suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/parse: added head ~optional pattern, improved docs

Browse Source 
svn: r15906
This commit is contained in:
Ryan Culpepper 2009-09-07 23:32:41 +00:00
parent 8f24d026d6
commit ee41d24bb9
4 changed files with 111 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/syntax/private/stxparse/parse.ss
View File

@ -308,6 +308,17 @@
(let ([sub-id alt-sub-id] ...)
(success pre ... id ...))))))]))
;; (disjunct (clause:attr ...) id (expr ...) (id ...)) : expr
(define-syntax (disjunct/sides stx)
(syntax-case stx ()
[(disjunct/sides clauses success (pre ...) (id ...))
(with-syntax ([(#s(clause:attr #s(attr sub-id _ _) _) ...) #'clauses])
(with-syntax ([(alt-sub-id ...) (generate-temporaries #'(sub-id ...))])
#`(let ([alt-sub-id (attribute sub-id)] ...)
(let ([id #f] ...)
(let ([sub-id alt-sub-id] ...)
(success pre ... id ...))))))]))
(begin-for-syntax
;; convert-list-pattern : ListPattern id -> SinglePattern
;; Converts '() datum pattern at end of list to bind (cons stx index)
@ -382,6 +393,22 @@
#'pattern
#'#s(internal-rest-pattern rest index index0))])
#'(parse:S x fc pattern k)))]
[#s(hpat:optional (a ...) pattern defaults)
(with-syntax ([(#s(attr id _ _) ...) #'(a ...)]
[index0 (frontier->index-expr (wash #'fc))])
#`(let ([success
(lambda (rest index fail id ...)
(with-enclosing-fail fail
(let-attributes ([a id] ...) k)))])
(try (parse:H x fc pattern rest index
(success rest index enclosing-fail (attribute id) ...))
(let ([rest x]
[index index0])
(convert-sides x defaults
(clause-success ()
(disjunct/sides defaults success
(rest index enclosing-fail)
(id ...))))))))]
[_
(with-syntax ([attrs (pattern-attrs (wash #'head))]
[index0 (frontier->index-expr (wash #'fc))])

12
collects/syntax/private/stxparse/rep-patterns.ss
View File

@ -30,8 +30,8 @@ A SinglePattern is one of
(make-pat:compound SPBase Kind (listof SinglePattern))
(make-pat:cut SPBase SinglePattern)
(make-pat:describe SPBase stx boolean SinglePattern)
(make-pat:bind SPBase (listof clause:attr))
(make-pat:fail SPBase stx stx)
(make-pat:bind SPBase (listof clause:attr))
A ListPattern is a subtype of SinglePattern; one of
(make-pat:datum SPBase '())
@ -53,9 +53,8 @@ A ListPattern is a subtype of SinglePattern; one of
(define-struct pat:compound (attrs kind patterns) #:prefab)
(define-struct pat:cut (attrs pattern) #:prefab)
(define-struct pat:describe (attrs description transparent? pattern) #:prefab)
(define-struct pat:bind (attrs clauses) #:prefab)
(define-struct pat:fail (attrs when message) #:prefab)
(define-struct pat:bind (attrs clauses) #:prefab)
#|
A HeadPattern is one of
@ -63,12 +62,14 @@ A HeadPattern is one of
(make-hpat:seq HPBase ListPattern)
(make-hpat:or HPBase (listof HeadPattern))
(make-hpat:describe HPBase stx/#f boolean HeadPattern)
(make-hpat:optional HPBase HeadPattern (listof clause:attr))
|#
(define-struct hpat:ssc (attrs parser description bind-term? bind-attrs?) #:prefab)
(define-struct hpat:seq (attrs inner) #:prefab)
(define-struct hpat:or (attrs patterns) #:prefab)
(define-struct hpat:describe (attrs description transparent? pattern) #:prefab)
(define-struct hpat:optional (attrs inner defaults) #:prefab)
#|
An EllipsisHeadPattern is
@ -114,7 +115,8 @@ A Kind is one of
(or (hpat:ssc? x)
(hpat:seq? x)
(hpat:or? x)
(hpat:describe? x)))
(hpat:describe? x)
(hpat:optional? x)))
(define (ellipsis-head-pattern? x)
(ehpat? x))
@ -143,5 +145,5 @@ A Kind is one of
(mk-get-attrs pat:name pat:any pat:sc pat:datum pat:literal pat:head
pat:dots pat:and pat:or pat:compound pat:cut pat:describe
pat:bind pat:fail
hpat:ssc hpat:seq hpat:or hpat:describe
hpat:ssc hpat:seq hpat:or hpat:describe hpat:optional
ehpat)))

26
collects/syntax/private/stxparse/rep.ss
View File

@ -306,7 +306,7 @@
;; parse-head-pattern : stx DeclEnv -> HeadPattern
(define (parse-head-pattern stx decls)
(syntax-case stx (~or ~seq ~describe)
(syntax-case stx (~or ~seq ~describe ~optional)
[id
(and (identifier? #'id) (not (reserved? #'id)))
(parse-pat:id stx decls #t)]
@ -316,6 +316,8 @@
(parse-hpat:seq stx #'rest decls)]
[(~describe . rest)
(parse-pat:describe stx decls #t)]
[(~optional . rest)
(parse-hpat:optional stx decls)]
[_
(parse-single-pattern stx decls)]))
@ -567,7 +569,18 @@
[else
(wrong-syntax stx "expected proper list pattern")]))
(define (parse-hpat:optional stx decls)
(define-values (head all-iattrs _name _tmm defaults)
(parse-optional-pattern stx decls h-optional-directive-table))
(make hpat:optional all-iattrs head defaults))
(define (parse-ehpat/optional stx decls)
(define-values (head all-iattrs name too-many-msg defaults)
(parse-optional-pattern stx decls eh-optional-directive-table))
(make ehpat all-iattrs head
(make rep:optional name too-many-msg defaults)))
(define (parse-optional-pattern stx decls optional-directive-table)
(syntax-case stx (~optional)
[(~optional p . options)
(let ([head (parse-head-pattern #'p decls)])
@ -587,8 +600,7 @@
(define all-iattrs
(union-iattrs (list pattern-iattrs defaults-iattrs)))
(check-iattrs-subset defaults-iattrs pattern-iattrs stx)
(make ehpat all-iattrs head
(make rep:optional name too-many-msg defaults))))]))
(values head all-iattrs name too-many-msg defaults)))]))
(define (parse-ehpat/once stx decls)
(syntax-case stx (~once)
@ -876,8 +888,12 @@
(define describe-option-table
(list (list '#:transparent)))
;; optional-directive-table
(define optional-directive-table
;; eh-optional-directive-table
(define eh-optional-directive-table
(list (list '#:too-many check-expression)
(list '#:name check-expression)
(list '#:defaults check-bind-clause-list)))
;; h-optional-directive-table
(define h-optional-directive-table
(list (list '#:defaults check-bind-clause-list)))

79
collects/syntax/scribblings/parse.scrbl
View File

@ -12,16 +12,31 @@
@(define ellipses @scheme[...])
@(begin
(define (fixup exn)
(let ([src (ormap values (exn:fail:syntax-exprs exn))])
(if src
(make-exn:fail:syntax
(format "~a at: ~a" (exn-message exn) (syntax->datum src))
(exn-continuation-marks exn)
(exn:fail:syntax-exprs exn))
exn)))
(define the-eval
(parameterize ((sandbox-output 'string)
(sandbox-error-output 'string))
(sandbox-error-output 'string)
(sandbox-make-code-inspector current-code-inspector)
(sandbox-eval-handlers
(list #f
(lambda (thunk)
(with-handlers ([exn:fail:syntax?
(lambda (e) (raise (fixup e)))])
(thunk))))))
(make-evaluator 'scheme/base
#:requires '(syntax/parse (for-syntax scheme/base)))))
(the-eval '(error-print-source-location #f))
(define-syntax-rule (myexamples e ...)
(parameterize ((error-print-source-location #f))
(examples #:eval the-eval e ...))))
(examples #:eval the-eval e ...)))
@title[#:tag "stxparse"]{Parsing and classifying syntax}
@title[#:tag "stxparse" #:style '(toc)]{Parsing and classifying syntax}
The @schememodname[syntax/parse] library provides a framework for
describing and parsing syntax. Using @schememodname[syntax/parse],
@ -32,6 +47,8 @@ which offers many improvements over @scheme[syntax-case].
@defmodule[syntax/parse]
@local-table-of-contents[]
@;{----------}
@section{Parsing syntax}
@ -59,25 +76,33 @@ subterms of the syntax object and that clause's side conditions and
If the syntax object fails to match any of the patterns (or all
matches fail the corresponding clauses' side conditions), a syntax
error is raised. If the @scheme[#:context] argument is given,
@scheme[context-expr] is used in reporting the error.
@scheme[context-expr] is used in reporting the error; otherwise
@scheme[stx-expr] is used.
@(myexamples
(syntax-parse #'(a b 3)
[(x:id ...) 'ok])
(syntax-parse #'(a b 3)
#:context #'(lambda (a b 3) (+ a b))
[(x:id ...) 'ok]))
The @scheme[#:literals] option specifies identifiers that should match
as literals, rather than simply being pattern variables. A literal in
the literals list has two components: the identifier used within the
pattern to signify the positions to be matched (@scheme[pattern-id]),
and the identifier expected to occur in those positions
(@scheme[literal-id]). If the single-identifier form is used, the same
identifier is used for both purposes.
as @tech{literals}, rather than simply being @tech{pattern
variables}. A literal in the literals list has two components: the
identifier used within the pattern to signify the positions to be
matched (@scheme[pattern-id]), and the identifier expected to occur in
those positions (@scheme[literal-id]). If the single-identifier form
is used, the same identifier is used for both purposes.
@bold{Note:} Unlike @scheme[syntax-case], @scheme[syntax-parse]
requires all literals to have a binding. To match identifiers by their
symbolic names, consider using the @scheme[atom-in-list] syntax class
instead.
Many literals can be declared at once via one or more @tech{literal sets},
imported with the @scheme[#:literal-sets] option. The literal-set
definition determines the literal identifiers to recognize and the
names used in the patterns to recognize those literals.
Many literals can be declared at once via one or more @tech{literal
sets}, imported with the @scheme[#:literal-sets] option. The
literal-set definition determines the literal identifiers to recognize
and the names used in the patterns to recognize those literals.
The @scheme[#:conventions] option imports @tech{convention}s that give
default syntax classes to pattern variables that do not explicitly
@ -167,9 +192,9 @@ like the following form.
@specsubform[pvar-id:syntax-class-id]{
Matches only subterms specified by the @svar[syntax-class-id]. The
syntax class's attributes are computed for the subterm and bound to
the pattern variables formed by prefixing @svar[pvar-id.] to the
name of the attribute. @svar[pvar-id] is bound to the matched
syntax class's @tech{attributes} are computed for the subterm and
bound to the pattern variables formed by prefixing @svar[pvar-id.] to
the name of the attribute. @svar[pvar-id] is bound to the matched
subterm.
If @svar[pvar-id] is @scheme[_], no attributes are bound.
@ -179,19 +204,27 @@ If @svar[pvar-id] is empty (that is, if the pattern is of the form
bound, but their names are not prefixed first.
@myexamples[
(syntax-parse #'x
(syntax-parse #'a
[var:id (syntax-e #'var)])
(syntax-parse #'12
[var:id (syntax-e #'var)])
(syntax-parse #'(x y z)
[var:id (syntax-e #'var)])]
(define-syntax-class two
#:attributes (x y)
(pattern (x y)))
(syntax-parse #'(a b)
[t:two (syntax->datum #'(t t.x t.y))])
(syntax-parse #'(a b)
[t
#:declare t two
(syntax->datum #'(t t.x t.y))])]
}
@specsubform[literal-id]{
An identifier that appears in the literals list is not a pattern
variable; instead, it is a literal that matches any identifier
@scheme[free-identifier=?] to it.
variable; instead, it is a @deftech{literal} that matches any
identifier @scheme[free-identifier=?] to it.
Specifically, if @scheme[literal-id] is the ``pattern'' name of an
entry in the literals list, then it represents a pattern that matches