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

Making zo-marshal more like C and not with large byte strings

Browse Source
This commit is contained in:
Jay McCarthy 2010-05-24 12:45:42 -06:00
parent f44e3123b5
commit 40e1ba95fc
1 changed files with 40 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,6 @@
#lang scheme/base #lang scheme/base
(require compiler/zo-structs (require compiler/zo-structs
unstable/byte-counting-port
scheme/match scheme/match
scheme/contract scheme/contract
scheme/local scheme/local
@ -41,44 +42,48 @@
(when (closure? v) (when (closure? v)
(hash-set! shared v (add1 (hash-count shared)))) (hash-set! shared v (add1 (hash-count shared))))
#t)))) #t))))
(define (v-skipping v)
(define skip? #t)
(lambda (v2)
(if (and skip? (eq? v v2))
(begin
(set! skip? #f)
#f)
(hash-ref shared v2 #f))))
(parameterize ([current-wrapped-ht wrapped]) (parameterize ([current-wrapped-ht wrapped])
(traverse-prefix prefix visit) (traverse-prefix prefix visit)
(traverse-form form visit)) (traverse-form form visit))
(let* ([s (open-output-bytes)] (local [(define in-order-shareds
[out (make-out s (lambda (v) (hash-ref shared v #f)) wrapped)] (sort (hash-map shared (lambda (k v) (cons v k)))
[offsets <
(map (lambda (k*v) #:key car))
(define v (cdr k*v)) (define (write-all outp)
(begin0 (define offsets
(file-position s) (for/list ([k*v (in-list in-order-shareds)])
(out-anything v (make-out (define v (cdr k*v))
s (begin0
(let ([skip? #t]) (file-position outp)
(lambda (v2) (out-anything v (make-out outp (v-skipping v) wrapped)))))
(if (and skip? (eq? v v2)) (define post-shared (file-position outp))
(begin (out-data (list* max-let-depth prefix (protect-quote form))
(set! skip? #f) (make-out outp (lambda (v) (hash-ref shared v #f)) wrapped))
#f) (values offsets post-shared (file-position outp)))
(hash-ref shared v2 #f)))) (define counting-p (make-byte-counting-port))
wrapped)))) (define-values (offsets post-shared all-forms-length)
(sort (hash-map shared (lambda (k v) (cons v k))) (write-all counting-p))
< (define all-short? (post-shared . < . #xFFFF))
#:key car))] (define version-bs (string->bytes/latin-1 (version)))]
[post-shared (file-position s)] (write-bytes #"#~" outp)
[all-short? (post-shared . < . #xFFFF)] (write-bytes (bytes (bytes-length version-bs)) outp)
[version-bs (string->bytes/latin-1 (version))]) (write-bytes version-bs outp)
(out-data (list* max-let-depth prefix (protect-quote form)) out) (write-bytes (int->bytes (add1 (hash-count shared))) outp)
(let ([res (get-output-bytes s)]) (write-bytes (bytes (if all-short? 1 0)) outp)
(write-bytes #"#~" outp) (for ([o (in-list offsets)])
(write-bytes (bytes (bytes-length version-bs)) outp) (write-bytes (integer->integer-bytes o (if all-short? 2 4) #f #f) outp))
(write-bytes version-bs outp) (write-bytes (int->bytes post-shared) outp)
(write-bytes (int->bytes (add1 (hash-count shared))) outp) (write-bytes (int->bytes all-forms-length) outp)
(write-bytes (bytes (if all-short? 1 0)) outp) (write-all outp)
(for ([o (in-list offsets)]) (void))]))
(write-bytes (integer->integer-bytes o (if all-short? 2 4) #f #f) outp))
(write-bytes (int->bytes post-shared) outp)
(write-bytes (int->bytes (bytes-length res)) outp)
(write-bytes res outp)))]))
;; ---------------------------------------- ;; ----------------------------------------