array tests pass

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()
+;      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))))

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)

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)))
+

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))

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)
+    [(and stream (NumberT? length)) (send length decode stream)]
+    [else (raise-argument-error 'resolveLength "fixed-size argument" length)]))