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

fix unmarshal of top-level "root" scope

Browse Source 
Closes #9
This commit is contained in:
Matthew Flatt 2016-01-03 06:40:14 -07:00
parent cfc28ee82a
commit 423feb1e21
1 changed files with 51 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
zo-lib/compiler/zo-parse.rkt
View File

@ -1175,7 +1175,7 @@
(struct-copy prefix p [stxs (map walk s)])] (struct-copy prefix p [stxs (map walk s)])]
[(req rs _) [(req rs _)
(struct-copy req p (struct-copy req p
[reqs (map walk rs)])] [reqs (walk rs)])]
[(? mod?) [(? mod?)
(struct-copy mod p (struct-copy mod p
[prefix (walk (mod-prefix p))] [prefix (walk (mod-prefix p))]
@ -1298,53 +1298,56 @@
[_ (error 'decode-wrap "bad shift")])))) [_ (error 'decode-wrap "bad shift")]))))
(define (decode-scope s ht) (define (decode-scope s ht)
(hash-ref ht s (or
(lambda () (and (eq? s root-scope)
(unless (encoded-scope? s) s)
(error 'decode-wrap "bad scope: ~e" s)) (hash-ref ht s
(define v (encoded-scope-content s)) (lambda ()
(define kind (unless (encoded-scope? s)
(match v (error 'decode-wrap "bad scope: ~e" s))
[(? number?) v] (define v (encoded-scope-content s))
[(cons (? number?) _) (define kind
(car v)] (match v
[else (error 'decode-wrap "bad scope")])) [(? number?) v]
(define sc (scope (encoded-scope-relative-id s) [(cons (? number?) _)
(case kind (car v)]
[(0 1) 'module] [else (error 'decode-wrap "bad scope")]))
[(2) 'macro] (define sc (scope (encoded-scope-relative-id s)
[(3) 'local] (case kind
[(4) 'intdef] [(0 1) 'module]
[else 'use-site]) [(2) 'macro]
null [(3) 'local]
null [(4) 'intdef]
#f)) [else 'use-site])
(hash-set! ht s sc) null
(unless (number? v) null
(define-values (bulk-bindings end) #f))
(let loop ([l (cdr v)] [bulk-bindings null]) (hash-set! ht s sc)
(cond (unless (number? v)
[(pair? l) (define-values (bulk-bindings end)
(loop (cdr l) (cons (list (decode-scope-set (caar l) ht) (let loop ([l (cdr v)] [bulk-bindings null])
(decode-bulk-import (cdar l) ht)) (cond
bulk-bindings))] [(pair? l)
[else (values (reverse bulk-bindings) l)]))) (loop (cdr l) (cons (list (decode-scope-set (caar l) ht)
(set-scope-bulk-bindings! sc bulk-bindings) (decode-bulk-import (cdar l) ht))
(unless (and (vector? end) bulk-bindings))]
(even? (vector-length end))) [else (values (reverse bulk-bindings) l)])))
(error 'decode-wrap "bad scope")) (set-scope-bulk-bindings! sc bulk-bindings)
(define bindings (unless (and (vector? end)
(let loop ([i 0]) (even? (vector-length end)))
(cond (error 'decode-wrap "bad scope"))
[(= i (vector-length end)) null] (define bindings
[else (let loop ([i 0])
(append (for/list ([p (in-list (vector-ref end (add1 i)))]) (cond
(list (vector-ref end i) [(= i (vector-length end)) null]
(decode-scope-set (car p) ht) [else
(decode-binding (cdr p) ht))) (append (for/list ([p (in-list (vector-ref end (add1 i)))])
(loop (+ i 2)))]))) (list (vector-ref end i)
(set-scope-bindings! sc bindings)) (decode-scope-set (car p) ht)
sc))) (decode-binding (cdr p) ht)))
(loop (+ i 2)))])))
(set-scope-bindings! sc bindings))
sc))))
(define (decode-scope-set l ht) (define (decode-scope-set l ht)
(decode-map decode-scope l ht)) (decode-map decode-scope l ht))