commit b34013592f7a4d0cec97d30e7b59ab1f4348335e
parent bd0e84df062fc112af8478fb74e1b1e5aa3fa2c4
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 4 Mar 2008 22:57:02 +0000
add #:id support to defform, etc.
svn: r8884
original commit: 8b0a675b9a24135100a12aa4d44e92aba0b6d1cf
Diffstat:
2 files changed, 63 insertions(+), 56 deletions(-)
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -760,21 +760,24 @@
immutable? transparent? (lambda () (list desc ...)))]))
(define-syntax (defform*/subs 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
- (syntax-case #'spec ()
- [(name . rest)
- (datum->syntax #'spec
- (cons
- (datum->syntax #'here
- '(unsyntax x)
- #'name)
- #'rest)
- #'spec)])]
- [spec-id
- (syntax-case #'spec ()
- [(name . rest) #'name])])
- #'(*defforms (quote-syntax/loc spec-id) '(lit ...)
+ (let loop ([spec #'spec])
+ (if (and (identifier? spec)
+ (free-identifier=? spec #'defined-id))
+ (datum->syntax #'here
+ '(unsyntax x)
+ spec
+ spec)
+ (syntax-case spec ()
+ [(a . b)
+ (datum->syntax spec
+ (cons (loop #'a)
+ (loop #'b))
+ spec
+ spec)]
+ [_ spec])))])
+ #'(*defforms (quote-syntax/loc defined-id) '(lit ...)
'(spec spec1 ...)
(list (lambda (x) (schemeblock0/form new-spec))
(lambda (ignored) (schemeblock0/form spec1)) ...)
@@ -784,18 +787,28 @@
...)
...)
(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 #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)]))
(define-syntax (defform* 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 ...)]
[(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
(define-syntax (defform 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 ...)]
[(_ spec desc ...) #'(defform*/subs [spec] () desc ...)]))
(define-syntax (defform/subs 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 ...)]
[(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)]))
(define-syntax (defform/none stx)
@@ -1646,24 +1659,16 @@
(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
(let ([var-list
- (apply
- append
- (map (lambda (form)
- (let loop ([form (cons (if kw-id
- (if (pair? form)
- (cdr form)
- null)
- form)
- subs)])
- (cond
- [(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))])
+ (let loop ([form (cons forms subs)])
+ (cond
+ [(symbol? form) (if (or (meta-symbol? form)
+ (and kw-id (eq? form (syntax-e kw-id)))
+ (memq form lits))
+ null
+ (list form))]
+ [(pair? form) (append (loop (car form))
+ (loop (cdr form)))]
+ [else null]))])
(parameterize ([current-variable-list var-list]
[current-meta-list '(... ...+)])
(make-box-splice
@@ -1684,11 +1689,7 @@
(and kw-id
(eq? form (car forms))
(let ([target-maker (id-to-form-target-maker kw-id #t)]
- [content (list (definition-site (if (pair? form)
- (car form)
- form)
- kw-id
- #t))])
+ [content (list (definition-site (syntax-e kw-id) kw-id #t))])
(if target-maker
(target-maker
content
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
@@ -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.}
-@defform/subs[(defform maybe-literals (id . datum) pre-flow ...)
- ([maybe-literals code:blank
+@defform/subs[(defform maybe-id maybe-literals form-datum pre-flow ...)
+ ([maybe-id code:blank
+ (code:line #:id id)]
+ [maybe-literals code:blank
(code:line #:literals (literal-id ...))])]{
Produces a a sequence of flow elements (encaptured in a
-@scheme[splice]) to document a syntatic form named by @scheme[id]. The
-@scheme[id] is indexed, and it is also registered so that
+@scheme[splice]) to document a syntatic form named by @scheme[id]
+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
-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
-as the binding requirements for @scheme[id], are the same as for
+The @scheme[defmodule] or @scheme[declare-exporting] requirements, as
+well as the binding requirements for @scheme[id], are the same as for
@scheme[defproc].
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
non-terminal. If @scheme[#:literals] clause is provided, however,
instances of the @scheme[literal-id]s are typeset normally (i.e., as
determined by the enclosing context).
-The typesetting of @scheme[(id . datum)] preserves the source
-layout, like @scheme[schemeblock].}
+The typesetting of @scheme[form-datum] preserves the source layout,
+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
-@scheme[id].}
+@scheme[_id].}
-@defform[(defform/subs maybe-literals (id . datum)
+@defform[(defform/subs maybe-id maybe-literals form-datum
([nonterm-id clause-datum ...+] ...)
pre-flow ...)]{
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[clause-datum]s, where the formatting of each
@scheme[clause-datum] is preserved.}
-@defform[(defform*/subs maybe-literals [(id . datum) ...]
+@defform[(defform*/subs maybe-id maybe-literals [form-datum ...]
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.}
@@ -415,9 +421,9 @@ Like @scheme[defform], but without registering a definition.}
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
and the @scheme[pre-flow]s.}
