suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

add #:id support to defform, etc.

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
collects/scribble/manual.ss
View File

@ -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

46
collects/scribblings/scribble/manual.scrbl
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.}
@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[scheme]-typeset uses of the identifier (with the same
for-label binding) are hyperlinked to this documentation.
@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[defmodule] or @scheme[declare-exporting] requires, as well
as the binding requirements for @scheme[id], are the same as for
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.
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.}