diff --git a/pitfall/restructure/array-test.rkt b/pitfall/restructure/array-test.rkt index 4686511c..aceeccce 100644 --- a/pitfall/restructure/array-test.rkt +++ b/pitfall/restructure/array-test.rkt @@ -1,5 +1,5 @@ #lang restructure/racket -(require "array.rkt" "stream.rkt" "number.rkt" "buffer.rkt" rackunit) +(require "array.rkt" "stream.rkt" "number.rkt" "buffer.rkt" rackunit "pointer.rkt") #| approximates @@ -14,7 +14,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array.decode(stream).should.deep.equal [1, 2, 3, 4] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] - [array (+Array uint8 4)]) + [array (+ArrayT uint8 4)]) (check-equal? (send array decode stream) '(1 2 3 4))) @@ -23,7 +23,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint16, 4, 'bytes' ; array.decode(stream).should.deep.equal [258, 772] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] - [array (+Array uint16be 4 'bytes)]) + [array (+ArrayT uint16be 4 'bytes)]) (check-equal? (send array decode stream) '(258 772))) @@ -33,7 +33,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array.decode(stream, len: 4).should.deep.equal [1, 2, 3, 4] ; (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] - [array (+Array uint8 4 'len)]) + [array (+ArrayT uint8 4 'len)]) (check-equal? (send array decode stream (mhash 'len 4)) '(1 2 3 4))) @@ -42,7 +42,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint16, 'len', 'bytes' ; array.decode(stream, len: 4).should.deep.equal [258, 772] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] - [array (+Array uint16be 'len 'bytes)]) + [array (+ArrayT uint16be 'len 'bytes)]) (check-equal? (send array decode stream (mhash 'len 4)) '(258 772))) @@ -51,7 +51,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint8, uint8 ; array.decode(stream).should.deep.equal [1, 2, 3, 4] (let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))] - [array (+Array uint8 uint8)]) + [array (+ArrayT uint8 uint8)]) (check-equal? (send array decode stream) '(1 2 3 4))) @@ -60,7 +60,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint16, uint8, 'bytes' ; array.decode(stream).should.deep.equal [258, 772] (let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))] - [array (+Array uint16be uint8 'bytes)]) + [array (+ArrayT uint16be uint8 'bytes)]) (check-equal? (send array decode stream) '(258 772))) ; it 'should decode length from function', -> @@ -68,7 +68,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint8, -> 4 ; array.decode(stream).should.deep.equal [1, 2, 3, 4] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] - [array (+Array uint8 (λ _ 4))]) + [array (+ArrayT uint8 (λ _ 4))]) (check-equal? (send array decode stream) '(1 2 3 4))) @@ -77,7 +77,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint16, (-> 4), 'bytes' ; array.decode(stream).should.deep.equal [258, 772] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] - [array (+Array uint16be (λ _ 4) 'bytes)]) + [array (+ArrayT uint16be (λ _ 4) 'bytes)]) (check-equal? (send array decode stream) '(258 772))) @@ -86,7 +86,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint8 ; array.decode(stream, _length: 4, _startOffset: 0).should.deep.equal [1, 2, 3, 4] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] - [array (+Array uint8)]) + [array (+ArrayT uint8)]) (check-equal? (send array decode stream (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))) @@ -95,7 +95,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint8 ; array.decode(stream).should.deep.equal [1, 2, 3, 4] (let ([stream (+DecodeStream (+Buffer '(1 2 3 4)))] - [array (+Array uint8)]) + [array (+ArrayT uint8)]) (check-equal? (send array decode stream) '(1 2 3 4))) @@ -103,7 +103,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; it 'should use array length', -> ; array = new ArrayT uint8, 10 ; array.size([1, 2, 3, 4]).should.equal 4 -(let ([array (+Array uint8 10)]) +(let ([array (+ArrayT uint8 10)]) (check-equal? (send array size '(1 2 3 4)) 4)) @@ -111,14 +111,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint8, uint8 ; array.size([1, 2, 3, 4]).should.equal 5 ; -(let ([array (+Array uint8 uint8)]) +(let ([array (+ArrayT uint8 uint8)]) (check-equal? (send array size '(1 2 3 4)) 5)) ; it 'should use defined length if no value given', -> ; array = new ArrayT uint8, 10 ; array.size().should.equal 10 -(let ([array (+Array uint8 10)]) +(let ([array (+ArrayT uint8 10)]) (check-equal? (send array size) 10)) @@ -134,7 +134,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; stream.end() (let ([stream (+EncodeStream)] - [array (+Array uint8 10)]) + [array (+ArrayT uint8 10)]) (send array encode stream '(1 2 3 4)) (check-equal? (send stream dump) (+Buffer '(1 2 3 4)))) @@ -151,12 +151,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; stream.end() (let ([stream (+EncodeStream)] - [array (+Array uint8 uint8)]) + [array (+ArrayT uint8 uint8)]) (send array encode stream '(1 2 3 4)) (check-equal? (send stream dump) (+Buffer '(4 1 2 3 4)))) -;; todo: needs pointer ; it 'should add pointers after array if length is encoded at start', (done) -> ; stream = new EncodeStream ; stream.pipe concat (buf) -> @@ -167,7 +166,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array.encode(stream, [1, 2, 3, 4]) ; stream.end() +(displayln "warning: pointer test not done") #;(let ([stream (+EncodeStream)] - [array (+Array (+Pointer uint8 uint8) uint8)]) + [array (+ArrayT (+Pointer uint8 uint8) uint8)]) (send array encode stream '(1 2 3 4)) (check-equal? (send stream dump) (+Buffer '(4 5 6 7 8 1 2 3 4)))) \ No newline at end of file diff --git a/pitfall/restructure/array.rkt b/pitfall/restructure/array.rkt index 2e5da83c..8a2eb1f9 100644 --- a/pitfall/restructure/array.rkt +++ b/pitfall/restructure/array.rkt @@ -1,5 +1,5 @@ #lang restructure/racket -(require "number.rkt" (prefix-in utils- "utils.rkt") "stream.rkt" br/cond) +(require "number.rkt" (prefix-in utils- "utils.rkt") "stream.rkt") (provide (all-defined-out)) #| @@ -7,7 +7,7 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Array.coffee |# -(define-subclass Streamcoder (Array type [length_ #f] [lengthType 'count]) +(define-subclass Streamcoder (ArrayT type [length_ #f] [lengthType 'count]) (define/augride (decode stream [parent #f]) (define pos (send stream pos)) @@ -26,7 +26,6 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee '_length length_) (set! ctx res)) - (cond [(or (not length__) (eq? lengthType 'bytes)) (define target (cond @@ -49,18 +48,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (countable->list res)) (define/override (size [array #f] [ctx #f]) - (when array (unless (countable? array) - (raise-argument-error 'Array:size "list or countable" array))) + (when array + (unless (countable? array) + (raise-argument-error 'Array:size "list or countable" array))) (cond - [(not array) (* (send type size #f ctx) (utils-resolveLength length_ #f ctx))] + [(not array) + (* (send type size #f ctx) (utils-resolveLength length_ #f ctx))] [else - (define size 0) - (when (NumberT? length_) - (increment! size (send length_ size)) - (set! ctx (mhash 'parent ctx))) - (for ([item (in-list (countable->list array))]) - (increment! size (send type size item ctx))) - size])) + (+ (cond + [(NumberT? length_) + (set! ctx (mhash 'parent ctx)) + (send length_ size)] + [else 0]) + (for/sum ([item (in-list (countable->list array))]) + (send type size item ctx)))])) (define/augride (encode stream array [parent #f]) (when array (unless (countable? array) @@ -70,92 +71,22 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (set! ctx (mhash 'pointers null 'startOffset (· stream pos) 'parent parent)) - (ref-set! ctx 'pointerOffset (+ (· stream pos) (size array ctx))) + (ref-set! ctx 'pointerOffset (+ (· stream pos) (size array ctx))) (send length_ encode stream (length array))) (for ([item (in-list (countable->list array))]) (send type encode stream item ctx)) (when (NumberT? length_) - (define i 0) - (define ptr #f) - (while (< i (length (· ctx pointers))) - (set! ptr (list-ref (· ctx pointers) (increment! i))) - (send (· ptr type) encode stream (· ptr val)))))) - - -#;(test-module - (define stream (+DecodeStream #"ABCDEFG")) - - (define A (+Array uint16be 3)) - (check-equal? (send A decode stream) '(16706 17220 17734)) - (define os (+EncodeStream)) - (send A encode os '(16706 17220 17734)) - (check-equal? (send os dump) #"ABCDEF") - - (check-equal? (send (+Array uint16be) size '(1 2 3)) 6) - (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40)) - -#| -approximates -https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee -|# - -(define-subclass object% (InnerLazyArray type [_length #f] [stream #f] [parent #f]) - (field [base (and stream (· stream pos))] - [items (mhash)]) ; implement with hash (random add) rather than array - - (define/public-final (get index) - (when (or (< index 0) (<= _length index)) - (raise-argument-error 'InnerLazyArray:get (format "array index between 0 and ~a" _length) index)) - (hash-ref! items index (λ () - (define stashed-pos (· stream pos)) - (send stream pos (+ base (* index (send type size)))) - (define new-val (send type decode stream parent)) - (send stream pos stashed-pos) - new-val))) - - (define/public-final (toArray) - (for/list ([i (in-range _length)]) - (get i)))) - -(define-subclass Array (LazyArray) - (inherit-field length_ type) - (define/override (decode stream [parent #f]) - (define len (utils-resolveLength length_ stream parent)) - (define res (+InnerLazyArray type len stream parent)) - (define lazy-space (* len (send type size))) - (report lazy-space) - (send stream pos (+ (· stream pos) lazy-space)) ; skip the bytes that LazyArray would occupy - res) - - (define/override (size [val #f]) - (super size (if (InnerLazyArray? val) - (send val toArray) - val))) - - (define/override (encode stream val) - (super encode stream (if (InnerLazyArray? val) - (send val toArray) - val)))) - -#;(test-module - (define bstr #"ABCD1234") - (define ds (+DecodeStream bstr)) - (define la (+LazyArray uint8 4)) - (define ila (send la decode ds)) - (check-equal? (send ds pos) 4) - (check-equal? (send ila get 1) 66) - (check-equal? (send ila get 3) 68) - (check-equal? (send ds pos) 4) - (check-equal? (send ila toArray) '(65 66 67 68)) - - (define la2 (+LazyArray int16be (λ (t) 4))) - (define es (+EncodeStream)) - (send la2 encode es '(1 2 3 4)) - (check-equal? (send es dump) #"\0\1\0\2\0\3\0\4") - (check-equal? (send (send la2 decode (+DecodeStream #"\0\1\0\2\0\3\0\4")) toArray) '(1 2 3 4)) - - ) - - + (for ([ptr (in-list (· ctx pointers))]) + (send (· ptr type) encode stream (· ptr val)))))) + +(define-values (Array? +Array) (values ArrayT? +ArrayT)) + +(test-module + (define stream (+DecodeStream #"ABCDEFG")) + (define A (+Array uint16be 3)) + (check-equal? (send A decode stream) '(16706 17220 17734)) + (check-equal? (send A encode #f '(16706 17220 17734)) #"ABCDEF") + (check-equal? (send (+Array uint16be) size '(1 2 3)) 6) + (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40)) diff --git a/pitfall/restructure/generic-interface-example.rkt b/pitfall/restructure/generic-interface-example.rkt deleted file mode 100644 index fa42e38a..00000000 --- a/pitfall/restructure/generic-interface-example.rkt +++ /dev/null @@ -1,20 +0,0 @@ -#lang br -(require data/collection racket/private/generic-methods) - -(define countable<%> - (interface* () - ([(generic-property gen:countable) - (generic-method-table gen:countable - (define (length o) - (send o length)))]))) - - -(define c (class* object% (countable<%>) - (super-new) - (define/public (length) 42))) - -c - -(define o (make-object c)) - -(length o) \ No newline at end of file diff --git a/pitfall/restructure/lazy-array-test.rkt b/pitfall/restructure/lazy-array-test.rkt new file mode 100644 index 00000000..d9538276 --- /dev/null +++ b/pitfall/restructure/lazy-array-test.rkt @@ -0,0 +1,114 @@ +#lang restructure/racket +(require "lazy-array.rkt" "array.rkt" "stream.rkt" "number.rkt" "buffer.rkt" rackunit) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee +|# + +;describe 'LazyArray', -> +; describe 'decode', -> +; it 'should decode items lazily', -> +; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] +; array = new LazyArray uint8, 4 +; +; arr = array.decode(stream) +; arr.should.not.be.an.instanceof Array +; arr.should.have.length 4 +; stream.pos.should.equal 4 +; +; arr.get(0).should.equal 1 +; arr.get(1).should.equal 2 +; arr.get(2).should.equal 3 +; arr.get(3).should.equal 4 +; +; should.not.exist arr.get(-1) +; should.not.exist arr.get(5) + +(let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+LazyArray uint8 4)]) + (define arr (send array decode stream)) + (check-false (Array? arr)) + (check-equal? (ref arr 'length_) 4) + (check-equal? (send stream pos) 4) + (check-equal? (send arr get 0) 1) + (check-equal? (send arr get 1) 2) + (check-equal? (send arr get 2) 3) + (check-equal? (send arr get 3) 4)) + + + +; +; it 'should be able to convert to an array', -> +; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] +; array = new LazyArray uint8, 4 +; +; arr = array.decode(stream) +; arr.toArray().should.deep.equal [1, 2, 3, 4] + +(let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+LazyArray uint8 4)]) + (define arr (send array decode stream)) + (check-equal? (send arr toArray) '(1 2 3 4))) + +; +; it 'should have an inspect method', -> +; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] +; array = new LazyArray uint8, 4 +; +; arr = array.decode(stream) +; arr.inspect().should.equal '[ 1, 2, 3, 4 ]' + +(let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+LazyArray uint8 4)]) + (define arr (send array decode stream)) + (check-equal? (send arr inspect) (format "~a" '(1 2 3 4)))) + +; +; it 'should decode length as number before array', -> +; stream = new DecodeStream new Buffer [4, 1, 2, 3, 4, 5] +; array = new LazyArray uint8, uint8 +; arr = array.decode(stream) +; +; arr.toArray().should.deep.equal [1, 2, 3, 4] + +(let* ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))] + [array (+LazyArray uint8 uint8)]) + (define arr (send array decode stream)) + (check-equal? (send arr toArray) '(1 2 3 4))) + +; +; describe 'size', -> +; it 'should work with LazyArrays', -> +; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] +; array = new LazyArray uint8, 4 +; arr = array.decode(stream) +; +; array.size(arr).should.equal 4 + +(let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+LazyArray uint8 4)]) + (define arr (send array decode stream)) + (check-equal? (send array size arr) 4)) + +; +; describe 'encode', -> +; it 'should work with LazyArrays', (done) -> +; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] +; array = new LazyArray uint8, 4 +; arr = array.decode(stream) +; +; enc = new EncodeStream +; enc.pipe concat (buf) -> +; buf.should.deep.equal new Buffer [1, 2, 3, 4] +; done() +; +; array.encode(enc, arr) +; enc.end() + +(let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+LazyArray uint8 4)]) + (define arr (send array decode stream)) + (define enc (+EncodeStream)) + (send array encode enc arr) + (check-equal? (send enc dump) (+Buffer '(1 2 3 4)))) \ No newline at end of file diff --git a/pitfall/restructure/lazy-array.rkt b/pitfall/restructure/lazy-array.rkt new file mode 100644 index 00000000..3c28d250 --- /dev/null +++ b/pitfall/restructure/lazy-array.rkt @@ -0,0 +1,83 @@ +#lang restructure/racket +(require (prefix-in utils- "utils.rkt") "array.rkt" "number.rkt") +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee +|# + +(define-subclass object% (InnerLazyArray type [length_ #f] [stream #f] [ctx #f]) + (define base (and stream (· stream pos))) + (define items (mhash)) ; rather than empty array + + (define/public-final (get index) + (cond + [(or (< index 0) (>= index length_)) #f] + [else + (define item (with-handlers ([exn:fail? (λ _ #f)]) + (ref items index))) + (or item + (let () + (define pos_ (· stream pos)) + (send stream pos (+ base (* (send type size #f ctx) index))) + (define new-item (send type decode stream ctx)) + (ref-set! items index new-item) + (send stream pos pos_) + new-item))])) + + (define/public-final (toArray) + (for/list ([i (in-range length_)]) + (get i))) + + (define/public-final (inspect) + (format "~a" (toArray)))) + +(define-subclass ArrayT (LazyArray) + (inherit-field length_ type) + + (define/override (decode stream [parent #f]) + (define pos (· stream pos)) + (define length__ (utils-resolveLength length_ stream parent)) + + (when (NumberT? length_) + ;; define hidden properties + (set! parent (mhash 'parent parent + '_startOffset pos + '_currentOffset 0 + '_length length_))) + + (define res (+InnerLazyArray type length__ stream parent)) + (send stream pos (+ (· stream pos) (* length__ (send type size #f parent)))) + res) + + (define/override (size [val #f] [ctx #f]) + (super size (if (InnerLazyArray? val) + (send val toArray) + val) ctx)) + + (define/override (encode stream val [ctx #f]) + (super encode stream (if (InnerLazyArray? val) + (send val toArray) + val) ctx))) + +#;(test-module + (require "stream.rkt") + (define bstr #"ABCD1234") + (define ds (+DecodeStream bstr)) + (define la (+LazyArray uint8 4)) + (define ila (send la decode ds)) + (check-equal? (send ds pos) 4) + (check-equal? (send ila get 1) 66) + (check-equal? (send ila get 3) 68) + (check-equal? (send ds pos) 4) + (check-equal? (send ila toArray) '(65 66 67 68)) + + (define la2 (+LazyArray int16be (λ (t) 4))) + (define es (+EncodeStream)) + (send la2 encode es '(1 2 3 4)) + (check-equal? (send es dump) #"\0\1\0\2\0\3\0\4") + (check-equal? (send (send la2 decode (+DecodeStream #"\0\1\0\2\0\3\0\4")) toArray) '(1 2 3 4)) + + ) + diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index b79cf48f..fc3c0258 100644 --- a/pitfall/restructure/number.rkt +++ b/pitfall/restructure/number.rkt @@ -80,7 +80,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define bs (real->floating-point-bytes val-in byte-size (eq? endian 'be))) (send stream write bs)) - (define/override (size) byte-size)) + (define/override (size . args) byte-size)) (define-instance float (make-object Float 32)) (define-instance floatbe (make-object Float 32 'be)) diff --git a/pitfall/restructure/pointer.rkt b/pitfall/restructure/pointer.rkt index 25e126f2..bb07b1c1 100644 --- a/pitfall/restructure/pointer.rkt +++ b/pitfall/restructure/pointer.rkt @@ -46,14 +46,16 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee (send stream pos orig-pos) val] [else ptr])) + + + (define/public (size [val #f] [ctx #f]) + (error 'Pointer-size-not-done) + (report* this offsetType type (send type size))) (define/public (encode stream val) (error 'Pointer-encode-not-done)) - (define/public (size [val #f] [ctx #f]) - (error 'Pointer-size-not-done) - (report* this offsetType type (send type size))) diff --git a/pitfall/restructure/stream.rkt b/pitfall/restructure/stream.rkt index cb51b714..5ae95644 100644 --- a/pitfall/restructure/stream.rkt +++ b/pitfall/restructure/stream.rkt @@ -151,6 +151,8 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee ;; not a subclass of DecodeStream or EncodeStream, however. (define-subclass RestructureBase (Streamcoder) (define/overment (decode x [parent #f]) + (when parent (unless (indexable? parent) + (raise-argument-error 'Streamcoder:decode "hash or incexable" x))) (define stream (if (bytes? x) (+DecodeStream x) x)) (unless (DecodeStream? stream) (raise-argument-error 'Streamcoder:decode "bytes or DecodeStream" x))