add #:id support to defform, etc.

svn: r8884

original commit: 8b0a675b9a24135100a12aa4d44e92aba0b6d1cf
This commit is contained in:
Matthew Flatt 2008-03-04 22:57:02 +00:00
parent bd0e84df06
commit b34013592f
2 changed files with 64 additions and 57 deletions

View File

@ -760,21 +760,24 @@
immutable? transparent? (lambda () (list desc ...)))])) immutable? transparent? (lambda () (list desc ...)))]))
(define-syntax (defform*/subs stx) (define-syntax (defform*/subs stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...) [(_ #:id defined-id #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
(with-syntax ([new-spec (with-syntax ([new-spec
(syntax-case #'spec () (let loop ([spec #'spec])
[(name . rest) (if (and (identifier? spec)
(datum->syntax #'spec (free-identifier=? spec #'defined-id))
(cons (datum->syntax #'here
(datum->syntax #'here '(unsyntax x)
'(unsyntax x) spec
#'name) spec)
#'rest) (syntax-case spec ()
#'spec)])] [(a . b)
[spec-id (datum->syntax spec
(syntax-case #'spec () (cons (loop #'a)
[(name . rest) #'name])]) (loop #'b))
#'(*defforms (quote-syntax/loc spec-id) '(lit ...) spec
spec)]
[_ spec])))])
#'(*defforms (quote-syntax/loc defined-id) '(lit ...)
'(spec spec1 ...) '(spec spec1 ...)
(list (lambda (x) (schemeblock0/form new-spec)) (list (lambda (x) (schemeblock0/form new-spec))
(lambda (ignored) (schemeblock0/form spec1)) ...) (lambda (ignored) (schemeblock0/form spec1)) ...)
@ -784,18 +787,28 @@
...) ...)
...) ...)
(lambda () (list desc ...))))] (lambda () (list desc ...))))]
[(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
#'(fm #:id id #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)]
[(fm #:literals lits [(spec-id . spec-rest) spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
(with-syntax ([(_ _ _ [spec . _] . _) stx])
#'(fm #:id spec-id #:literals lits [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...))]
[(fm [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...) [(fm [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
#'(fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)])) #'(fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)]))
(define-syntax (defform* stx) (define-syntax (defform* stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:id id #:literals lits [spec ...] desc ...) #'(defform*/subs #:id id #:literals lits [spec ...] () desc ...)]
[(_ #:literals lits [spec ...] desc ...) #'(defform*/subs #:literals lits [spec ...] () desc ...)] [(_ #:literals lits [spec ...] desc ...) #'(defform*/subs #:literals lits [spec ...] () desc ...)]
[(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)])) [(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
(define-syntax (defform stx) (define-syntax (defform stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:id id #:literals (lit ...) spec desc ...) #'(defform*/subs #:id id #:literals (lit ...) [spec] () desc ...)]
[(_ #:id id spec desc ...) #'(defform*/subs #:id id #:literals () [spec] () desc ...)]
[(_ #:literals (lit ...) spec desc ...) #'(defform*/subs #:literals (lit ...) [spec] () desc ...)] [(_ #:literals (lit ...) spec desc ...) #'(defform*/subs #:literals (lit ...) [spec] () desc ...)]
[(_ spec desc ...) #'(defform*/subs [spec] () desc ...)])) [(_ spec desc ...) #'(defform*/subs [spec] () desc ...)]))
(define-syntax (defform/subs stx) (define-syntax (defform/subs stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:id id #:literals lits spec subs desc ...) #'(defform*/subs #:id id #:literals lits [spec] subs desc ...)]
[(_ #:id id spec subs desc ...) #'(defform*/subs #:id id #:literals () [spec] subs desc ...)]
[(_ #:literals lits spec subs desc ...) #'(defform*/subs #:literals lits [spec] subs desc ...)] [(_ #:literals lits spec subs desc ...) #'(defform*/subs #:literals lits [spec] subs desc ...)]
[(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)])) [(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)]))
(define-syntax (defform/none stx) (define-syntax (defform/none stx)
@ -1646,24 +1659,16 @@
(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk) (define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
(let ([var-list (let ([var-list
(apply (let loop ([form (cons forms subs)])
append (cond
(map (lambda (form) [(symbol? form) (if (or (meta-symbol? form)
(let loop ([form (cons (if kw-id (and kw-id (eq? form (syntax-e kw-id)))
(if (pair? form) (memq form lits))
(cdr form) null
null) (list form))]
form) [(pair? form) (append (loop (car form))
subs)]) (loop (cdr form)))]
(cond [else null]))])
[(symbol? form) (if (or (meta-symbol? form)
(memq form lits))
null
(list form))]
[(pair? form) (append (loop (car form))
(loop (cdr form)))]
[else null])))
forms))])
(parameterize ([current-variable-list var-list] (parameterize ([current-variable-list var-list]
[current-meta-list '(... ...+)]) [current-meta-list '(... ...+)])
(make-box-splice (make-box-splice
@ -1684,11 +1689,7 @@
(and kw-id (and kw-id
(eq? form (car forms)) (eq? form (car forms))
(let ([target-maker (id-to-form-target-maker kw-id #t)] (let ([target-maker (id-to-form-target-maker kw-id #t)]
[content (list (definition-site (if (pair? form) [content (list (definition-site (syntax-e kw-id) kw-id #t))])
(car form)
form)
kw-id
#t))])
(if target-maker (if target-maker
(target-maker (target-maker
content content

View File

@ -359,53 +359,59 @@ can also be defined by a single @scheme[defproc*], for the case that
it's best to document a related group of procedures at once.} it's best to document a related group of procedures at once.}
@defform/subs[(defform maybe-literals (id . datum) pre-flow ...) @defform/subs[(defform maybe-id maybe-literals form-datum pre-flow ...)
([maybe-literals code:blank ([maybe-id code:blank
(code:line #:id id)]
[maybe-literals code:blank
(code:line #:literals (literal-id ...))])]{ (code:line #:literals (literal-id ...))])]{
Produces a a sequence of flow elements (encaptured in a Produces a a sequence of flow elements (encaptured in a
@scheme[splice]) to document a syntatic form named by @scheme[id]. The @scheme[splice]) to document a syntatic form named by @scheme[id]
@scheme[id] is indexed, and it is also registered so that whose syntax described by @scheme[datum]. If no @scheme[#:id] is used
to specify @scheme[id], then @scheme[form-datum] must have the form
@scheme[(id . _datum)].
The @scheme[id] is indexed, and it is also registered so that
@scheme[scheme]-typeset uses of the identifier (with the same @scheme[scheme]-typeset uses of the identifier (with the same
for-label binding) are hyperlinked to this documentation. for-label binding) are hyperlinked to this documentation.
The @scheme[defmodule] or @scheme[declare-exporting] requires, as well The @scheme[defmodule] or @scheme[declare-exporting] requirements, as
as the binding requirements for @scheme[id], are the same as for well as the binding requirements for @scheme[id], are the same as for
@scheme[defproc]. @scheme[defproc].
The @tech{decode}d @scheme[pre-flow] documents the form. In this The @tech{decode}d @scheme[pre-flow] documents the form. In this
description, a reference to any identifier in @scheme[datum] via description, a reference to any identifier in @scheme[form-datum] via
@scheme[scheme], @scheme[schemeblock], @|etc| is typeset as a sub-form @scheme[scheme], @scheme[schemeblock], @|etc| is typeset as a sub-form
non-terminal. If @scheme[#:literals] clause is provided, however, non-terminal. If @scheme[#:literals] clause is provided, however,
instances of the @scheme[literal-id]s are typeset normally (i.e., as instances of the @scheme[literal-id]s are typeset normally (i.e., as
determined by the enclosing context). determined by the enclosing context).
The typesetting of @scheme[(id . datum)] preserves the source The typesetting of @scheme[form-datum] preserves the source layout,
layout, like @scheme[schemeblock].} like @scheme[schemeblock].}
@defform[(defform* maybe-literals [(id . datum) ..+] pre-flow ...)]{ @defform[(defform* maybe-id maybe-literals [form-datum ..+] pre-flow ...)]{
Like @scheme[defform], but for multiple forms using the same Like @scheme[defform], but for multiple forms using the same
@scheme[id].} @scheme[_id].}
@defform[(defform/subs maybe-literals (id . datum) @defform[(defform/subs maybe-id maybe-literals form-datum
([nonterm-id clause-datum ...+] ...) ([nonterm-id clause-datum ...+] ...)
pre-flow ...)]{ pre-flow ...)]{
Like @scheme[defform], but including an auxiliary grammar of Like @scheme[defform], but including an auxiliary grammar of
non-terminals shown with the @scheme[id] form. Each non-terminals shown with the @scheme[_id] form. Each
@scheme[nonterm-id] is specified as being any of the corresponding @scheme[nonterm-id] is specified as being any of the corresponding
@scheme[clause-datum]s, where the formatting of each @scheme[clause-datum]s, where the formatting of each
@scheme[clause-datum] is preserved.} @scheme[clause-datum] is preserved.}
@defform[(defform*/subs maybe-literals [(id . datum) ...] @defform[(defform*/subs maybe-id maybe-literals [form-datum ...]
pre-flow ...)]{ pre-flow ...)]{
Like @scheme[defform/subs], but for multiple forms for @scheme[id].} Like @scheme[defform/subs], but for multiple forms for @scheme[_id].}
@defform[(defform/none maybe-literal datum pre-flow ...)]{ @defform[(defform/none maybe-literal form-datum pre-flow ...)]{
Like @scheme[defform], but without registering a definition.} Like @scheme[defform], but without registering a definition.}
@ -415,9 +421,9 @@ Like @scheme[defform], but without registering a definition.}
Like @scheme[defform], but with a plain @scheme[id] as the form.} Like @scheme[defform], but with a plain @scheme[id] as the form.}
@defform[(specform maybe-literals (id . datum) pre-flow ...)]{ @defform[(specform maybe-literals datum pre-flow ...)]{
Like @scheme[defform], with without indexing or registering a Like @scheme[defform], but without indexing or registering a
definition, and with indenting on the left for both the specification definition, and with indenting on the left for both the specification
and the @scheme[pre-flow]s.} and the @scheme[pre-flow]s.}