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

add #:contracts optional sub-form to defform

Browse Source 
svn: r13012

original commit: 851c58ea50dc31c175bde7016962833f379885c6
This commit is contained in:
Matthew Flatt 2009-01-05 14:00:07 +00:00
parent e296df0471
commit 322be283e3
2 changed files with 129 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
collects/scribble/private/manual-form.ss
View File

@ -32,6 +32,7 @@
(syntax-case stx ()
[(_ #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...)
#:contracts ([contract-nonterm contract-expr] ...)
desc ...)
(with-syntax ([new-spec
(let loop ([spec #'spec])
@ -65,57 +66,83 @@
(lambda () (schemeblock0/form non-term-form))
...)
...)
(list (list (lambda () (scheme contract-nonterm))
(lambda () (schemeblock0 contract-expr)))
...)
(lambda () (list desc ...)))))]
[(fm #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...)
desc ...)
(syntax/loc stx
(fm #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...)
#:contracts ()
desc ...))]
[(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...)
desc ...)
#'(fm #:id id #:literals () [spec spec1 ...]
(syntax/loc stx
(fm #:id id #:literals () [spec spec1 ...]
([non-term-id non-term-form ...] ...)
desc ...)]
#:contracts ()
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 ...]
(syntax/loc stx
(fm #:id spec-id #:literals lits [spec spec1 ...]
([non-term-id non-term-form ...] ...)
desc ...))]
desc ...)))]
[(fm [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
#'(fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...)
desc ...)]))
(syntax/loc stx
(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 ...)]
(syntax/loc stx
(defform*/subs #:id id #:literals lits [spec ...] () desc ...))]
[(_ #:literals lits [spec ...] desc ...)
#'(defform*/subs #:literals lits [spec ...] () desc ...)]
(syntax/loc stx
(defform*/subs #:literals lits [spec ...] () desc ...))]
[(_ [spec ...] desc ...)
#'(defform*/subs [spec ...] () desc ...)]))
(syntax/loc stx
(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 ...)]
(syntax/loc stx
(defform*/subs #:id id #:literals (lit ...) [spec] () desc ...))]
[(_ #:id id spec desc ...)
#'(defform*/subs #:id id #:literals () [spec] () desc ...)]
(syntax/loc stx
(defform*/subs #:id id #:literals () [spec] () desc ...))]
[(_ #:literals (lit ...) spec desc ...)
#'(defform*/subs #:literals (lit ...) [spec] () desc ...)]
(syntax/loc stx
(defform*/subs #:literals (lit ...) [spec] () desc ...))]
[(_ spec desc ...)
#'(defform*/subs [spec] () desc ...)]))
(syntax/loc stx
(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 ...)]
(syntax/loc stx
(defform*/subs #:id id #:literals lits [spec] subs desc ...))]
[(_ #:id id spec subs desc ...)
#'(defform*/subs #:id id #:literals () [spec] subs desc ...)]
(syntax/loc stx
(defform*/subs #:id id #:literals () [spec] subs desc ...))]
[(_ #:literals lits spec subs desc ...)
#'(defform*/subs #:literals lits [spec] subs desc ...)]
(syntax/loc stx
(defform*/subs #:literals lits [spec] subs desc ...))]
[(_ spec subs desc ...)
#'(defform*/subs [spec] subs desc ...)]))
(syntax/loc stx
(defform*/subs [spec] subs desc ...))]))
(define-syntax (defform/none stx)
(syntax-case stx ()
[(_ #:literals (lit ...) spec desc ...)
[(_ #:literals (lit ...) spec #:contracts ([contract-id contract-expr] ...) desc ...)
(begin
(for-each (lambda (id)
(unless (identifier? id)
@ -130,9 +157,16 @@
(*defforms #f
'(spec) (list (lambda (ignored) (schemeblock0/form spec)))
null null
(list (list (lambda () (scheme contract-id))
(lambda () (schemeblock0 contract-expr)))
...)
(lambda () (list desc ...)))))]
[(_ spec desc ...)
#'(defform/none #:literals () spec desc ...)]))
[(fm #:literals (lit ...) spec desc ...)
(syntax/loc stx
(fm #:literals (lit ...) spec #:contracts () desc ...))]
[(fm spec desc ...)
(syntax/loc stx
(fm #:literals () spec desc ...))]))
(define-syntax (defidform stx)
(syntax-case stx ()
@ -145,6 +179,7 @@
(list (lambda (x) (make-omitable-paragraph (list x))))
null
null
null
(lambda () (list desc ...))))]))
(define (into-blockquote s)
@ -164,6 +199,7 @@
(define-syntax spec?form/subs
(syntax-rules ()
[(_ has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
#:contracts ([contract-nonterm contract-expr] ...)
desc ...)
(with-scheme-variables
(lit ...)
@ -175,7 +211,15 @@
(lambda () (schemeblock0/form non-term-form))
...)
...)
(lambda () (list desc ...))))]))
(list (list (lambda () (scheme contract-nonterm))
(lambda () (schemeblock0 contract-expr)))
...)
(lambda () (list desc ...))))]
[(_ has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
desc ...)
(spec?form/subs has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
#:contracts ()
desc ...)]))
(define-syntax specsubform
(syntax-rules ()
@ -220,7 +264,7 @@
(with-scheme-variables
()
([form/maybe (#f spec)])
(*specsubform 'spec null #f null null (lambda () (list desc ...)))))
(*specsubform 'spec null #f null null null (lambda () (list desc ...)))))
(define-syntax schemegrammar
(syntax-rules ()
@ -258,7 +302,7 @@
(define (meta-symbol? s) (memq s '(... ...+ ?)))
(define (*defforms kw-id forms form-procs subs sub-procs content-thunk)
(define (*defforms kw-id forms form-procs subs sub-procs contract-procs content-thunk)
(parameterize ([current-meta-list '(... ...+)])
(make-box-splice
(cons
@ -307,10 +351,11 @@
sub-procs)])
(*schemerawgrammars "specgrammar"
(map car l)
(map cdr l))))))))))
(map cdr l))))))))
(make-contracts-table contract-procs)))
(content-thunk)))))
(define (*specsubform form lits form-thunk subs sub-procs content-thunk)
(define (*specsubform form lits form-thunk subs sub-procs contract-procs content-thunk)
(parameterize ([current-meta-list '(... ...+)])
(make-blockquote
"leftindent"
@ -324,16 +369,18 @@
(if form-thunk
(form-thunk)
(make-omitable-paragraph (list (to-element form)))))))
(if (null? sub-procs)
null
(list (list flow-empty-line)
(list (make-flow
(list (let ([l (map (lambda (sub)
(map (lambda (f) (f)) sub))
sub-procs)])
(*schemerawgrammars "specgrammar"
(map car l)
(map cdr l))))))))))
(append
(if (null? sub-procs)
null
(list (list flow-empty-line)
(list (make-flow
(list (let ([l (map (lambda (sub)
(map (lambda (f) (f)) sub))
sub-procs)])
(*schemerawgrammars "specgrammar"
(map car l)
(map cdr l))))))))
(make-contracts-table contract-procs))))
(flow-paragraphs (decode-flow (content-thunk)))))))
(define (*schemerawgrammars style nonterms clauseses)
@ -374,3 +421,21 @@
(define (*var-sym id)
(string->symbol (format "_~a" id)))
(define (make-contracts-table contract-procs)
(if (null? contract-procs)
null
(append
(list (list flow-empty-line))
(list (list (make-flow
(map (lambda (c)
(make-table
"argcontract"
(list
(list (to-flow (hspace 2))
(to-flow ((car c)))
flow-spacer
(to-flow ":")
flow-spacer
(make-flow (list ((cadr c))))))))
contract-procs)))))))

39
collects/scribblings/scribble/manual.scrbl
View File

@ -387,15 +387,19 @@ 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-id maybe-literals form-datum pre-flow ...)
@defform/subs[(defform maybe-id maybe-literals form-datum maybe-contracts
pre-flow ...)
([maybe-id code:blank
(code:line #:id id)]
[maybe-literals code:blank
(code:line #:literals (literal-id ...))])]{
(code:line #:literals (literal-id ...))]
[maybe-contracts code:blank
(code:line #:contracts ([subform-datum contract-expr-datum]
...))])]{
Produces a sequence of flow elements (encapsulated in a
@scheme[splice]) to document a syntatic form named by @scheme[id]
whose syntax described by @scheme[form-datum]. If no @scheme[#:id] is used
whose syntax is described by @scheme[form-datum]. If no @scheme[#:id] is used
to specify @scheme[id], then @scheme[form-datum] must have the form
@scheme[(id . _datum)].
@ -414,16 +418,24 @@ 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[form-datum] preserves the source layout,
like @scheme[schemeblock].}
If a @scheme[#:contracts] clause is provided, each
@scheme[subform-datum] (typically an identifier that serves as a
meta-variable in @scheme[form-datum]) is shown as producing a value
that must satisfy the contract described by @scheme[contract-expr-datum].
@defform[(defform* maybe-id maybe-literals [form-datum ...+] pre-flow ...)]{
The typesetting of @scheme[form-datum], @scheme[subform-datum], and
@scheme[contract-expr-datum] preserves the source layout, like
@scheme[schemeblock].}
@defform[(defform* maybe-id maybe-literals [form-datum ...+] maybe-contracts
pre-flow ...)]{
Like @scheme[defform], but for multiple forms using the same
@scheme[_id].}
@defform[(defform/subs maybe-id maybe-literals form-datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{
Like @scheme[defform], but including an auxiliary grammar of
@ -434,12 +446,14 @@ non-terminals shown with the @scheme[_id] form. Each
@defform[(defform*/subs maybe-id maybe-literals [form-datum ...]
maybe-contracts
pre-flow ...)]{
Like @scheme[defform/subs], but for multiple forms for @scheme[_id].}
@defform[(defform/none maybe-literal form-datum pre-flow ...)]{
@defform[(defform/none maybe-literal form-datum maybe-contracts
pre-flow ...)]{
Like @scheme[defform], but without registering a definition.}
@ -449,14 +463,16 @@ Like @scheme[defform], but without registering a definition.}
Like @scheme[defform], but with a plain @scheme[id] as the form.}
@defform[(specform maybe-literals datum pre-flow ...)]{
@defform[(specform maybe-literals datum maybe-contracts
pre-flow ...)]{
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.}
@defform[(specsubform maybe-literals datum pre-flow ...)]{
@defform[(specsubform maybe-literals datum maybe-contracts
pre-flow ...)]{
Similar to @scheme[defform], but without any specific identifier being
defined, and the table and flow are typeset indented. This form is
@ -472,13 +488,15 @@ procedure. In this description, a reference to any identifier in
@defform[(specsubform/subs maybe-literals datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{
Like @scheme[specsubform], but with a grammar like
@scheme[defform/subs].}
@defform[(specspecsubform maybe-literals datum pre-flow ...)]{
@defform[(specspecsubform maybe-literals datum maybe-contracts
pre-flow ...)]{
Like @scheme[specsubform], but indented an extra level. Since using
@scheme[specsubform] within the body of @scheme[specsubform] already
@ -488,6 +506,7 @@ without nesting a description.}
@defform[(specspecsubform/subs maybe-literals datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{
Like @scheme[specspecsubform], but with a grammar like