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 () (syntax-case stx ()
[(_ #:id defined-id #:literals (lit ...) [spec spec1 ...] [(_ #:id defined-id #:literals (lit ...) [spec spec1 ...]
([non-term-id non-term-form ...] ...) ([non-term-id non-term-form ...] ...)
#:contracts ([contract-nonterm contract-expr] ...)
desc ...) desc ...)
(with-syntax ([new-spec (with-syntax ([new-spec
(let loop ([spec #'spec]) (let loop ([spec #'spec])
@ -65,57 +66,83 @@
(lambda () (schemeblock0/form non-term-form)) (lambda () (schemeblock0/form non-term-form))
...) ...)
...) ...)
(list (list (lambda () (scheme contract-nonterm))
(lambda () (schemeblock0 contract-expr)))
...)
(lambda () (list desc ...)))))] (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 ...] ...) [(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...)
desc ...) desc ...)
#'(fm #:id id #:literals () [spec spec1 ...] (syntax/loc stx
(fm #:id id #:literals () [spec spec1 ...]
([non-term-id non-term-form ...] ...) ([non-term-id non-term-form ...] ...)
desc ...)] #:contracts ()
desc ...))]
[(fm #:literals lits [(spec-id . spec-rest) spec1 ...] [(fm #:literals lits [(spec-id . spec-rest) spec1 ...]
([non-term-id non-term-form ...] ...) ([non-term-id non-term-form ...] ...)
desc ...) desc ...)
(with-syntax ([(_ _ _ [spec . _] . _) stx]) (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 ...] ...) ([non-term-id non-term-form ...] ...)
desc ...))] desc ...)))]
[(fm [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 ...] ...) (syntax/loc stx
desc ...)])) (fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...)
desc ...))]))
(define-syntax (defform* stx) (define-syntax (defform* stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:id id #:literals lits [spec ...] desc ...) [(_ #: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 ...) [(_ #:literals lits [spec ...] desc ...)
#'(defform*/subs #:literals lits [spec ...] () desc ...)] (syntax/loc stx
(defform*/subs #:literals lits [spec ...] () desc ...))]
[(_ [spec ...] desc ...) [(_ [spec ...] desc ...)
#'(defform*/subs [spec ...] () desc ...)])) (syntax/loc stx
(defform*/subs [spec ...] () desc ...))]))
(define-syntax (defform stx) (define-syntax (defform stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:id id #:literals (lit ...) spec desc ...) [(_ #: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 ...) [(_ #: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 ...) [(_ #:literals (lit ...) spec desc ...)
#'(defform*/subs #:literals (lit ...) [spec] () desc ...)] (syntax/loc stx
(defform*/subs #:literals (lit ...) [spec] () desc ...))]
[(_ spec desc ...) [(_ spec desc ...)
#'(defform*/subs [spec] () desc ...)])) (syntax/loc stx
(defform*/subs [spec] () desc ...))]))
(define-syntax (defform/subs stx) (define-syntax (defform/subs stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:id id #:literals lits spec subs desc ...) [(_ #: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 ...) [(_ #: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 ...) [(_ #: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 ...) [(_ spec subs desc ...)
#'(defform*/subs [spec] subs desc ...)])) (syntax/loc stx
(defform*/subs [spec] subs desc ...))]))
(define-syntax (defform/none stx) (define-syntax (defform/none stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:literals (lit ...) spec desc ...) [(_ #:literals (lit ...) spec #:contracts ([contract-id contract-expr] ...) desc ...)
(begin (begin
(for-each (lambda (id) (for-each (lambda (id)
(unless (identifier? id) (unless (identifier? id)
@ -130,9 +157,16 @@
(*defforms #f (*defforms #f
'(spec) (list (lambda (ignored) (schemeblock0/form spec))) '(spec) (list (lambda (ignored) (schemeblock0/form spec)))
null null null null
(list (list (lambda () (scheme contract-id))
(lambda () (schemeblock0 contract-expr)))
...)
(lambda () (list desc ...)))))] (lambda () (list desc ...)))))]
[(_ spec desc ...) [(fm #:literals (lit ...) spec desc ...)
#'(defform/none #:literals () 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) (define-syntax (defidform stx)
(syntax-case stx () (syntax-case stx ()
@ -145,6 +179,7 @@
(list (lambda (x) (make-omitable-paragraph (list x)))) (list (lambda (x) (make-omitable-paragraph (list x))))
null null
null null
null
(lambda () (list desc ...))))])) (lambda () (list desc ...))))]))
(define (into-blockquote s) (define (into-blockquote s)
@ -164,6 +199,7 @@
(define-syntax spec?form/subs (define-syntax spec?form/subs
(syntax-rules () (syntax-rules ()
[(_ has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) [(_ has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
#:contracts ([contract-nonterm contract-expr] ...)
desc ...) desc ...)
(with-scheme-variables (with-scheme-variables
(lit ...) (lit ...)
@ -175,7 +211,15 @@
(lambda () (schemeblock0/form non-term-form)) (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 (define-syntax specsubform
(syntax-rules () (syntax-rules ()
@ -220,7 +264,7 @@
(with-scheme-variables (with-scheme-variables
() ()
([form/maybe (#f spec)]) ([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 (define-syntax schemegrammar
(syntax-rules () (syntax-rules ()
@ -258,7 +302,7 @@
(define (meta-symbol? s) (memq s '(... ...+ ?))) (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 '(... ...+)]) (parameterize ([current-meta-list '(... ...+)])
(make-box-splice (make-box-splice
(cons (cons
@ -307,10 +351,11 @@
sub-procs)]) sub-procs)])
(*schemerawgrammars "specgrammar" (*schemerawgrammars "specgrammar"
(map car l) (map car l)
(map cdr l)))))))))) (map cdr l))))))))
(make-contracts-table contract-procs)))
(content-thunk))))) (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 '(... ...+)]) (parameterize ([current-meta-list '(... ...+)])
(make-blockquote (make-blockquote
"leftindent" "leftindent"
@ -324,16 +369,18 @@
(if form-thunk (if form-thunk
(form-thunk) (form-thunk)
(make-omitable-paragraph (list (to-element form))))))) (make-omitable-paragraph (list (to-element form)))))))
(if (null? sub-procs) (append
null (if (null? sub-procs)
(list (list flow-empty-line) null
(list (make-flow (list (list flow-empty-line)
(list (let ([l (map (lambda (sub) (list (make-flow
(map (lambda (f) (f)) sub)) (list (let ([l (map (lambda (sub)
sub-procs)]) (map (lambda (f) (f)) sub))
(*schemerawgrammars "specgrammar" sub-procs)])
(map car l) (*schemerawgrammars "specgrammar"
(map cdr l)))))))))) (map car l)
(map cdr l))))))))
(make-contracts-table contract-procs))))
(flow-paragraphs (decode-flow (content-thunk))))))) (flow-paragraphs (decode-flow (content-thunk)))))))
(define (*schemerawgrammars style nonterms clauseses) (define (*schemerawgrammars style nonterms clauseses)
@ -374,3 +421,21 @@
(define (*var-sym id) (define (*var-sym id)
(string->symbol (format "_~a" 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.} 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 ([maybe-id code:blank
(code:line #:id id)] (code:line #:id id)]
[maybe-literals code:blank [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 Produces a sequence of flow elements (encapsulated in a
@scheme[splice]) to document a syntatic form named by @scheme[id] @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 to specify @scheme[id], then @scheme[form-datum] must have the form
@scheme[(id . _datum)]. @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 instances of the @scheme[literal-id]s are typeset normally (i.e., as
determined by the enclosing context). determined by the enclosing context).
The typesetting of @scheme[form-datum] preserves the source layout, If a @scheme[#:contracts] clause is provided, each
like @scheme[schemeblock].} @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 Like @scheme[defform], but for multiple forms using the same
@scheme[_id].} @scheme[_id].}
@defform[(defform/subs maybe-id maybe-literals form-datum @defform[(defform/subs maybe-id maybe-literals form-datum
([nonterm-id clause-datum ...+] ...) ([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @scheme[defform], but including an auxiliary grammar of 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 ...] @defform[(defform*/subs maybe-id maybe-literals [form-datum ...]
maybe-contracts
pre-flow ...)]{ 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 form-datum pre-flow ...)]{ @defform[(defform/none maybe-literal form-datum maybe-contracts
pre-flow ...)]{
Like @scheme[defform], but without registering a definition.} 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.} 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 Like @scheme[defform], but without indexing or registering a
definition, and with indenting on the left for both the specification definition, and with indenting on the left for both the specification
and the @scheme[pre-flow]s.} 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 Similar to @scheme[defform], but without any specific identifier being
defined, and the table and flow are typeset indented. This form is 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 @defform[(specsubform/subs maybe-literals datum
([nonterm-id clause-datum ...+] ...) ([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @scheme[specsubform], but with a grammar like Like @scheme[specsubform], but with a grammar like
@scheme[defform/subs].} @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 Like @scheme[specsubform], but indented an extra level. Since using
@scheme[specsubform] within the body of @scheme[specsubform] already @scheme[specsubform] within the body of @scheme[specsubform] already
@ -488,6 +506,7 @@ without nesting a description.}
@defform[(specspecsubform/subs maybe-literals datum @defform[(specspecsubform/subs maybe-literals datum
([nonterm-id clause-datum ...+] ...) ([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @scheme[specspecsubform], but with a grammar like Like @scheme[specspecsubform], but with a grammar like