syntax/parse: speed up free-identifier=?/phases when phases are same

This commit is contained in:
Ryan Culpepper 2011-09-06 02:07:01 -06:00
parent 15e3640191
commit 68e76a9876

View File

@ -273,23 +273,27 @@
;; 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 ([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
;; Module is only way to get phase-shift; if not module-bound names,
;; then only identifiers at same phase can refer to same binding.
(and (equal? phase-x phase-y)
(free-identifier=? x y phase-x))])))
(cond [(eqv? phase-x phase-y)
(free-identifier=? x y phase-x)]
[else
(let ([bx (identifier-binding x phase-x)]
[by (identifier-binding y phase-y)])
(cond [(and (pair? bx) (pair? by))
(let ([mpix (first bx)]
[namex (second bx)]
[defphasex (fifth bx)]
[mpiy (first by)]
[namey (second by)]
[defphasey (fifth by)])
(and (eq? namex namey)
;; resolved-module-paths are interned
(eq? (module-path-index-resolve mpix)
(module-path-index-resolve mpiy))
(eqv? defphasex defphasey)))]
[else
;; Module is only way to get phase-shift; phases differ, so
;; if not module-bound names, no way can refer to same binding.
#f]))]))
;; ----