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

syntax/parse: conventions have lowest priority

Browse Source
This commit is contained in:
Ryan Culpepper 2014-10-01 00:04:42 -04:00
parent 462bf4b399
commit e1e2e7e5da
2 changed files with 28 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -120,16 +120,17 @@ expressions are duplicated, and may be evaluated in different scopes.
(bound-id-table-set table id literal)))])
(make-declenv table conventions)))
(define (declenv-lookup env id #:use-conventions? [use-conventions? #t])
(or (bound-id-table-ref (declenv-table env) id #f)
(and use-conventions?
(conventions-lookup (declenv-conventions env) id))))
(define (declenv-lookup env id)
(bound-id-table-ref (declenv-table env) id #f))
(define (declenv-apply-conventions env id)
(conventions-lookup (declenv-conventions env) id))
(define (declenv-check-unbound env id [stxclass-name #f]
#:blame-declare? [blame-declare? #f])
;; Order goes: literals, pattern, declares
;; So blame-declare? only applies to stxclass declares
(let ([val (declenv-lookup env id #:use-conventions? #f)])
(let ([val (declenv-lookup env id)])
(match val
[(den:lit _i _e _ip _lp)
(wrong-syntax id "identifier previously declared as literal")]
@ -229,7 +230,9 @@ expressions are duplicated, and may be evaluated in different scopes.
[#:conventions list?]
DeclEnv/c)]
[declenv-lookup
(->* [DeclEnv/c identifier?] [#:use-conventions? any/c] any)]
(-> DeclEnv/c identifier? any)]
[declenv-apply-conventions
(-> DeclEnv/c identifier? any)]
[declenv-put-stxclass
(-> DeclEnv/c identifier? identifier? arguments? (or/c syntax? #f)
DeclEnv/c)]

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

@ -439,11 +439,11 @@
;; Conventions to not shadow pattern-form bindings, under the
;; theory that conventions only apply to things already determined
;; to be pattern variables.
(not (declenv-lookup decls id #:use-conventions? #f)))
(not (declenv-lookup decls id)))
;; suitable as id=? argument to syntax-case*
(define ((make-not-shadowed-id=? decls) lit-id pat-id)
(and (free-identifier=? lit-id pat-id)
(not (declenv-lookup decls pat-id #:use-conventions? #f))))
(not (declenv-lookup decls pat-id))))
;; parse-*-pattern : stx DeclEnv boolean boolean -> Pattern
(define (parse-*-pattern stx decls allow-head? allow-action?)
@ -681,7 +681,21 @@
"not allowed within ~~not pattern"))))
(define (parse-pat:id id decls allow-head?)
(define entry (declenv-lookup decls id))
(cond [(declenv-lookup decls id)
=> (lambda (entry) (parse-pat:id/entry id decls allow-head? entry))]
[(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)]
[(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)]))]))
;; parse-pat:id/entry : Identifier .... DeclEntry -> SinglePattern
;; Handle when meaning of identifier pattern is given by declenv entry.
(define (parse-pat:id/entry id decls allow-head? entry)
(match entry
[(den:lit internal literal input-phase lit-phase)
(create-pat:literal literal input-phase lit-phase)]
@ -706,14 +720,8 @@
(parse-pat:id/s id parser no-arguments attrs commit? "." #f)])]
[(den:delayed parser class)
(let ([sc (get-stxclass class)])
(parse-pat:var* id allow-head? id sc no-arguments "." #f parser))]
['#f
(unless (safe-name? id)
(wrong-syntax id "expected identifier not starting with ~~ character"))
(let-values ([(name sc) (split-id/get-stxclass id decls)])
(if sc
(parse-pat:var* id allow-head? name sc no-arguments "." #f #f)
(create-pat:var name #f no-arguments null #f #t #f)))]))
(parse-pat:var* id allow-head? id sc no-arguments "." #f parser))]))
(define (parse-pat:var stx decls allow-head?)
(define name0