syntax/parse: fixed bug in litsets at higher phases
This commit is contained in:
parent
4e54ae0c02
commit
b2196cc595
|
@ -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)])))
|
||||
|
||||
;; ----
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user