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

update for inspector descriptor in prefix bytecode

Browse Source
This commit is contained in:
Matthew Flatt 2015-03-11 18:36:26 -06:00
parent 29d86bcaac
commit bbfdc73e5d
6 changed files with 32 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler-lib/compiler/decompile.rkt
View File

@ -126,7 +126,7 @@
(define (decompile-prefix a-prefix stx-ht)
(match a-prefix
[(struct prefix (num-lifts toplevels stxs))
[(struct prefix (num-lifts toplevels stxs src-insp-desc))
(let ([lift-ids (for/list ([i (in-range num-lifts)])
(gensym 'lift))]
[stx-ids (map (lambda (i) (gensym 'stx))
@ -169,12 +169,14 @@
(length toplevels)
(length stxs)
num-lifts)
(map (lambda (stx id)
`(define ,id ,(if stx
`(#%decode-syntax
,(decompile-stx (stx-encoded stx) stx-ht))
#f)))
stxs stx-ids)))]
(cons
`(quote inspector ,src-insp-desc)
(map (lambda (stx id)
`(define ,id ,(if stx
`(#%decode-syntax
,(decompile-stx (stx-encoded stx) stx-ht))
#f)))
stxs stx-ids))))]
[else (error 'decompile-prefix "huh?: ~e" a-prefix)]))
(define (decompile-stx stx stx-ht)
@ -216,7 +218,8 @@
(define (decompile-module mod-form orig-stack stx-ht mod-name)
(match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported
[(struct mod (name srcname self-modidx
prefix provides requires body syntax-bodies unexported
max-let-depth dummy lang-info
internal-context binding-names
flags pre-submodules post-submodules))

10
compiler-lib/compiler/demodularizer/merge.rkt
View File

@ -54,12 +54,13 @@
(define (merge-prefix root-prefix mod-prefix)
(match root-prefix
[(struct prefix (root-num-lifts root-toplevels root-stxs))
[(struct prefix (root-num-lifts root-toplevels root-stxs root-src-insp-desc))
(match mod-prefix
[(struct prefix (mod-num-lifts mod-toplevels mod-stxs))
[(struct prefix (mod-num-lifts mod-toplevels mod-stxs src-insp-desc))
(make-prefix (+ root-num-lifts mod-num-lifts)
(append root-toplevels mod-toplevels)
(append root-stxs mod-stxs))])]))
(append root-stxs mod-stxs)
root-src-insp-desc)])]))
(struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent)
@ -121,7 +122,8 @@
(define (merge-module max-let-depth top-prefix mod-form)
(match mod-form
[(struct mod (name srcname self-modidx mod-prefix provides requires body syntax-bodies
[(struct mod (name srcname self-modidx
mod-prefix provides requires body syntax-bodies
unexported mod-max-let-depth dummy lang-info
internal-context binding-names
flags pre-submodules post-submodules))

6
compiler-lib/compiler/demodularizer/nodep.rkt
View File

@ -139,7 +139,8 @@
(define (nodep-module mod-form phase)
(match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies
[(struct mod (name srcname self-modidx
prefix provides requires body syntax-bodies
unexported max-let-depth dummy lang-info
internal-context binding-names
flags pre-submodules post-submodules))
@ -158,7 +159,8 @@
(append (requires->modlist requires phase)
(if (and phase (zero? phase))
(begin (log-debug (format "[~S] lang-info : ~S" name lang-info)) ; XXX Seems to always be #f now
(list (make-mod name srcname self-modidx new-prefix provides requires body empty
(list (make-mod name srcname self-modidx
new-prefix provides requires body empty
unexported max-let-depth dummy lang-info internal-context #hash()
empty empty empty)))
(begin (log-debug (format "[~S] Dropping module @ ~S" name phase))

12
zo-lib/compiler/zo-marshal.rkt
View File

@ -639,12 +639,13 @@
(let ([pos ((out-shared-index out) v #:error? #t)])
(out-number pos out)
(out-anything lam out))]
[(struct prefix (num-lifts toplevels stxs))
[(struct prefix (num-lifts toplevels stxs src-insp-desc))
(out-marshaled
prefix-type-num
(cons num-lifts
(cons (list->vector toplevels)
(list->vector stxs)))
(list* src-insp-desc
num-lifts
(list->vector toplevels)
(list->vector stxs))
out)]
[(struct global-bucket (name))
(out-marshaled variable-type-num name out)]
@ -963,7 +964,8 @@
(define (convert-module mod-form)
(match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported
[(struct mod (name srcname self-modidx
prefix provides requires body syntax-bodies unexported
max-let-depth dummy lang-info
internal-context binding-names
flags pre-submodules post-submodules))

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

@ -68,9 +68,9 @@
(define (read-resolve-prefix v)
(match v
[`(,i ,tv . ,sv)
[`(,src-insp-desc ,i ,tv . ,sv)
;; XXX Why not leave them as vectors and change the contract?
(make-prefix i (vector->list tv) (vector->list sv))]))
(make-prefix i (vector->list tv) (vector->list sv) src-insp-desc)]))
(define (read-unclosed-procedure v)
(define CLOS_HAS_REST 1)

3
zo-lib/compiler/zo-structs.rkt
View File

@ -81,7 +81,8 @@
(define-form-struct prefix ([num-lifts exact-nonnegative-integer?]
[toplevels (listof (or/c #f symbol? global-bucket? module-variable?))]
[stxs list?])) ; should be (listof stx?) sets up top-level and syntax-object array
[stxs list?] ; should be (listof stx?) sets up top-level and syntax-object array
[src-inspector-desc symbol?]))
(define-form-struct form ())
(define-form-struct (expr form) ())