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

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

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

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

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