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

Fixing up a few things in zo-parse/etc

Browse Source 
original commit: 28432037af
This commit is contained in:
Jay McCarthy 2010-07-26 12:18:01 -06:00
parent 78faf5e6d6
commit 99c7fa04e2
3 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/compiler/zo-marshal.rkt
View File

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require compiler/zo-structs (require compiler/zo-structs
scheme/port scheme/port
racket/vector
scheme/match scheme/match
scheme/contract scheme/contract
scheme/local scheme/local
@ -633,6 +634,7 @@
(bloop b2))] (bloop b2))]
[else [else
(encode-wrapped b)])))] (encode-wrapped b)])))]
; XXX Cylic list error possible
[len (let loop ([datum datum][len 0]) [len (let loop ([datum datum][len 0])
(cond (cond
[(null? datum) #f] [(null? datum) #f]
@ -643,14 +645,15 @@
(if len (if len
(cons len p) (cons len p)
p))] p))]
[(box x) (box (encode-wrapped x))] [(box x)
[(vector a ...) (list->vector (box (encode-wrapped x))]
(map encode-wrapped a))] [(? vector? v)
(vector-map encode-wrapped v)]
[(? prefab-struct-key) [(? prefab-struct-key)
(let ([l (vector->list (struct->vector datum))]) (define l (vector->list (struct->vector datum)))
(make-prefab-struct (make-prefab-struct
(car l) (car l)
(map encode-wrapped (cdr l))))] (map encode-wrapped (cdr l)))]
[_ datum])] [_ datum])]
[p (cons enc-datum [p (cons enc-datum
(encode-wraps wraps))]) (encode-wraps wraps))])

1
collects/compiler/zo-parse.rkt
View File

@ -502,7 +502,6 @@
(if (integer? v) (if (integer? v)
(unmarshal-stx-get/decode cp v decode-stx) (unmarshal-stx-get/decode cp v decode-stx)
(let loop ([v v]) (let loop ([v v])
;(printf "~s~n" v)
(let-values ([(cert-marks v encoded-wraps) (let-values ([(cert-marks v encoded-wraps)
(match v (match v
[`#((,datum . ,wraps) ,cert-marks) (values cert-marks datum wraps)] [`#((,datum . ,wraps) ,cert-marks) (values cert-marks datum wraps)]

8
collects/tests/compiler/zo-test.rkt
View File

@ -316,15 +316,15 @@ exec racket -t "$0" -- -s -t 60 -v -R $*
[compare-marshalled-to-marshalled-marshalled [compare-marshalled-to-marshalled-marshalled
#f #f
(bytes-not-equal?-error marshal-parsed marshal-marshalled)] (bytes-not-equal?-error marshal-parsed marshal-marshalled)]
#;[show-orig-and-marshal-parsed
#f
(print-bytes read-orig marshal-parsed)]
#;[replace-with-marshalled #;[replace-with-marshalled
#t #t
(replace-file file marshal-marshalled)] (replace-file file marshal-marshalled)]
[decompile-parsed [decompile-parsed
#t #t
(decompile parse-orig)] (decompile parse-orig)]
[show-orig-and-marshal-parsed
#f
(print-bytes read-orig marshal-parsed)]
[c-parse-marshalled [c-parse-marshalled
#t #t
(read-compiled-bytes marshal-parsed)] (read-compiled-bytes marshal-parsed)]
@ -333,6 +333,8 @@ exec racket -t "$0" -- -s -t 60 -v -R $*
(bytes-not-equal?-error read-orig marshal-parsed)]) (bytes-not-equal?-error read-orig marshal-parsed)])
(define (run-test file) (define (run-test file)
(when (debugging?)
(printf "~a\n" file))
(run-with-limit (run-with-limit
file file
(* 1024 1024 128) (* 1024 1024 128)