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

syntax/parse: fixed bug in litsets at higher phases

Browse Source
This commit is contained in:
Ryan Culpepper 2010-06-02 17:19:12 -06:00
parent 4e54ae0c02
commit b2196cc595
2 changed files with 27 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/syntax/private/stxparse/runtime.rkt
View File

@ -601,13 +601,9 @@ An Expectation is one of
;;
(provide phase+
check-literal
(provide check-literal
free-identifier=?/phases)
(define (phase+ a b)
(and (number? a) (number? b) (+ a b)))
;; check-literal : id phase-level stx -> void
;; FIXME: change to normal 'error', if src gets stripped away
(define (check-literal id phase ctx)
@ -621,23 +617,22 @@ An Expectation is one of
;; that y has at phase-level y.
;; At least one of the identifiers MUST have a binding (module or lexical)
(define (free-identifier=?/phases x phase-x y phase-y)
(let ([base-phase (syntax-local-phase-level)])
(let ([bx (identifier-binding x (phase+ base-phase phase-x))]
[by (identifier-binding y (phase+ base-phase phase-y))])
(cond [(and (list? bx) (list? by))
(let ([modx (module-path-index-resolve (first bx))]
[namex (second bx)]
[phasex (fifth bx)]
[mody (module-path-index-resolve (first by))]
[namey (second by)]
[phasey (fifth by)])
(and (eq? modx mody) ;; resolved-module-paths are interned
(eq? namex namey)
(equal? phasex phasey)))]
[else
;; One must be lexical (can't be #f, since one must be bound)
;; lexically-bound names bound in only one phase; just compare
(free-identifier=? x y)]))))
(let ([bx (identifier-binding x phase-x)]
[by (identifier-binding y phase-y)])
(cond [(and (list? bx) (list? by))
(let ([modx (module-path-index-resolve (first bx))]
[namex (second bx)]
[phasex (fifth bx)]
[mody (module-path-index-resolve (first by))]
[namey (second by)]
[phasey (fifth by)])
(and (eq? modx mody) ;; resolved-module-paths are interned
(eq? namex namey)
(equal? phasex phasey)))]
[else
;; One must be lexical (can't be #f, since one must be bound)
;; lexically-bound names bound in only one phase; just compare
(free-identifier=? x y)])))
;; ----

15
collects/syntax/private/stxparse/sc.rkt
View File

@ -151,11 +151,7 @@
(with-syntax ([((internal external) ...) lits])
#`(begin
(define phase-of-literals
(let ([phase-of-module-instantiation
;; Hack to get enclosing module's base phase
(variable-reference->phase (#%variable-reference))])
(- phase-of-module-instantiation
'#,(if (zero? phase-of-definition) 0 1))))
(phase-of-enclosing-module))
(define-syntax name
(make-literalset
(list (list 'internal (quote-syntax external)) ...)
@ -166,6 +162,15 @@
(raise-syntax-error #f "literal is unbound in phase 0"
(quote-syntax #,stx) x))))))))]))
(define-syntax (phase-of-enclosing-module stx)
(syntax-case stx ()
[(poem)
(let ([phase-within-module (syntax-local-phase-level)])
#`(let ([phase-of-this-expression
(variable-reference->phase (#%variable-reference))])
(- phase-of-this-expression
#,(if (zero? phase-within-module) 0 1))))]))
#|
Literal sets: The goal is for literals to refer to their bindings at