generalize `defform' & co. to better support abstraction

This commit is contained in:
Matthew Flatt 2011-07-07 10:09:33 -06:00
parent 2afff3d210
commit e1b02e08f7
2 changed files with 68 additions and 53 deletions

View File

@ -36,42 +36,46 @@
([non-term-id non-term-form ...] ...) ([non-term-id non-term-form ...] ...)
#:contracts ([contract-nonterm contract-expr] ...) #:contracts ([contract-nonterm contract-expr] ...)
desc ...) desc ...)
(with-syntax ([new-spec (with-syntax ([(defined-id defined-id-expr)
(let loop ([spec #'spec]) (if (identifier? #'defined-id)
(if (and (identifier? spec) (syntax [defined-id (quote-syntax defined-id)])
(free-identifier=? spec #'defined-id)) #'defined-id)])
(datum->syntax #'here '(unsyntax x) spec spec) (with-syntax ([new-spec
(syntax-case spec () (let loop ([spec #'spec])
[(a . b) (if (and (identifier? spec)
(datum->syntax spec (free-identifier=? spec #'defined-id))
(cons (loop #'a) (loop #'b)) (datum->syntax #'here '(unsyntax x) spec spec)
spec (syntax-case spec ()
spec)] [(a . b)
[_ spec])))]) (datum->syntax spec
(for-each (lambda (id) (cons (loop #'a) (loop #'b))
(unless (identifier? id) spec
(raise-syntax-error #f spec)]
"expected an identifier for a literal" [_ spec])))])
stx (for-each (lambda (id)
id))) (unless (identifier? id)
(syntax->list #'(lit ...))) (raise-syntax-error #f
#'(with-togetherable-racket-variables "expected an identifier for a literal"
(lit ...) stx
([form spec] [form spec1] ... id)))
[non-term (non-term-id non-term-form ...)] ...) (syntax->list #'(lit ...)))
(*defforms (quote-syntax/loc defined-id) #'(with-togetherable-racket-variables
'(spec spec1 ...) (lit ...)
(list (lambda (x) (racketblock0/form new-spec)) ([form spec] [form spec1] ...
(lambda (ignored) (racketblock0/form spec1)) ...) [non-term (non-term-id non-term-form ...)] ...)
'((non-term-id non-term-form ...) ...) (*defforms defined-id-expr
(list (list (lambda () (racket non-term-id)) '(spec spec1 ...)
(lambda () (racketblock0/form non-term-form)) (list (lambda (x) (racketblock0/form new-spec))
...) (lambda (ignored) (racketblock0/form spec1)) ...)
...) '((non-term-id non-term-form ...) ...)
(list (list (lambda () (racket contract-nonterm)) (list (list (lambda () (racket non-term-id))
(lambda () (racketblock0 contract-expr))) (lambda () (racketblock0/form non-term-form))
...) ...)
(lambda () (list desc ...)))))] ...)
(list (list (lambda () (racket contract-nonterm))
(lambda () (racketblock0 contract-expr)))
...)
(lambda () (list desc ...))))))]
[(fm #:id defined-id #:literals (lit ...) [spec spec1 ...] [(fm #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...) ([non-term-id non-term-form ...] ...)
desc ...) desc ...)
@ -174,10 +178,12 @@
(fm #:literals () spec desc ...))])) (fm #:literals () spec desc ...))]))
(define-syntax (defidform/inline stx) (define-syntax (defidform/inline stx)
(syntax-case stx () (syntax-case stx (unsyntax)
[(_ id) [(_ id)
(identifier? #'id) (identifier? #'id)
#'(defform-site (quote-syntax id))])) #'(defform-site (quote-syntax id))]
[(_ (unsyntax id-expr))
#'(defform-site id-expr)]))
(define-syntax (defidform stx) (define-syntax (defidform stx)
(syntax-case stx () (syntax-case stx ()

View File

@ -640,7 +640,8 @@ it's best to document a related group of procedures at once.}
@defform/subs[(defform maybe-id maybe-literals form-datum maybe-contracts @defform/subs[(defform maybe-id maybe-literals form-datum maybe-contracts
pre-flow ...) pre-flow ...)
([maybe-id code:blank ([maybe-id code:blank
(code:line #:id id)] (code:line #:id id)
(code:line #:id [id id-expr])]
[maybe-literals code:blank [maybe-literals code:blank
(code:line #:literals (literal-id ...))] (code:line #:literals (literal-id ...))]
[maybe-contracts code:blank [maybe-contracts code:blank
@ -648,18 +649,24 @@ it's best to document a related group of procedures at once.}
...))])]{ ...))])]{
Produces a sequence of flow elements (encapsulated in a Produces a sequence of flow elements (encapsulated in a
@racket[splice]) to document a syntatic form named by @racket[id] @racket[splice]) to document a syntatic form named by @racket[id] (or the
whose syntax is described by @racket[form-datum]. If no @racket[#:id] is used result of @racket[id-expr]) whose syntax is described by
to specify @racket[id], then @racket[form-datum] must have the form @racket[form-datum]. If no @racket[#:id] is used to specify
@racket[(id . _datum)]. @racket[id], then @racket[form-datum] must have the form @racket[(id
. _datum)].
The @racket[id] is indexed, and it is also registered so that If @racket[#:id [id id-expr]] is supplied, then @racket[id] is the
@racket[racket]-typeset uses of the identifier (with the same identifier as it appears in the @racket[form-datum] (to be replaced by
for-label binding) are hyperlinked to this documentation. a defining instance), and @racket[id-expr] produces the identifier to
be documented. This split between @racket[id] and @racket[id-expr]
roles is useful for functional abstraction of @racket[defform].
The @racket[defmodule] or @racket[declare-exporting] requirements, as The @racket[id] (or result of @racket[id-expr]) is indexed, and it is
well as the binding requirements for @racket[id], are the same as for also registered so that @racket[racket]-typeset uses of the identifier
@racket[defproc]. (with the same for-label binding) are hyperlinked to this
documentation. The @racket[defmodule] or @racket[declare-exporting]
requirements, as well as the binding requirements for @racket[id] (or
result of @racket[id-expr]), are the same as for @racket[defproc].
The @tech{decode}d @racket[pre-flow] documents the form. In this The @tech{decode}d @racket[pre-flow] documents the form. In this
description, a reference to any identifier in @racket[form-datum] via description, a reference to any identifier in @racket[form-datum] via
@ -718,11 +725,13 @@ Like @racket[defform], but without registering a definition.}
Like @racket[defform], but with a plain @racket[id] as the form.} Like @racket[defform], but with a plain @racket[id] as the form.}
@defform[(defidform/inline id)]{ @defform*[[(defidform/inline id)
(defidform/inline (@#,racket[unsyntax] id-expr))]]{
Like @racket[defidform], but @racket[id] is typeset as an inline Like @racket[defidform], but @racket[id] (or the result of
element. Use this form sparingly, because the typeset form does not @racket[id-expr], analogous to @racket[defform]) is typeset as an
stand out to the reader as a specification of @racket[id].} inline element. Use this form sparingly, because the typeset form does
not stand out to the reader as a specification of @racket[id].}
@defform[(specform maybe-literals datum maybe-contracts @defform[(specform maybe-literals datum maybe-contracts