diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index 8333ef8c23..f3b11324db 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -621,11 +621,42 @@ (define (encode-wrapped w) (match w [(struct wrapped (datum wraps certs)) - (vector - (cons - datum - (encode-wraps wraps)) - certs)])) + (let* ([enc-datum + (match datum + [(cons a b) + (let ([p (cons (encode-wrapped a) + (let bloop ([b b]) + (match b + ['() null] + [(cons b1 b2) + (cons (encode-wrapped b1) + (bloop b2))] + [else + (encode-wrapped b)])))] + [len (let loop ([datum datum][len 0]) + (cond + [(null? datum) #f] + [(pair? datum) (loop (cdr datum) (add1 len))] + [else len]))]) + ;; for improper lists, we need to include the length so the + ;; parser knows where the end of the improper list is + (if len + (cons len p) + p))] + [(box x) (box (encode-wrapped x))] + [(vector a ...) (list->vector + (map encode-wrapped a))] + [(? prefab-struct-key) + (let ([l (vector->list (struct->vector datum))]) + (make-prefab-struct + (car l) + (map encode-wrapped (cdr l))))] + [_ datum])] + [p (cons enc-datum + (encode-wraps wraps))]) + (if certs + (vector p certs) + p))])) (define (lookup-encoded-wrapped w out) (hash-ref (out-encoded-wraps out) w)) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index 7c1186ed64..8cca2af017 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -502,6 +502,7 @@ (if (integer? v) (unmarshal-stx-get/decode cp v decode-stx) (let loop ([v v]) + ;(printf "~s~n" v) (let-values ([(cert-marks v encoded-wraps) (match v [`#((,datum . ,wraps) ,cert-marks) (values cert-marks datum wraps)] @@ -933,7 +934,7 @@ ;; path -> bytes ;; implementes read.c:read_compiled -(define (zo-parse port) +(define (zo-parse [port (current-input-port)]) (begin-with-definitions ;; skip the "#~" (unless (equal? #"#~" (read-bytes 2 port)) diff --git a/collects/tests/compiler/zo-test.rkt b/collects/tests/compiler/zo-test.rkt index d280efac02..56cd89db6e 100755 --- a/collects/tests/compiler/zo-test.rkt +++ b/collects/tests/compiler/zo-test.rkt @@ -326,7 +326,7 @@ exec racket -t "$0" -- -s -t 60 -v -R $* #f (print-bytes read-orig marshal-parsed)] [c-parse-marshalled - #f + #t (read-compiled-bytes marshal-parsed)] [compare-orig-to-marshalled #f