added optional #:grammar clause to defform, etc

original commit: 293b208af72c53b5bb2b625650b19a52d1cf256d
This commit is contained in:
Ryan Culpepper 2013-03-20 10:52:16 -04:00
parent 6b54708a39
commit af5721a887
2 changed files with 113 additions and 87 deletions

View File

@ -29,8 +29,9 @@
(begin-for-syntax (begin-for-syntax
(define-splicing-syntax-class kind-kw (define-splicing-syntax-class kind-kw
#:description "#:kind keyword" #:description "#:kind keyword"
(pattern (~optional (~seq #:kind kind) (pattern (~seq #:kind kind))
#:defaults ([kind #'#f])))) (pattern (~seq)
#:with kind #'#f))
(define-splicing-syntax-class id-kw (define-splicing-syntax-class id-kw
#:description "#:id keyword" #:description "#:id keyword"
@ -46,17 +47,25 @@
(define-splicing-syntax-class literals-kw (define-splicing-syntax-class literals-kw
#:description "#:literals keyword" #:description "#:literals keyword"
(pattern (~optional (~seq #:literals (lit:id ...)) (pattern (~seq #:literals (lit:id ...)))
#:defaults ([(lit 1) '()])))) (pattern (~seq)
#:with (lit ...) #'()))
(define-splicing-syntax-class contracts-kw (define-splicing-syntax-class contracts-kw
#:description "#:contracts keyword" #:description "#:contracts keyword"
(pattern (~optional (~seq #:contracts ([contract-nonterm:id contract-expr] ...)) (pattern (~seq #:contracts (~and cs ([contract-nonterm:id contract-expr] ...))))
#:defaults ([(contract-nonterm 1) '()] (pattern (~seq)
[(contract-expr 1) '()])))) #:with (~and cs ((contract-nonterm contract-expr) ...)) #'()))
(define-syntax-class grammar (define-syntax-class grammar
(pattern ([non-term-id:id non-term-form ...] ...))) #:description "grammar"
(pattern ([non-term-id:id non-term-form ...+] ...)))
(define-splicing-syntax-class subs-kw
#:description "#:grammar keyword"
#:attributes (g (g.non-term-id 1) (g.non-term-form 2))
(pattern (~seq #:grammar g:grammar))
(pattern (~seq) #:with g:grammar #'()))
) )
(define-syntax (defform*/subs stx) (define-syntax (defform*/subs stx)
@ -104,21 +113,23 @@
(define-syntax (defform* stx) (define-syntax (defform* stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw d:id-kw l:literals-kw [spec ...] desc ...) [(_ k:kind-kw d:id-kw l:literals-kw [spec ...]
subs:subs-kw c:contracts-kw desc ...)
(syntax/loc stx (syntax/loc stx
(defform*/subs #:kind k.kind (defform*/subs #:kind k.kind
#:id [d.defined-id d.defined-id-expr] #:id [d.defined-id d.defined-id-expr]
#:literals (l.lit ...) #:literals (l.lit ...)
[spec ...] () desc ...))])) [spec ...] subs.g #:contracts c.cs desc ...))]))
(define-syntax (defform stx) (define-syntax (defform stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw d:id-kw l:literals-kw spec desc ...) [(_ k:kind-kw d:id-kw l:literals-kw spec
subs:subs-kw c:contracts-kw desc ...)
(syntax/loc stx (syntax/loc stx
(defform*/subs #:kind k.kind (defform*/subs #:kind k.kind
#:id [d.defined-id d.defined-id-expr] #:id [d.defined-id d.defined-id-expr]
#:literals (l.lit ...) #:literals (l.lit ...)
[spec] () desc ...))])) [spec] subs.g #:contracts c.cs desc ...))]))
(define-syntax (defform/subs stx) (define-syntax (defform/subs stx)
(syntax-parse stx (syntax-parse stx
@ -131,14 +142,20 @@
(define-syntax (defform/none stx) (define-syntax (defform/none stx)
(syntax-parse stx (syntax-parse stx
[(_ k:kind-kw l:literals-kw spec c:contracts-kw desc ...) [(_ k:kind-kw l:literals-kw spec subs:subs-kw c:contracts-kw desc ...)
(syntax/loc stx (syntax/loc stx
(with-togetherable-racket-variables (with-togetherable-racket-variables
(l.lit ...) (l.lit ...)
([form/none spec]) ([form/none spec]
[non-term (subs.g.non-term-id subs.g.non-term-form ...)] ...)
(*defforms k.kind #f (*defforms k.kind #f
'(spec) (list (lambda (ignored) (racketblock0/form spec))) '(spec)
null null (list (lambda (ignored) (racketblock0/form spec)))
'((subs.g.non-term-id subs.g.non-term-form ...) ...)
(list (list (lambda () (racket subs.g.non-term-id))
(lambda () (racketblock0/form subs.g.non-term-form))
...)
...)
(list (list (lambda () (racket c.contract-nonterm)) (list (list (lambda () (racket c.contract-nonterm))
(lambda () (racketblock0 c.contract-expr))) (lambda () (racketblock0 c.contract-expr)))
...) ...)
@ -203,9 +220,9 @@
(define-syntax (specsubform stx) (define-syntax (specsubform stx)
(syntax-parse stx (syntax-parse stx
[(_ l:literals-kw spec desc ...) [(_ l:literals-kw spec subs:subs-kw c:contracts-kw desc ...)
(syntax/loc stx (syntax/loc stx
(spec?form/subs #f #:literals (l.lit ...) spec () desc ...))])) (spec?form/subs #f #:literals (l.lit ...) spec subs.g #:contracts c.cs desc ...))]))
(define-syntax (specsubform/subs stx) (define-syntax (specsubform/subs stx)
(syntax-parse stx (syntax-parse stx
@ -221,12 +238,11 @@
(define-syntax-rule (specspecsubform/subs spec subs desc ...) (define-syntax-rule (specspecsubform/subs spec subs desc ...)
(make-blockquote "leftindent" (list (specsubform/subs spec subs desc ...)))) (make-blockquote "leftindent" (list (specsubform/subs spec subs desc ...))))
(define-syntax specform (define-syntax (specform stx)
(syntax-rules () (syntax-parse stx
[(_ #:literals (lit ...) spec desc ...) [(_ l:literals-kw spec subs:subs-kw c:contracts-kw desc ...)
(spec?form/subs #t #:literals (lit ...) spec () desc ...)] (syntax/loc stx
[(_ spec desc ...) (spec?form/subs #t #:literals (l.lit ...) spec subs.g #:contracts c.cs desc ...))]))
(specform #:literals () spec desc ...)]))
(define-syntax (specform/subs stx) (define-syntax (specform/subs stx)
(syntax-parse stx (syntax-parse stx

View File

@ -812,7 +812,7 @@ Examples:
@defform/subs[(defform maybe-kind maybe-id maybe-literals form-datum @defform/subs[(defform maybe-kind maybe-id maybe-literals form-datum
maybe-contracts maybe-grammar maybe-contracts
pre-flow ...) pre-flow ...)
([maybe-kind code:blank ([maybe-kind code:blank
(code:line #:kind kind-string-expr)] (code:line #:kind kind-string-expr)]
@ -821,6 +821,8 @@ Examples:
(code:line #:id [id id-expr])] (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-grammar code:blank
(code:line #:grammar ([nonterm-id clause-datum ...+] ...))]
[maybe-contracts code:blank [maybe-contracts code:blank
(code:line #:contracts ([subform-datum contract-expr-datum] (code:line #:contracts ([subform-datum contract-expr-datum]
...))])]{ ...))])]{
@ -856,19 +858,24 @@ non-terminal. If @racket[#:literals] clause is provided, however,
instances of the @racket[literal-id]s are typeset normally (i.e., as instances of the @racket[literal-id]s are typeset normally (i.e., as
determined by the enclosing context). determined by the enclosing context).
If a @racket[#:grammar] clause is provided, it includes an auxiliary
grammar of non-terminals shown with the @racket[id] form. Each
@racket[nonterm-id] is specified as being any of the corresponding
@racket[clause-datum]s.
If a @racket[#:contracts] clause is provided, each If a @racket[#:contracts] clause is provided, each
@racket[subform-datum] (typically an identifier that serves as a @racket[subform-datum] (typically an identifier that serves as a
meta-variable in @racket[form-datum]) is shown as producing a value meta-variable in @racket[form-datum] or @racket[clause-datum]) is
that must satisfy the contract described by shown as producing a value that must satisfy the contract described by
@racket[contract-expr-datum]. Use @racket[#:contracts] only to @racket[contract-expr-datum]. Use @racket[#:contracts] only to
specify constraints on a @emph{value} produced by an expression; specify constraints on a @emph{value} produced by an expression; for
for constraints on the @emph{syntax} of a @racket[subform-datum], constraints on the @emph{syntax} of a @racket[subform-datum], use
use grammar notation instead, possibly through an grammar notation instead, possibly through an auxiliary grammar
auxiliary grammar specified using @racket[defform/subs]. specified with @racket[#:grammar].
The typesetting of @racket[form-datum], @racket[subform-datum], and The typesetting of @racket[form-datum], @racket[clause-datum],
@racket[contract-expr-datum] preserves the source layout, like @racket[subform-datum], and @racket[contract-expr-datum] preserves the
@racket[racketblock]. source layout, like @racket[racketblock].
Examples: Examples:
@codeblock[#:keep-lang-line? #f]|{ @codeblock[#:keep-lang-line? #f]|{
@ -889,11 +896,22 @@ Examples:
the @racket[ingredient-expr]s will be mixed into the resulting the @racket[ingredient-expr]s will be mixed into the resulting
sandwich. sandwich.
} }
@defform[(sandwich-factory maybe-name factory-component ...)
#:grammar
[(maybe-name (code:line)
name)
(factory-component (code:line #:protein protein-expr)
[vegetable vegetable-expr])]]{
Constructs a sandwich factory. If @racket[maybe-name] is provided,
the factory will be named. Each of the @racket[factory-component]
clauses adds an additional ingredient to the sandwich pipeline.
}
}| }|
} }
@defform[(defform* maybe-kind maybe-id maybe-literals [form-datum ...+] @defform[(defform* maybe-kind maybe-id maybe-literals [form-datum ...+]
maybe-contracts maybe-grammar maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @racket[defform], but for multiple forms using the same Like @racket[defform], but for multiple forms using the same
@ -911,42 +929,9 @@ Examples:
}| }|
} }
@defform[(defform/subs maybe-kind maybe-id maybe-literals form-datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{
Like @racket[defform], but including an auxiliary grammar of @defform[(defform/none maybe-kind maybe-literal form-datum
non-terminals shown with the @racket[_id] form. Each maybe-grammar maybe-contracts
@racket[nonterm-id] is specified as being any of the corresponding
@racket[clause-datum]s, where the formatting of each
@racket[clause-datum] is preserved.
Examples:
@codeblock[#:keep-lang-line? #f]|{
#lang scribble/manual
@defform/subs[(sandwich-factory maybe-name factory-component ...)
[(maybe-name (code:line)
name)
(factory-component (code:line #:protein protein-expr)
[vegetable vegetable-expr])]]{
Constructs a sandwich factory. If @racket[maybe-name] is provided,
the factory will be named. Each of the @racket[factory-component]
clauses adds an additional ingredient to the sandwich pipeline.
}
}|
}
@defform[(defform*/subs maybe-kind maybe-id maybe-literals [form-datum ...+]
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{
Like @racket[defform/subs], but for multiple forms for @racket[_id].}
@defform[(defform/none maybe-kind maybe-literal form-datum maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @racket[defform], but without registering a definition.} Like @racket[defform], but without registering a definition.}
@ -966,7 +951,7 @@ inline element. Use this form sparingly, because the typeset form does
not stand out to the reader as a specification of @racket[id].} 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-grammar maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @racket[defform], but without indexing or registering a Like @racket[defform], but without indexing or registering a
@ -974,7 +959,7 @@ definition, and with indenting on the left for both the specification
and the @racket[pre-flow]s.} and the @racket[pre-flow]s.}
@defform[(specsubform maybe-literals datum maybe-contracts @defform[(specsubform maybe-literals datum maybe-grammar maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Similar to @racket[defform], but without any specific identifier being Similar to @racket[defform], but without any specific identifier being
@ -989,16 +974,7 @@ procedure. In this description, a reference to any identifier in
@racket[datum] is typeset as a sub-form non-terminal.} @racket[datum] is typeset as a sub-form non-terminal.}
@defform[(specsubform/subs maybe-literals datum @defform[(specspecsubform maybe-literals datum maybe-grammar maybe-contracts
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]{
Like @racket[specsubform], but with a grammar like
@racket[defform/subs].}
@defform[(specspecsubform maybe-literals datum maybe-contracts
pre-flow ...)]{ pre-flow ...)]{
Like @racket[specsubform], but indented an extra level. Since using Like @racket[specsubform], but indented an extra level. Since using
@ -1007,13 +983,47 @@ nests indentation, @racket[specspecsubform] is for extra indentation
without nesting a description.} without nesting a description.}
@deftogether[[
@defform[(defform/subs maybe-kind maybe-id maybe-literals form-datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]
@defform[(defform*/subs maybe-kind maybe-id maybe-literals [form-datum ...+]
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]
@defform[(specform/subs maybe-literals datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]
@defform[(specsubform/subs maybe-literals datum
([nonterm-id clause-datum ...+] ...)
maybe-contracts
pre-flow ...)]
@defform[(specspecsubform/subs maybe-literals datum @defform[(specspecsubform/subs maybe-literals datum
([nonterm-id clause-datum ...+] ...) ([nonterm-id clause-datum ...+] ...)
maybe-contracts maybe-contracts
pre-flow ...)]{ pre-flow ...)]]]{
Like @racket[specspecsubform], but with a grammar like Like @racket[defform], @racket[defform*], @racket[specform],
@racket[defform/subs].} @racket[specsubform], and @racket[specspecsubform], respectively, but
the auxiliary grammar is mandatory and the @racket[#:grammar] keyword
is omitted.
Examples:
@codeblock[#:keep-lang-line? #f]|{
#lang scribble/manual
@defform/subs[(sandwich-factory maybe-name factory-component ...)
[(maybe-name (code:line)
name)
(factory-component (code:line #:protein protein-expr)
[vegetable vegetable-expr])]]{
Constructs a sandwich factory. If @racket[maybe-name] is provided,
the factory will be named. Each of the @racket[factory-component]
clauses adds an additional ingredient to the sandwich pipeline.
}
}|
}
@defform[(defparam id arg-id contract-expr-datum pre-flow ...)]{ @defform[(defparam id arg-id contract-expr-datum pre-flow ...)]{