diff --git a/pitfall/restructure/array-test.rkt b/pitfall/restructure/array-test.rkt index 6fdae9ae..4686511c 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" rackunit) +(require "array.rkt" "stream.rkt" "number.rkt" "buffer.rkt" rackunit) #| approximates @@ -13,90 +13,88 @@ 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 (bytes 1 2 3 4 5))] +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] [array (+Array uint8 4)]) (check-equal? (send array decode stream) '(1 2 3 4))) -;; todo + ; it 'should decode fixed amount of bytes', -> ; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] ; array = new ArrayT uint16, 4, 'bytes' ; array.decode(stream).should.deep.equal [258, 772] -(let ([stream (+DecodeStream (bytes 1 2 3 4 5))] - [array (+Array uint16be 4 'bytes)]) - (check-equal? (send array decode stream) '(258 772))) +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+Array uint16be 4 'bytes)]) + (check-equal? (send array decode stream) '(258 772))) + -;; todo ; it 'should decode length from parent key', -> ; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] ; array = new ArrayT uint8, 'len' ; array.decode(stream, len: 4).should.deep.equal [1, 2, 3, 4] ; -#;(let ([stream (+DecodeStream (bytes 1 2 3 4 5))] - [array (+Array uint8 4 'len)]) - (check-equal? (send array decode stream (mhash 'len 4)) '(1 2 3 4))) +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+Array uint8 4 'len)]) + (check-equal? (send array decode stream (mhash 'len 4)) '(1 2 3 4))) + -;; todo ; it 'should decode amount of bytes from parent key', -> ; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] ; array = new ArrayT uint16, 'len', 'bytes' ; array.decode(stream, len: 4).should.deep.equal [258, 772] -#;(let ([stream (+DecodeStream (bytes 1 2 3 4 5))] - [array (+Array uint16be 'len 'bytes)]) - (check-equal? (send array decode stream (mhash 'len 4)) '(258 772))) +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+Array uint16be 'len 'bytes)]) + (check-equal? (send array decode stream (mhash 'len 4)) '(258 772))) -;; todo ; it 'should decode length as number before array', -> ; stream = new DecodeStream new Buffer [4, 1, 2, 3, 4, 5] ; array = new ArrayT uint8, uint8 ; array.decode(stream).should.deep.equal [1, 2, 3, 4] -#;(let ([stream (+DecodeStream (bytes 1 2 3 4 5))] - [array (+Array uint8 uint8)]) - (check-equal? (send array decode stream (mhash 'len 4)) '(1 2 3 4))) +(let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))] + [array (+Array uint8 uint8)]) + (check-equal? (send array decode stream) '(1 2 3 4))) -;; todo ; it 'should decode amount of bytes as number before array', -> ; stream = new DecodeStream new Buffer [4, 1, 2, 3, 4, 5] ; array = new ArrayT uint16, uint8, 'bytes' ; array.decode(stream).should.deep.equal [258, 772] -#;(let ([stream (+DecodeStream (bytes 4 1 2 3 4 5))] - [array (+Array uint16be uint8 'bytes)]) - (check-equal? (send array decode stream) '(258 772))) +(let ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))] + [array (+Array uint16be uint8 'bytes)]) + (check-equal? (send array decode stream) '(258 772))) ; it 'should decode length from function', -> ; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] ; array = new ArrayT uint8, -> 4 ; array.decode(stream).should.deep.equal [1, 2, 3, 4] -#;(let ([stream (+DecodeStream (bytes 1 2 3 4 5))] +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] [array (+Array uint8 (λ _ 4))]) (check-equal? (send array decode stream) '(1 2 3 4))) -;; todo + ; it 'should decode amount of bytes from function', -> ; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] ; array = new ArrayT uint16, (-> 4), 'bytes' ; array.decode(stream).should.deep.equal [258, 772] -#;(let ([stream (+DecodeStream (bytes 4 1 2 3 4 5))] - [array (+Array uint16be (λ _ 4) 'bytes)]) - (check-equal? (send array decode stream) '(258 772))) +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+Array uint16be (λ _ 4) 'bytes)]) + (check-equal? (send array decode stream) '(258 772))) + -;; todo ; it 'should decode to the end of the parent if no length is given', -> ; stream = new DecodeStream new Buffer [1, 2, 3, 4, 5] ; array = new ArrayT uint8 ; array.decode(stream, _length: 4, _startOffset: 0).should.deep.equal [1, 2, 3, 4] -#;(let ([stream (+DecodeStream (bytes 1 2 3 4 5))] - [array (+Array uint8)]) - (check-equal? (send array decode stream (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))) +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))] + [array (+Array uint8)]) + (check-equal? (send array decode stream (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))) ; it 'should decode to the end of the stream if no parent and length is given', -> ; stream = new DecodeStream new Buffer [1, 2, 3, 4] ; array = new ArrayT uint8 ; array.decode(stream).should.deep.equal [1, 2, 3, 4] -#;(let ([stream (+DecodeStream (bytes 1 2 3 4))] +(let ([stream (+DecodeStream (+Buffer '(1 2 3 4)))] [array (+Array uint8)]) (check-equal? (send array decode stream) '(1 2 3 4))) @@ -108,12 +106,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee (let ([array (+Array uint8 10)]) (check-equal? (send array size '(1 2 3 4)) 4)) -;; todo + ; it 'should add size of length field before string', -> ; array = new ArrayT uint8, uint8 ; array.size([1, 2, 3, 4]).should.equal 5 ; -#;(let ([array (+Array uint8 uint8)]) +(let ([array (+Array uint8 uint8)]) (check-equal? (send array size '(1 2 3 4)) 5)) @@ -124,8 +122,6 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee (check-equal? (send array size) 10)) - - ; describe 'encode', -> ; it 'should encode using array length', (done) -> ; stream = new EncodeStream @@ -136,6 +132,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint8, 10 ; array.encode(stream, [1, 2, 3, 4]) ; stream.end() + +(let ([stream (+EncodeStream)] + [array (+Array uint8 10)]) + (send array encode stream '(1 2 3 4)) + (check-equal? (send stream dump) (+Buffer '(1 2 3 4)))) + + ; ; it 'should encode length as number before array', (done) -> ; stream = new EncodeStream @@ -146,7 +149,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; array = new ArrayT uint8, uint8 ; array.encode(stream, [1, 2, 3, 4]) ; stream.end() -; + +(let ([stream (+EncodeStream)] + [array (+Array 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) -> @@ -155,4 +165,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee ; ; array = new ArrayT new Pointer(uint8, uint8), uint8 ; array.encode(stream, [1, 2, 3, 4]) -; stream.end() \ No newline at end of file +; stream.end() + +#;(let ([stream (+EncodeStream)] + [array (+Array (+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 c78808ba..2e5da83c 100644 --- a/pitfall/restructure/array.rkt +++ b/pitfall/restructure/array.rkt @@ -1,5 +1,5 @@ #lang restructure/racket -(require "number.rkt" "utils.rkt" "stream.rkt") +(require "number.rkt" (prefix-in utils- "utils.rkt") "stream.rkt" br/cond) (provide (all-defined-out)) #| @@ -10,14 +10,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (define-subclass Streamcoder (Array type [length_ #f] [lengthType 'count]) (define/augride (decode stream [parent #f]) - (define pos (send stream pos)) - (define res (make-object RestructureBase)) + (define res (make-object RestructureBase)) ; instead of empty list (define ctx parent) (define length__ - (and length_ (resolveLength length_ stream parent))) + (and length_ (utils-resolveLength length_ stream parent))) (when (NumberT? length_) ;; define hidden properties @@ -28,55 +27,61 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (set! ctx res)) - ) - #| (cond [(or (not length__) (eq? lengthType 'bytes)) (define target (cond [length__ (+ (send stream pos) length__)] [(and parent (· parent _length)) - (+ (· parent _startOffset) - (· parent _length))] - [else - (*length stream)])) - (while (< (send stream pos) target) - ( - - #;(define length__ (cond - ;; explicit length - [length_ (resolveLength length_ stream parent)] - [else ;; implicit length: length of stream divided by size of item - (define num (send stream length)) - (define denom (send type size)) - (unless (andmap (λ (x) (and x (number? x))) (list num denom)) - (raise-argument-error 'Array:decode "valid length and size" (list num denom))) - (floor (/ (send stream length) (send type size)))])) - - - - #;(define res (caseq lengthType - [(bytes) (error 'array-decode-bytes-no!)] - [(count) (for/list ([i (in-range length__)]) - (send type decode stream ctx))])) - res) -|# - - (define/override (size [array #f]) - (when (and array (not (list? array))) - (raise-argument-error 'Array:size "list" array)) + (+ (ref parent '_startOffset) + (ref parent '_length))] + [else (· stream length_)])) + (ref-set! res '_list + (push-end res + (for/list ([i (in-naturals)] + #:break (= (send stream pos) target)) + (send type decode stream ctx))))] + [else + (ref-set! res '_list + (push-end res + (for/list ([i (in-range length__)]) + (send type decode stream ctx))))]) + + (countable->list res)) + + (define/override (size [array #f] [ctx #f]) + (when array (unless (countable? array) + (raise-argument-error 'Array:size "list or countable" array))) (cond - [(not array) (* (send type size) (resolveLength length_ (+DecodeStream) #f))] - [(Number? length_) (send length_ size)] - [else (* (send type size) (length array))])) + [(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])) (define/augride (encode stream array [parent #f]) - (unless (list? array) (raise-argument-error 'Array:encode "list" array)) - (for ([item (in-list array)]) - (send type encode stream item)))) + (when array (unless (countable? array) + (raise-argument-error 'Array:encode "list or countable" array))) + (define ctx parent) + (when (NumberT? length_) + (set! ctx (mhash 'pointers null + 'startOffset (· stream pos) + 'parent parent)) + (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)) -(define a (+Array uint8)) -(define stream (+DecodeStream #"ABCDEFG")) -(send a decode stream) + (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 @@ -117,7 +122,7 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee (define-subclass Array (LazyArray) (inherit-field length_ type) (define/override (decode stream [parent #f]) - (define len (resolveLength length_ stream parent)) + (define len (utils-resolveLength length_ stream parent)) (define res (+InnerLazyArray type len stream parent)) (define lazy-space (* len (send type size))) (report lazy-space) diff --git a/pitfall/restructure/generic.rkt b/pitfall/restructure/generic.rkt index 3dd71f16..a3e8e6e3 100644 --- a/pitfall/restructure/generic.rkt +++ b/pitfall/restructure/generic.rkt @@ -60,13 +60,20 @@ (define-generics countable (length countable) + (countable->list countable) #:defaults - ([list? (define length b:length)] - [vector? (define length vector-length)] - [string? (define length string-length)] - [bytes? (define length bytes-length)] - [dict? (define length dict-count)] - [object? (define (length o) (with-handlers ([exn:fail:object? (λ (exn) 0)]) (b:length (get-field _list o))))])) + ([list? (define length b:length) + (define countable->list (λ (x) x))] + [vector? (define length vector-length) + (define countable->list vector->list)] + [string? (define length string-length) + (define countable->list string->list)] + [bytes? (define length bytes-length) + (define countable->list bytes->list)] + [dict? (define length dict-count) + (define countable->list (λ (x) x))] + [object? (define (length o) (b:length (get-field _list o))) + (define (countable->list o) (get-field _list o))])) (module+ test (require racket/list) @@ -75,5 +82,18 @@ (check-equal? (length (make-string 42 #\x)) 42) (check-equal? (length (make-bytes 42 0)) 42) (check-equal? (length (map cons (range 42) (range 42))) 42) - (check-equal? (length (make-object (class object% (super-new) (field [_list (make-list 42 #f)])))) 42) - (check-equal? (length (make-object (class object% (super-new)))) 0)) + (check-equal? (length (make-object (class object% (super-new) (field [_list (make-list 42 #f)])))) 42)) + +(define-generics pushable + (push-end pushable xs) + #:defaults + ([list? (define push-end b:append)] + [object? (define (push-end o xs) + (append (get-field _list o) xs))])) + +(module+ test + (check-equal? (push-end (range 3) '(3 4 5)) (range 6)) + (define o2 (make-object (class object% (super-new) (field [_list (range 3)])))) + (ref-set! o2 '_list (push-end o2 '(3 4 5))) + (check-equal? (ref o2 '_list) (range 6))) + diff --git a/pitfall/restructure/stream.rkt b/pitfall/restructure/stream.rkt index 3b82df25..cb51b714 100644 --- a/pitfall/restructure/stream.rkt +++ b/pitfall/restructure/stream.rkt @@ -1,4 +1,5 @@ #lang restructure/racket +(require racket/private/generic-methods) (provide (all-defined-out)) ;; helper class @@ -71,56 +72,68 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee (define bs (*ref type-sizes (string->symbol (string-downcase (string-replace (symbol->string 'ID) "read" ""))))) (readBuffer bs))) -(define-subclass* PortWrapper (DecodeStream [buffer #""]) - (unless (bytes? buffer) ; corresponds to a Node Buffer, not a restructure BufferT object - (raise-argument-error 'DecodeStream:constructor "bytes" buffer)) - (super-make-object (open-input-bytes buffer)) - (inherit-field _port) - - (field [pos 0] - [length_ (length buffer)]) - - (define/public (readString length [encoding 'ascii]) - (define proc (caseq encoding - [(utf16le) (error 'bah)] - [(ucs2) (error 'bleh)] - [(utf8) bytes->string/utf-8] - [(ascii) bytes->string/latin-1] - [else identity])) - (proc (subbytes buffer pos (increment-field! pos this length)))) - - (define/public-final (readBuffer count) - (unless (index? count) - (raise-argument-error 'DecodeStream:read "positive integer" count)) - (define bytes-remaining (- length_ (port-position _port))) - (when (> count bytes-remaining) - (raise-argument-error 'DecodeStream:read (format "byte count not more than bytes remaining = ~a" bytes-remaining) count)) - (increment-field! pos this count) - (define bs (read-bytes count _port)) - (unless (= pos (file-position _port)) (raise-result-error 'DecodeStream "positions askew" (list pos (file-position _port)))) - bs) - - (define/public (read count) (readBuffer count)) - - (define/public (readUInt8) (bytes-ref (readBuffer 1) 0)) - (define/public (readUInt16BE) (+ (arithmetic-shift (readUInt8) 8) (readUInt8))) - (define/public (readInt16BE) (unsigned->signed (readUInt16BE) 16)) - (define/public (readUInt16LE) (+ (readUInt8) (arithmetic-shift (readUInt8) 8))) - (define/public (readUInt24BE) (+ (arithmetic-shift (readUInt16BE) 8) (readUInt8))) - (define/public (readUInt24LE) (+ (readUInt16LE) (arithmetic-shift (readUInt8) 16))) - (define/public (readInt24BE) (unsigned->signed (readUInt24BE) 24)) - (define/public (readInt24LE) (unsigned->signed (readUInt24LE) 24)) +(define countable<%> + (interface* () + ([(generic-property gen:countable) + (generic-method-table gen:countable + (define (length o) (get-field length_ o)))]))) + +(define DecodeStreamT + (class* PortWrapper + (countable<%>) + (init-field [buffer #""]) + (unless (bytes? buffer) ; corresponds to a Node Buffer, not a restructure BufferT object + (raise-argument-error 'DecodeStream:constructor "bytes" buffer)) + (super-make-object (open-input-bytes buffer)) + (inherit-field _port) + + (field [pos 0] + [length_ (length buffer)]) + + (define/public (readString length [encoding 'ascii]) + (define proc (caseq encoding + [(utf16le) (error 'bah)] + [(ucs2) (error 'bleh)] + [(utf8) bytes->string/utf-8] + [(ascii) bytes->string/latin-1] + [else identity])) + (proc (subbytes buffer pos (increment-field! pos this length)))) + + (define/public-final (readBuffer count) + (unless (index? count) + (raise-argument-error 'DecodeStream:read "positive integer" count)) + (define bytes-remaining (- length_ (port-position _port))) + (when (> count bytes-remaining) + (raise-argument-error 'DecodeStream:read (format "byte count not more than bytes remaining = ~a" bytes-remaining) count)) + (increment-field! pos this count) + (define bs (read-bytes count _port)) + (unless (= pos (file-position _port)) (raise-result-error 'DecodeStream "positions askew" (list pos (file-position _port)))) + bs) + + (define/public (read count) (readBuffer count)) + + (define/public (readUInt8) (bytes-ref (readBuffer 1) 0)) + (define/public (readUInt16BE) (+ (arithmetic-shift (readUInt8) 8) (readUInt8))) + (define/public (readInt16BE) (unsigned->signed (readUInt16BE) 16)) + (define/public (readUInt16LE) (+ (readUInt8) (arithmetic-shift (readUInt8) 8))) + (define/public (readUInt24BE) (+ (arithmetic-shift (readUInt16BE) 8) (readUInt8))) + (define/public (readUInt24LE) (+ (readUInt16LE) (arithmetic-shift (readUInt8) 16))) + (define/public (readInt24BE) (unsigned->signed (readUInt24BE) 24)) + (define/public (readInt24LE) (unsigned->signed (readUInt24LE) 24)) - (define/override-final (dump) - (define current-position (port-position _port)) - (set-port-position! _port 0) - (define bs (port->bytes _port)) - (set-port-position! _port current-position) - bs)) + (define/override-final (dump) + (define current-position (port-position _port)) + (set-port-position! _port 0) + (define bs (port->bytes _port)) + (set-port-position! _port current-position) + bs))) + +(define-subclass DecodeStreamT (DecodeStream)) (test-module (define ds (+DecodeStream #"ABCD")) (check-true (DecodeStream? ds)) + (check-equal? (length ds) 4) (check-equal? (send ds dump) #"ABCD") (check-equal? (send ds dump) #"ABCD") ; dump can repeat (check-equal? (send ds readUInt16BE) 16706) @@ -138,8 +151,6 @@ 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 (hash? parent) - (raise-argument-error 'Streamcoder:decode "hash" parent))) (define stream (if (bytes? x) (+DecodeStream x) x)) (unless (DecodeStream? stream) (raise-argument-error 'Streamcoder:decode "bytes or DecodeStream" x)) diff --git a/pitfall/restructure/utils.rkt b/pitfall/restructure/utils.rkt index 55f63bdb..37a536c9 100644 --- a/pitfall/restructure/utils.rkt +++ b/pitfall/restructure/utils.rkt @@ -3,11 +3,9 @@ (require "number.rkt") (define (resolveLength length [stream #f] [parent #f]) - (define res - (cond + (cond [(number? length) length] [(procedure? length) (length parent)] [(and parent (symbol? length)) (ref parent length)] ; treat as key into RStruct parent - [(and stream (Number? length)) (send length decode stream)] - [else (raise-argument-error 'resolveLength "fixed-size argument" length)])) - res) \ No newline at end of file + [(and stream (NumberT? length)) (send length decode stream)] + [else (raise-argument-error 'resolveLength "fixed-size argument" length)])) \ No newline at end of file