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

trim some fat from module-variable references

Browse Source 
svn: r12833

original commit: cf8b75939b
This commit is contained in:
Matthew Flatt 2008-12-13 17:38:14 +00:00
parent 34af15866c
commit 0e41ae2e49
2 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/compiler/decompile.ss
View File

@ -57,7 +57,8 @@
(values (append (values (append
(map (lambda (tl) (map (lambda (tl)
(match tl (match tl
[(? symbol?) '#%linkage] [#f '#%linkage]
[(? symbol?) (string->symbol (format "_~a" tl))]
[(struct global-bucket (name)) [(struct global-bucket (name))
(string->symbol (format "_~a" name))] (string->symbol (format "_~a" name))]
[(struct module-variable (modidx sym pos phase)) [(struct module-variable (modidx sym pos phase))

22
collects/compiler/zo-parse.ss
View File

@ -85,15 +85,10 @@
(define (read-variable v) (define (read-variable v)
(if (symbol? v) (if (symbol? v)
(make-global-bucket v) (make-global-bucket v)
(let-values ([(phase modname varname) (error "expected a symbol")))
(match v
[(list* phase modname varname) (define (do-not-read-variable v)
(values phase modname varname)] (error "should not get here"))
[(list* modname varname)
(values 0 modname varname)])])
(if (and (zero? phase) (eq? modname '#%kernel))
(error 'bucket "var ~a" varname)
(make-module-variable modname varname -1 phase)))))
(define (read-compilation-top v) (define (read-compilation-top v)
(match v (match v
@ -198,6 +193,7 @@
,rename ,max-let-depth ,dummy ,rename ,max-let-depth ,dummy
,prefix ,kernel-exclusion ,reprovide-kernel? ,prefix ,kernel-exclusion ,reprovide-kernel?
,indirect-provides ,num-indirect-provides ,indirect-provides ,num-indirect-provides
,indirect-syntax-provides ,num-indirect-syntax-provides
,indirect-et-provides ,num-indirect-et-provides ,indirect-et-provides ,num-indirect-et-provides
,protects ,et-protects ,protects ,et-protects
,provide-phase-count . ,rest) ,provide-phase-count . ,rest)
@ -282,7 +278,7 @@
(cons 'with-cont-mark-type read-with-cont-mark) (cons 'with-cont-mark-type read-with-cont-mark)
(cons 'quote-syntax-type read-topsyntax) (cons 'quote-syntax-type read-topsyntax)
(cons 'variable-type read-variable) (cons 'variable-type read-variable)
(cons 'module-variable-type read-variable) (cons 'module-variable-type do-not-read-variable)
(cons 'compilation-top-type read-compilation-top) (cons 'compilation-top-type read-compilation-top)
(cons 'case-lambda-sequence-type read-case-lambda) (cons 'case-lambda-sequence-type read-case-lambda)
(cons 'begin0-sequence-type read-sequence) (cons 'begin0-sequence-type read-sequence)
@ -719,7 +715,11 @@
(let ([mod (read-compact cp)] (let ([mod (read-compact cp)]
[var (read-compact cp)] [var (read-compact cp)]
[pos (read-compact-number cp)]) [pos (read-compact-number cp)])
(make-module-variable mod var pos 0))] (let-values ([(mod-phase pos)
(if (= pos -2)
(values 1 (read-compact-number cp))
(values 0 pos))])
(make-module-variable mod var pos mod-phase)))]
[(local-unbox) [(local-unbox)
(let* ([p* (read-compact-number cp)] (let* ([p* (read-compact-number cp)]
[p (if (< p* 0) [p (if (< p* 0)