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

syntax/parse: support pvar:literal patterns

Browse Source
This commit is contained in:
Ryan Culpepper 2014-10-01 01:02:24 -04:00
parent e1e2e7e5da
commit b2c6022989
3 changed files with 30 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/racket-pkgs/racket-doc/syntax/scribblings/parse/patterns.scrbl
View File

@ -36,6 +36,7 @@ means specifically @tech{@Spattern}.
[S-pattern
pvar-id
pvar-id:syntax-class-id
pvar-id:literal-id
literal-id
(@#,ref[~var s-] id)
(@#,ref[~var s+] id syntax-class-id maybe-role)
@ -241,6 +242,18 @@ An identifier can be either a @tech{pattern variable}, an
@svar[pvar-id].
}
@item{If @racket[id] is of the form @racket[_pvar-id:literal-id],
where @racket[_literal-id] is in the literals list, then it is
equivalent to @racket[(~and (~var _pvar-id) literal-id)].
@myexamples[
(require (only-in racket/base [define def]))
(syntax-parse #'(def x 7)
#:literals (define)
[(d:define var:id body:expr) #'d])
]
}
@item{Otherwise, @racket[id] is a @tech{pattern variable}, and the
pattern is equivalent to @racket[(~var id)].
}

14
racket/collects/syntax/parse/private/rep-data.rkt
View File

@ -252,7 +252,7 @@ expressions are duplicated, and may be evaluated in different scopes.
stxclass?)]
[split-id/get-stxclass
(-> identifier? DeclEnv/c
(values identifier? (or/c stxclass? #f)))])
(values identifier? (or/c stxclass? den:lit? den:datum-lit? #f)))])
;; stxclass-lookup-config : (parameterof (U 'no 'try 'yes))
;; 'no means don't lookup, always use dummy (no nested attrs)
@ -288,12 +288,16 @@ expressions are duplicated, and may be evaluated in different scopes.
=> (lambda (m)
(define id
(datum->syntax id0 (string->symbol (cadr m)) id0 id0))
(define scname
(define suffix
(datum->syntax id0 (string->symbol (caddr m)) id0 id0))
(declenv-check-unbound decls id (syntax-e scname)
(declenv-check-unbound decls id (syntax-e suffix)
#:blame-declare? #t)
(let ([sc (get-stxclass/check-arity scname id0 0 null)])
(values id sc)))]
(let ([suffix-entry (declenv-lookup decls suffix)])
(cond [(or (den:lit? suffix-entry) (den:datum-lit? suffix-entry))
(values id suffix-entry)]
[else
(let ([sc (get-stxclass/check-arity suffix id0 0 null)])
(values id sc))])))]
[else (values id0 #f)]))
;; ----

11
racket/collects/syntax/parse/private/rep.rkt
View File

@ -686,9 +686,14 @@
[(not (safe-name? id))
(wrong-syntax id "expected identifier not starting with ~~ character")]
[else
(let-values ([(name sc) (split-id/get-stxclass id decls)])
(cond [sc
(parse-pat:var* id allow-head? name sc no-arguments "." #f #f)]
(let-values ([(name suffix) (split-id/get-stxclass id decls)])
(cond [(stxclass? suffix)
(parse-pat:var* id allow-head? name suffix no-arguments "." #f #f)]
[(or (den:lit? suffix) (den:datum-lit? suffix))
(create-pat:and
(list
(create-pat:var name #f no-arguments null #f #t #f)
(parse-pat:id/entry id decls allow-head? suffix)))]
[(declenv-apply-conventions decls id)
=> (lambda (entry) (parse-pat:id/entry id decls allow-head? entry))]
[else (create-pat:var name #f no-arguments null #f #t #f)]))]))