zo-marshal wrap fixes, optional port for zo-parse
original commit: 8eeed89982
This commit is contained in:
parent
c1d54547d8
commit
78faf5e6d6
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user