fix decoding of free-identifier=? alias information

This commit is contained in:
Matthew Flatt 2015-04-09 06:04:48 -06:00
parent 3d46070994
commit 8e617a6e5b
3 changed files with 12 additions and 8 deletions

View File

@ -1307,17 +1307,19 @@
(define (encode-binding b name ht) (define (encode-binding b name ht)
(match b (match b
[(free-id=?-binding base id) [(free-id=?-binding base id phase)
(hash-ref ht b (hash-ref ht b
(lambda () (lambda ()
(match b (match b
[(free-id=?-binding base id) [(free-id=?-binding base id phase)
(define bx (box #f)) (define bx (box #f))
(hash-set! ht b bx) (hash-set! ht b bx)
(set-box! bx (set-box! bx
(cons (encode-binding base name ht) (cons
(cons (stx-obj-datum id) (cons (encode-binding base name ht)
(stx-obj-wrap id))))])))] (cons (stx-obj-datum id)
(stx-obj-wrap id)))
phase))])))]
[_ [_
(hash-ref! ht b (hash-ref! ht b
(lambda () (lambda ()

View File

@ -1298,10 +1298,11 @@
(hash-ref! ht b (hash-ref! ht b
(lambda () (lambda ()
(match b (match b
[(box (cons base-b (cons sym wraps))) [(box (cons base-b (cons (cons sym wraps) phase)))
(free-id=?-binding (free-id=?-binding
(decode-binding base-b ht) (decode-binding base-b ht)
(stx-obj sym wraps 'clean))] (stx-obj sym (decode-wrap wraps ht) 'clean)
phase)]
[(? symbol?) [(? symbol?)
(local-binding b)] (local-binding b)]
[else [else

View File

@ -205,7 +205,8 @@
(define-form-struct binding ()) (define-form-struct binding ())
(define-form-struct (free-id=?-binding binding) ([base (and/c binding? (define-form-struct (free-id=?-binding binding) ([base (and/c binding?
(not/c free-id=?-binding?))] (not/c free-id=?-binding?))]
[id stx-obj?])) [id stx-obj?]
[phase (or/c #f exact-integer?)]))
(define-form-struct (local-binding binding) ([name symbol?])) (define-form-struct (local-binding binding) ([name symbol?]))
(define-form-struct (module-binding binding) ([encoded any/c])) (define-form-struct (module-binding binding) ([encoded any/c]))
;; Convert `module-binding` to `decoded-module-binding` with `decode-module-binding`: ;; Convert `module-binding` to `decoded-module-binding` with `decode-module-binding`: