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

update for 6.2.900.15 bytecode change

Browse Source 
The `compilation-top` bytecode form has a new `binding-namess` field.
This commit is contained in:
Matthew Flatt 2015-09-05 13:13:38 -06:00
parent 2a542b3966
commit 89d99b92da
9 changed files with 44 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,7 +33,7 @@
(with-output-to-bytes
(λ () (write (cdr b)))))))])
(let ([n (match v
[(struct compilation-top (_ prefix (struct primval (n)))) n]
[(struct compilation-top (_ _ prefix (struct primval (n)))) n]
[else #f])])
(hash-set! table n (car b)))))
table))
@ -53,7 +53,7 @@
(define (decompile top)
(let ([stx-ht (make-hasheq)])
(match top
[(struct compilation-top (max-let-depth prefix form))
[(struct compilation-top (max-let-depth binding-namess prefix form))
(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
(expose-module-path-indexes
`(begin

4
compiler-lib/compiler/demodularizer/alpha.rkt
View File

@ -4,8 +4,8 @@
(define (alpha-vary-ctop top)
(match top
[(struct compilation-top (max-let-depth prefix form))
(make-compilation-top max-let-depth (alpha-vary-prefix prefix) form)]))
[(struct compilation-top (max-let-depth binding-namess prefix form))
(make-compilation-top max-let-depth binding-namess (alpha-vary-prefix prefix) form)]))
(define (alpha-vary-prefix p)
(struct-copy prefix p
[toplevels

3
compiler-lib/compiler/demodularizer/gc-toplevels.rkt
View File

@ -10,7 +10,7 @@
; XXX Use efficient set structure
(define (gc-toplevels top)
(match top
[(struct compilation-top (max-let-depth top-prefix form))
[(struct compilation-top (max-let-depth binding-namess top-prefix form))
(define lift-start
(prefix-lift-start top-prefix))
(define max-depgraph-index
@ -54,6 +54,7 @@
(log-debug (format "Used stxs: ~S" ordered-stxs))
(make-compilation-top
max-let-depth
#hash()
new-prefix
new-form)]))

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

@ -15,7 +15,7 @@
(define (merge-compilation-top get-modvar-rewrite top)
(parameterize ([current-get-modvar-rewrite get-modvar-rewrite])
(match top
[(struct compilation-top (max-let-depth prefix form))
[(struct compilation-top (max-let-depth binding-namess prefix form))
(define-values (new-max-let-depth new-prefix gen-new-forms)
(merge-form max-let-depth prefix form))
(define total-tls (length (prefix-toplevels new-prefix)))
@ -29,7 +29,7 @@
[p (in-list (prefix-toplevels new-prefix))])
(log-debug (format "new-prefix tls\t~v ~v" i p)))
(make-compilation-top
new-max-let-depth new-prefix
new-max-let-depth #hash() new-prefix
(make-splice (gen-new-forms new-prefix)))]
[else (error 'merge "unrecognized: ~e" top)])))

3
compiler-lib/compiler/demodularizer/module.rkt
View File

@ -13,13 +13,14 @@
(define (wrap-in-kernel-module name srcname lang-info self-modidx top)
(match top
[(struct compilation-top (max-let-depth prefix form))
[(struct compilation-top (max-let-depth binding-namess prefix form))
(define-values (reqs new-forms)
(partition req? (splice-forms form)))
(define requires
(map (compose ->module-path-index stx-obj-datum stx-content req-reqs) reqs))
(make-compilation-top
0
#hash()
(make-prefix 0 (list #f) empty (prefix-src-inspector-desc prefix))
(make-mod name srcname
self-modidx

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

@ -107,9 +107,9 @@
(define (nodep top phase)
(match top
[(struct compilation-top (max-let-depth prefix form))
[(struct compilation-top (max-let-depth binding-namess prefix form))
(define-values (modvar-rewrite lang-info new-form) (nodep-form form phase))
(values modvar-rewrite lang-info (make-compilation-top max-let-depth prefix new-form))]
(values modvar-rewrite lang-info (make-compilation-top max-let-depth #hash() prefix new-form))]
[else (error 'nodep "unrecognized: ~e" top)]))
(define (nodep-form form phase)

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

@ -155,8 +155,11 @@
(define (out-compilation-top shared-obj-pos shared-obj-pos-any counting? outp)
(define ct
(match top
[(compilation-top max-let-depth prefix form)
(list* max-let-depth prefix (protect-quote form))]))
[(compilation-top max-let-depth binding-namess prefix form)
(list* max-let-depth
(binding-namess-hash->list binding-namess)
prefix
(protect-quote form))]))
(out-anything ct (make-out outp shared-obj-pos shared-obj-pos-any counting?
stx-objs wraps hash-consed hash-consed-results))
(file-position outp))
@ -1247,6 +1250,13 @@
(find-relative-path r v)
v)))
(define (binding-namess-hash->list binding-namess)
(for/list ([(phase t) (in-hash binding-namess)])
(cons phase
(list->vector
(apply append (for/list ([(id sym) (in-hash t)])
(list id sym)))))))
;; ----------------------------------------
;; We want to hash-cons syntax-object wraps, but a normal `equal?`-based

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

@ -43,10 +43,21 @@
(define (read-compilation-top v)
(match v
[`(,ld ,prefix . ,code)
[`(,ld ,binding-namess ,prefix . ,code)
(unless (prefix? prefix)
(error 'bad "not prefix ~a" prefix))
(make-compilation-top ld prefix code)]))
(make-compilation-top ld
(binding-namess-list->hash binding-namess)
prefix
code)]))
(define (binding-namess-list->hash binding-namess)
(for/hash ([e (in-list binding-namess)])
(values (car e)
(let ([vec (cdr e)])
(for/hash ([i (in-range 0 (vector-length vec) 2)])
(values (vector-ref vec i)
(vector-ref vec (add1 i))))))))
(define (read-resolve-prefix v)
(match v
@ -1155,8 +1166,9 @@
(define srcloc-ht (make-hasheq))
(let walk ([p v])
(match p
[(compilation-top _ pfx c)
[(compilation-top _ binding-namess pfx c)
(struct-copy compilation-top p
[binding-namess (walk binding-namess)]
[prefix (walk pfx)]
[code (walk c)])]
[(prefix _ _ s _)

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

@ -66,7 +66,11 @@
(define-form-struct form ())
(define-form-struct (expr form) ())
(define-form-struct compilation-top ([max-let-depth exact-nonnegative-integer?] [prefix prefix?] [code (or/c form? any/c)])) ; compiled code always wrapped with this
(define-form-struct compilation-top ([max-let-depth exact-nonnegative-integer?]
[binding-namess (hash/c exact-nonnegative-integer?
(hash/c symbol? identifier?))]
[prefix prefix?]
[code (or/c form? any/c)])) ; compiled code always wrapped with this
;; A provided identifier
(define-form-struct provided ([name symbol?]