From 29d86bcaacb2ab8d41bd2c1da4551332abe164f1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 10 Mar 2015 17:21:29 -0600 Subject: [PATCH] sync with new macro system bytecode format --- zo-lib/compiler/zo-marshal.rkt | 64 ++++++++-------------------------- zo-lib/compiler/zo-parse.rkt | 11 ++---- zo-lib/compiler/zo-structs.rkt | 28 --------------- 3 files changed, 18 insertions(+), 85 deletions(-) diff --git a/zo-lib/compiler/zo-marshal.rkt b/zo-lib/compiler/zo-marshal.rkt index 75748469ae..a05642fa37 100644 --- a/zo-lib/compiler/zo-marshal.rkt +++ b/zo-lib/compiler/zo-marshal.rkt @@ -288,8 +288,7 @@ (define module-type-num 26) (define inline-variants-type-num 27) (define variable-type-num 35) -(define prefix-type-num 114) -(define free-id-info-type-num 164) +(define prefix-type-num 115) (define-syntax define-enum (syntax-rules () @@ -336,12 +335,15 @@ CPT_CLOSURE CPT_DELAY_REF ; XXX unused, but appears to be same as CPT_SYMREF CPT_PREFAB - CPT_LET_ONE_UNUSED) + CPT_LET_ONE_UNUSED + CPT_MARK + CPT_ROOT_MARK + CPT_SHARED) -(define CPT_SMALL_NUMBER_START 36) -(define CPT_SMALL_NUMBER_END 60) +(define CPT_SMALL_NUMBER_START 39) +(define CPT_SMALL_NUMBER_END 62) -(define CPT_SMALL_SYMBOL_START 60) +(define CPT_SMALL_SYMBOL_START 62) (define CPT_SMALL_SYMBOL_END 80) (define CPT_SMALL_MARSHALLED_START 80) @@ -418,39 +420,7 @@ (list* path phase src-phase exns prefix)])) (define (encode-wraps wraps) - (for/list ([wrap (in-list wraps)]) - (match wrap - [(struct phase-shift (amt src dest cancel-id)) - (box (vector amt src dest #f #f cancel-id))] - [(struct module-rename (phase kind set-id unmarshals renames mark-renames plus-kern?)) - (define encoded-kind (eq? kind 'marked)) - (define encoded-unmarshals (map encode-all-from-module unmarshals)) - (define encoded-renames (encode-module-bindings renames)) - (define-values (maybe-unmarshals maybe-renames) (if (null? encoded-unmarshals) - (values encoded-renames mark-renames) - (values encoded-unmarshals (cons encoded-renames mark-renames)))) - (define mod-rename (list* phase encoded-kind set-id maybe-unmarshals maybe-renames)) - (if plus-kern? - (cons #t mod-rename) - mod-rename)] - [(struct lexical-rename (bool1 bool2 alist)) - (define len (length alist)) - (define vec (make-vector (+ (* 2 len) 2))) ; + 2 for booleans at the beginning - (vector-set! vec 0 bool1) - (vector-set! vec 1 bool2) - (for ([(k v) (in-dict alist)] - [i (in-naturals)]) - (vector-set! vec (+ 2 i) k) - (vector-set! vec (+ 2 i len) v)) - vec] - [(struct top-level-rename (flag)) - flag] - [(struct mark-barrier (value)) - value] - [(struct prune (syms)) - (box syms)] - [(struct wrap-mark (val)) - (list val)]))) + #f) (define (encode-mark-map mm) mm @@ -678,11 +648,6 @@ out)] [(struct global-bucket (name)) (out-marshaled variable-type-num name out)] - [(struct free-id-info (mpi0 s0 mpi1 s1 p0 p1 p2 insp?)) - (out-marshaled - free-id-info-type-num - (vector mpi0 s0 mpi1 s1 p0 p1 p2 insp?) - out)] [(? mod?) (out-module v out)] [(struct def-values (ids rhs)) @@ -1112,13 +1077,14 @@ (define (pack-binding-names binding-names) (define (ht-to-vector ht) - (list->vector (apply append (hash-map ht list)))) + (and ht (list->vector (apply append (hash-map ht list))))) (list (ht-to-vector (hash-ref binding-names 0 #f)) (ht-to-vector (hash-ref binding-names 1 #f)) - (apply append - (for/list ([(phase ht) (in-hash binding-names)] - #:unless (or (= phase 0) (= phase 1))) - (list phase (ht-to-vector ht)))))) + (list->vector + (apply append + (for/list ([(phase ht) (in-hash binding-names)] + #:unless (or (= phase 0) (= phase 1))) + (list phase (ht-to-vector ht))))))) (define (out-lam expr out) (match expr diff --git a/zo-lib/compiler/zo-parse.rkt b/zo-lib/compiler/zo-parse.rkt index 10a84811ce..80b82e3256 100644 --- a/zo-lib/compiler/zo-parse.rkt +++ b/zo-lib/compiler/zo-parse.rkt @@ -72,11 +72,6 @@ ;; XXX Why not leave them as vectors and change the contract? (make-prefix i (vector->list tv) (vector->list sv))])) -(define read-free-id-info - (match-lambda - [(vector mpi0 symbol0 mpi1 symbol1 num0 num1 num2 bool0) ; I have no idea what these mean - (make-free-id-info mpi0 symbol0 mpi1 symbol1 num0 num1 num2 bool0)])) - (define (read-unclosed-procedure v) (define CLOS_HAS_REST 1) (define CLOS_HAS_REF_ARGS 2) @@ -422,7 +417,6 @@ (cons 'module-type read-module) (cons 'inline-variant-type read-inline-variant) (cons 'resolve-prefix-type read-resolve-prefix) - (cons 'free-id-info-type read-free-id-info) (cons 'define-values-type read-define-values) (cons 'define-syntaxes-type read-define-syntax) (cons 'begin-for-syntax-type read-begin-for-syntax) @@ -513,8 +507,9 @@ [34 prefab] [35 let-one-unused] [36 mark] - [37 shared] - [38 62 small-number] + [37 root-mark] + [38 shared] + [39 62 small-number] [62 80 small-symbol] [80 92 small-marshalled] [92 ,(+ 92 small-list-max) small-proper-list] diff --git a/zo-lib/compiler/zo-structs.rkt b/zo-lib/compiler/zo-structs.rkt index bd97241008..230e047c97 100644 --- a/zo-lib/compiler/zo-structs.rkt +++ b/zo-lib/compiler/zo-structs.rkt @@ -195,34 +195,6 @@ ;; Top-level `require' (define-form-struct (req form) ([reqs stx?] [dummy toplevel?])) - -(define-form-struct free-id-info ([path0 module-path-index?] - [symbol0 symbol?] - [path1 module-path-index?] - [symbol1 symbol?] - [phase0 (or/c exact-integer? #f)] - [phase1 (or/c exact-integer? #f)] - [phase2 (or/c exact-integer? #f)] - [use-current-inspector? boolean?])) - -(define-form-struct (lexical-rename wrap) ([has-free-id-renames? boolean?] - [bool2 boolean?] ; this needs a name - [alist (listof - (cons/c symbol? - (or/c - symbol? - (cons/c - symbol? - (or/c - (cons/c symbol? (or/c symbol? #f)) - free-id-info?)))))])) -(define-form-struct (phase-shift wrap) ([amt (or/c exact-integer? #f)] - [src (or/c module-path-index? #f)] - [dest (or/c module-path-index? #f)] - [cancel-id (or/c exact-integer? #f)])) -(define-form-struct (wrap-mark wrap) ([val exact-integer?])) -(define-form-struct (prune wrap) ([sym any/c])) - (define-form-struct all-from-module ([path module-path-index?] [phase (or/c exact-integer? #f)] [src-phase (or/c exact-integer? #f)]