From e1b02e08f7697b1ca9514df5d14f21c604c3ae0c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 7 Jul 2011 10:09:33 -0600 Subject: [PATCH] generalize `defform' & co. to better support abstraction --- collects/scribble/private/manual-form.rkt | 82 ++++++++++++---------- collects/scribblings/scribble/manual.scrbl | 39 ++++++---- 2 files changed, 68 insertions(+), 53 deletions(-) diff --git a/collects/scribble/private/manual-form.rkt b/collects/scribble/private/manual-form.rkt index 7d98050dfe..92d42059ed 100644 --- a/collects/scribble/private/manual-form.rkt +++ b/collects/scribble/private/manual-form.rkt @@ -36,42 +36,46 @@ ([non-term-id non-term-form ...] ...) #:contracts ([contract-nonterm contract-expr] ...) desc ...) - (with-syntax ([new-spec - (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])))]) - (for-each (lambda (id) - (unless (identifier? id) - (raise-syntax-error #f - "expected an identifier for a literal" - stx - id))) - (syntax->list #'(lit ...))) - #'(with-togetherable-racket-variables - (lit ...) - ([form spec] [form spec1] ... - [non-term (non-term-id non-term-form ...)] ...) - (*defforms (quote-syntax/loc defined-id) - '(spec spec1 ...) - (list (lambda (x) (racketblock0/form new-spec)) - (lambda (ignored) (racketblock0/form spec1)) ...) - '((non-term-id non-term-form ...) ...) - (list (list (lambda () (racket non-term-id)) - (lambda () (racketblock0/form non-term-form)) - ...) - ...) - (list (list (lambda () (racket contract-nonterm)) - (lambda () (racketblock0 contract-expr))) - ...) - (lambda () (list desc ...)))))] + (with-syntax ([(defined-id defined-id-expr) + (if (identifier? #'defined-id) + (syntax [defined-id (quote-syntax defined-id)]) + #'defined-id)]) + (with-syntax ([new-spec + (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])))]) + (for-each (lambda (id) + (unless (identifier? id) + (raise-syntax-error #f + "expected an identifier for a literal" + stx + id))) + (syntax->list #'(lit ...))) + #'(with-togetherable-racket-variables + (lit ...) + ([form spec] [form spec1] ... + [non-term (non-term-id non-term-form ...)] ...) + (*defforms defined-id-expr + '(spec spec1 ...) + (list (lambda (x) (racketblock0/form new-spec)) + (lambda (ignored) (racketblock0/form spec1)) ...) + '((non-term-id non-term-form ...) ...) + (list (list (lambda () (racket non-term-id)) + (lambda () (racketblock0/form non-term-form)) + ...) + ...) + (list (list (lambda () (racket contract-nonterm)) + (lambda () (racketblock0 contract-expr))) + ...) + (lambda () (list desc ...))))))] [(fm #:id defined-id #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...) @@ -174,10 +178,12 @@ (fm #:literals () spec desc ...))])) (define-syntax (defidform/inline stx) - (syntax-case stx () + (syntax-case stx (unsyntax) [(_ id) (identifier? #'id) - #'(defform-site (quote-syntax id))])) + #'(defform-site (quote-syntax id))] + [(_ (unsyntax id-expr)) + #'(defform-site id-expr)])) (define-syntax (defidform stx) (syntax-case stx () diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index e0ff769299..8f5429472b 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -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 pre-flow ...) ([maybe-id code:blank - (code:line #:id id)] + (code:line #:id id) + (code:line #:id [id id-expr])] [maybe-literals code:blank (code:line #:literals (literal-id ...))] [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 -@racket[splice]) to document a syntatic form named by @racket[id] -whose syntax is described by @racket[form-datum]. If no @racket[#:id] is used -to specify @racket[id], then @racket[form-datum] must have the form -@racket[(id . _datum)]. +@racket[splice]) to document a syntatic form named by @racket[id] (or the +result of @racket[id-expr]) whose syntax is described by +@racket[form-datum]. If no @racket[#:id] is used to specify +@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 -@racket[racket]-typeset uses of the identifier (with the same -for-label binding) are hyperlinked to this documentation. +If @racket[#:id [id id-expr]] is supplied, then @racket[id] is the +identifier as it appears in the @racket[form-datum] (to be replaced by +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 -well as the binding requirements for @racket[id], are the same as for -@racket[defproc]. +The @racket[id] (or result of @racket[id-expr]) is indexed, and it is +also registered so that @racket[racket]-typeset uses of the identifier +(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 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.} -@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 -element. Use this form sparingly, because the typeset form does not -stand out to the reader as a specification of @racket[id].} +Like @racket[defidform], but @racket[id] (or the result of +@racket[id-expr], analogous to @racket[defform]) is typeset as an +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