zo-marshal wrap fixes, optional port for zo-parse

original commit: 8eeed89982
This commit is contained in:
Blake Johnson 2010-07-26 11:45:01 -06:00 committed by Jay McCarthy
parent c1d54547d8
commit 78faf5e6d6
3 changed files with 39 additions and 7 deletions

View File

@ -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))

View File

@ -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))

View File

@ -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