From 4d7cdfe3eee72723aa02de76c7fa5b21e3092dfd Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 12 Dec 2018 13:16:32 -0800 Subject: [PATCH] lazy array done --- xenomorph/xenomorph/redo/array.rkt | 29 +++---- xenomorph/xenomorph/redo/lazy-array.rkt | 83 +++++++++++++++++++ .../xenomorph/redo/test/lazy-array-test.rkt | 53 ++++++++++++ xenomorph/xenomorph/redo/test/main.rkt | 2 +- 4 files changed, 152 insertions(+), 15 deletions(-) create mode 100644 xenomorph/xenomorph/redo/lazy-array.rkt create mode 100644 xenomorph/xenomorph/redo/test/lazy-array-test.rkt diff --git a/xenomorph/xenomorph/redo/array.rkt b/xenomorph/xenomorph/redo/array.rkt index bc32d4d4..a548b863 100644 --- a/xenomorph/xenomorph/redo/array.rkt +++ b/xenomorph/xenomorph/redo/array.rkt @@ -9,13 +9,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (define (xarray-decode xa [port-arg (current-input-port)] #:parent [parent #f]) (define port (->input-port port-arg)) - (define ctx (if (xint? (xarray-len xa)) + (define ctx (if (xint? (xarray-base-len xa)) (mhasheq 'parent parent '_startOffset (pos port) '_currentOffset 0 - '_length (xarray-len xa)) + '_length (xarray-base-len xa)) parent)) - (define decoded-len (resolve-length (xarray-len xa) port parent)) + (define decoded-len (resolve-length (xarray-base-len xa) port parent)) (cond [(or (not decoded-len) (eq? (xarray-length-type xa) 'bytes)) (define end-pos (cond @@ -27,10 +27,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee [else +inf.0])) (for/list ([i (in-naturals)] #:break (or (eof-object? (peek-byte port)) (= (pos port) end-pos))) - (decode (xarray-type xa) port #:parent ctx))] + (decode (xarray-base-type xa) port #:parent ctx))] ;; we have decoded-len, which is treated as count of items [else (for/list ([i (in-range decoded-len)]) - (decode (xarray-type xa) port #:parent ctx))])) + (decode (xarray-base-type xa) port #:parent ctx))])) (define (xarray-encode xa array [port-arg (current-output-port)] #:parent [parent #f]) (unless (sequence? array) @@ -43,15 +43,15 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee #;[item-count (length items)] #;[max-items (if (number? (xarray-len xa)) (xarray-len xa) item-count)]) (for ([item array]) - (encode (xarray-type xa) item port #:parent ctx)))) + (encode (xarray-base-type xa) item port #:parent ctx)))) (cond - [(xint? (xarray-len xa)) + [(xint? (xarray-base-len xa)) (define ctx (mhash 'pointers null 'startOffset (pos port) 'parent parent)) (dict-set! ctx 'pointerOffset (+ (pos port) (size xa array ctx))) - (encode (xarray-len xa) (length array) port) ; encode length at front + (encode (xarray-base-len xa) (length array) port) ; encode length at front (encode-items ctx) (for ([ptr (in-list (dict-ref ctx 'pointers))]) ; encode pointer data at end (encode (dict-ref ptr 'type) (dict-ref ptr 'val) port))] @@ -62,16 +62,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (when val (unless (sequence? val) (raise-argument-error 'xarray-size "sequence" val))) (cond - [val (let-values ([(ctx len-size) (if (xint? (xarray-len xa)) - (values (mhasheq 'parent ctx) (size (xarray-len xa))) + [val (let-values ([(ctx len-size) (if (xint? (xarray-base-len xa)) + (values (mhasheq 'parent ctx) (size (xarray-base-len xa))) (values ctx 0))]) (+ len-size (for/sum ([item val]) - (size (xarray-type xa) item ctx))))] - [else (let ([item-count (resolve-length (xarray-len xa) #f ctx)] - [item-size (size (xarray-type xa) #f ctx)]) + (size (xarray-base-type xa) item ctx))))] + [else (let ([item-count (resolve-length (xarray-base-len xa) #f ctx)] + [item-size (size (xarray-base-type xa) #f ctx)]) (* item-size item-count))])) -(struct xarray (type len length-type) #:transparent +(struct xarray-base (type len) #:transparent) +(struct xarray xarray-base (length-type) #:transparent #:methods gen:xenomorphic [(define decode xarray-decode) (define encode xarray-encode) diff --git a/xenomorph/xenomorph/redo/lazy-array.rkt b/xenomorph/xenomorph/redo/lazy-array.rkt new file mode 100644 index 00000000..d822984a --- /dev/null +++ b/xenomorph/xenomorph/redo/lazy-array.rkt @@ -0,0 +1,83 @@ +#lang racket/base +(require "helper.rkt" "util.rkt" "number.rkt" "array.rkt" racket/dict sugar/unstable/dict) +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee +|# +(define (get ila index) + (unless (<= 0 index (sub1 (inner-lazy-array-len ila))) + (raise-argument-error 'LazyArray:get (format "index in range 0 to ~a" (sub1 (inner-lazy-array-len ila))) index)) + (dict-ref! (inner-lazy-array-item-cache ila) index (λ () + (define port (inner-lazy-array-port ila)) + (define orig-pos (pos port)) + (pos port (+ (inner-lazy-array-starting-pos ila) + (* (size (inner-lazy-array-type ila) #f (inner-lazy-array-ctx ila)) index))) + (define new-item (decode (inner-lazy-array-type ila) port #:parent (inner-lazy-array-ctx ila))) + (pos port orig-pos) + new-item))) + +(define (to-list ila) + (for/list ([i (in-range (inner-lazy-array-len ila))]) + (get ila i))) + +(define (xlazy-array->list ila) (to-list ila)) + +(struct inner-lazy-array (type len port ctx starting-pos item-cache) #:transparent) + +(define (+inner-lazy-array type [len #f] [port-in #f] [ctx #f]) + (define port (->input-port port-in)) + (define starting-pos (pos port)) + (inner-lazy-array type len port ctx starting-pos (mhasheqv))) + + +(define (xlazy-array-decode xla [port-arg (current-input-port)] #:parent [parent #f]) + (define port (->input-port port-arg)) + (define starting-pos (pos port)) ; ! placement matters. `resolve-length` will change `pos` + (define decoded-len (resolve-length (xarray-base-len xla) port parent)) + (let ([parent (if (xint? (xarray-base-len xla)) + (mhasheq 'parent parent + '_startOffset starting-pos + '_currentOffset 0 + '_length (xarray-base-len xla)) + parent)]) + (define res (+inner-lazy-array (xarray-base-type xla) decoded-len port parent)) + (pos port (+ (pos port) (* decoded-len (size (xarray-base-type xla) #f parent)))) + res)) + +(define (xlazy-array-encode xla val [port-arg (current-output-port)] #:parent [parent #f]) + (xarray-encode xla (if (inner-lazy-array? val) (to-list val) val) port-arg #:parent parent)) + +(define (xlazy-array-size xla [val #f] [ctx #f]) + (xarray-size xla (if (inner-lazy-array? val) (to-list val) val) ctx)) + +;; xarray-base holds type and len fields +(struct xlazy-array xarray-base () #:transparent + #:methods gen:xenomorphic + [(define decode xlazy-array-decode) + (define encode xlazy-array-encode) + (define size xlazy-array-size)]) + +(define (+xlazy-array type [len #f]) + (unless (xenomorphic? type) + (raise-argument-error '+xarray "xenomorphic type" type)) + (unless (length-resolvable? len) + (raise-argument-error '+xarray "length-resolvable?" len)) + (xlazy-array type len)) + + +(module+ test + (require rackunit "number.rkt") + (define bstr #"ABCD1234") + (define ds (open-input-bytes bstr)) + (define la (+xlazy-array uint8 4)) + (define ila (decode la ds)) + (check-equal? (pos ds) 4) + (check-equal? (get ila 1) 66) + (check-equal? (get ila 3) 68) + (check-equal? (pos ds) 4) + (check-equal? (xlazy-array->list ila) '(65 66 67 68)) + (define la2 (+xlazy-array int16be (λ (t) 4))) + (check-equal? (encode la2 '(1 2 3 4) #f) #"\0\1\0\2\0\3\0\4") + (check-equal? (to-list (decode la2 (open-input-bytes #"\0\1\0\2\0\3\0\4"))) '(1 2 3 4))) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/test/lazy-array-test.rkt b/xenomorph/xenomorph/redo/test/lazy-array-test.rkt new file mode 100644 index 00000000..a3f4d551 --- /dev/null +++ b/xenomorph/xenomorph/redo/test/lazy-array-test.rkt @@ -0,0 +1,53 @@ +#lang racket/base +(require rackunit + racket/dict + "../array.rkt" + "../helper.rkt" + "../number.rkt" + "../lazy-array.rkt") + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee +|# + +(test-case + "decode should decode items lazily" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (define array (+xlazy-array uint8 4)) + (define arr (decode array)) + (check-false (xarray? arr)) + (check-equal? (inner-lazy-array-len arr) 4) + (check-equal? (pos (current-input-port)) 4) + (check-equal? (get arr 0) 1) + (check-equal? (get arr 1) 2) + (check-equal? (get arr 2) 3) + (check-equal? (get arr 3) 4))) + +(test-case + "should be able to convert to an array" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (define array (+xlazy-array uint8 4)) + (define arr (decode array)) + (check-equal? (xlazy-array->list arr) '(1 2 3 4)))) + +(test-case + "decode should decode length as number before array" + (parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))]) + (define array (+xlazy-array uint8 uint8)) + (define arr (decode array)) + (check-equal? (xlazy-array->list arr) '(1 2 3 4)))) + +(test-case + "size should work with xlazy-arrays" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (define array (+xlazy-array uint8 4)) + (define arr (decode array)) + (check-equal? (size array arr) 4))) + +(test-case + "encode should work with xlazy-arrays" + (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) + (define array (+xlazy-array uint8 4)) + (define arr (decode array)) + (check-equal? (encode array arr #f) (bytes 1 2 3 4)))) diff --git a/xenomorph/xenomorph/redo/test/main.rkt b/xenomorph/xenomorph/redo/test/main.rkt index ff349a28..87f862af 100644 --- a/xenomorph/xenomorph/redo/test/main.rkt +++ b/xenomorph/xenomorph/redo/test/main.rkt @@ -4,7 +4,7 @@ "bitfield-test.rkt" "buffer-test.rkt" "enum-test.rkt" - ;"lazy-array-test.rkt" + "lazy-array-test.rkt" "number-test.rkt" "optional-test.rkt" "pointer-test.rkt"