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

Streaming final output from zo-marshal

Browse Source 
original commit: b892c276ff
This commit is contained in:
Jay McCarthy 2010-05-24 11:48:19 -06:00
parent 50c18d0b92
commit 46f7907aca
1 changed files with 24 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,11 +1,14 @@
#lang scheme/base #lang scheme/base
(require compiler/zo-structs (require compiler/zo-structs
scheme/match scheme/match
scheme/contract
scheme/local scheme/local
scheme/list scheme/list
scheme/dict) scheme/dict)
(provide zo-marshal) (provide/contract
[zo-marshal (compilation-top? . -> . bytes?)]
[zo-marshal-to (compilation-top? output-port? . -> . void?)])
#| Unresolved Issues #| Unresolved Issues
@ -16,6 +19,11 @@
(define current-wrapped-ht (make-parameter #f)) (define current-wrapped-ht (make-parameter #f))
(define (zo-marshal top) (define (zo-marshal top)
(define bs (open-output-bytes))
(zo-marshal-to top bs)
(get-output-bytes bs))
(define (zo-marshal-to top outp)
(match top (match top
[(struct compilation-top (max-let-depth prefix form)) [(struct compilation-top (max-let-depth prefix form))
(let ([encountered (make-hasheq)] (let ([encountered (make-hasheq)]
@ -61,24 +69,21 @@
(out-data (list* max-let-depth prefix (protect-quote form)) out) (out-data (list* max-let-depth prefix (protect-quote form)) out)
(let ([res (get-output-bytes s)] (let ([res (get-output-bytes s)]
[version-bs (string->bytes/latin-1 (version))]) [version-bs (string->bytes/latin-1 (version))])
(bytes-append #"#~" (write-bytes #"#~" outp)
(bytes (bytes-length version-bs)) (write-bytes (bytes (bytes-length version-bs)) outp)
version-bs (write-bytes version-bs outp)
(int->bytes (add1 (hash-count shared))) (write-bytes (int->bytes (add1 (hash-count shared))) outp)
(bytes (if all-short? (write-bytes (bytes (if all-short?
1 1
0)) 0)) outp)
(apply (for ([o (in-list offsets)])
bytes-append (write-bytes (integer->integer-bytes o
(map (lambda (o) (if all-short? 2 4)
(integer->integer-bytes o #f
(if all-short? 2 4) #f) outp))
#f (write-bytes (int->bytes post-shared) outp)
#f)) (write-bytes (int->bytes (bytes-length res)) outp)
offsets)) (write-bytes res outp))))]))
(int->bytes post-shared)
(int->bytes (bytes-length res))
res))))]))
;; ---------------------------------------- ;; ----------------------------------------