lazy array done

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)

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

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

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"