xla

xenomorph/xenomorph/array.rkt

@@ -13,25 +13,19 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 |#
 
-(define xarray-base%
+(define xarray%
   (class xenobase%
     (super-new)
-    (init-field type len)
+    (init-field type len length-type)
+    
     (unless (xenomorphic-type? type)
       (raise-argument-error '+xarray "xenomorphic type" type))
     (unless (length-resolvable? len)
-      (raise-argument-error '+xarray "length-resolvable?" len))))
-
-(define xarray%
-  (class xarray-base%
-    (super-new)
-    (init-field length-type)
+      (raise-argument-error '+xarray "length-resolvable?" len))
     (unless (memq length-type '(bytes count))
       (raise-argument-error '+xarray "'bytes or 'count" length-type))
 
-    (inherit-field type len)
-
-    (define/augment (xxdecode port parent)
+    (define/augride (xxdecode port parent)
       (define new-parent (if (xint? len)
                              (mhasheq 'parent parent
                                       '_startOffset (pos port)
@@ -56,7 +50,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
         [else (for/list ([i (in-range resolved-len)])
                 (send type xxdecode port new-parent))]))
 
-    (define/augment (xxencode array port [parent #f])
+    (define/augride (xxencode array port [parent #f])
       (unless (sequence? array)
         (raise-argument-error 'xarray-encode "sequence" array))
       (define (encode-items parent)
@@ -79,7 +73,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
              (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port)))]
         [else (encode-items parent)]))
 
-    (define/augment (xxsize [val #f] [parent #f])
+    (define/augride (xxsize [val #f] [parent #f])
       (when val (unless (sequence? val)
                   (raise-argument-error 'xarray-size "sequence" val)))
       (cond
@@ -102,6 +96,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
   (new class [type (or type-arg type-kwarg)]
        [len (or len-arg len-kwarg)]
        [length-type (if count-bytes? 'bytes length-type-arg)]))
+
+(define (xarray? x) (is-a? x xarray%))
   
 (module+ test
   (require rackunit "generic.rkt")

xenomorph/xenomorph/lazy-array.rkt

@@ -1,36 +1,17 @@
-#lang racket/base
+#lang debug racket/base
 (require racket/class
-         "helper.rkt" "util.rkt" "number.rkt" "array.rkt" racket/stream racket/dict sugar/unstable/dict)
+         "helper.rkt" "util.rkt" "number.rkt" "array.rkt" racket/stream sugar/unstable/dict)
 (provide (all-defined-out))
 
 #|
 approximates
 https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
 |#
-  
-#;(define (xlazy-array-decode xla [port-arg (current-input-port)] #:parent [parent #f])
-    (define port (->input-port port-arg))
-    (parameterize ([current-input-port port])
-      ))
-
-#;(define (xlazy-array-encode xla val [port-arg (current-output-port)] #:parent [parent #f])
-    )
-
-#;(define (xlazy-array-size xla [val #f] #:parent [parent #f]))
-
-;; xarray-base holds type and len fields
-#;(struct xlazy-array xarray-base () #:transparent
-    #:methods gen:xenomorphic
-    [(define decode xlazy-array-decode)
-     (define xdecode xlazy-array-decode)
-     (define encode xlazy-array-encode)
-     (define size xlazy-array-size)])
-
+ 
 (define xlazy-array%
-  (class xarray-base%
+  (class xarray%
     (super-new)
-    (init-field lazy-type values)
-    (inherit-field len)
+    (inherit-field type len)
 
     (define/override (xxdecode port parent)
       (define starting-pos (pos port)) ; ! placement matters. `resolve-length` will change `pos`
@@ -42,14 +23,12 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
                                  '_length len)
                         parent)])
         (define starting-pos (pos port))
-        (define type type)
         (begin0
           (for/stream ([index (in-range decoded-len)])
             (define orig-pos (pos port))
             (pos port (+ starting-pos (* (send type xxsize #f parent) index)))
-            ;; use explicit `port` arg below because this evaluation is delayed
             (begin0
-              (send this post-decode (send type xxdecode port parent))
+              (send type xxdecode port parent)
               (pos port orig-pos)))
           (pos port (+ (pos port) (* decoded-len (send type xxsize #f parent)))))))
 
@@ -57,7 +36,7 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
       (super xxencode (if (stream? val) (stream->list val) val) port parent))
     
     (define/override (xxsize [val #f] [parent #f])
-    (super xxsize (if (stream? val) (stream->list val) val) parent))))
+      (super xxsize (if (stream? val) (stream->list val) val) parent))))
 
 (define (+xlazy-array [type-arg #f] [len-arg #f]
                       #:type [type-kwarg #f]
@@ -65,11 +44,9 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
                       #:subclass [class xlazy-array%])
   (define type (or type-arg type-kwarg))
   (define len (or len-arg len-kwarg))
-  (unless (xenomorphic-type? type)
-    (raise-argument-error '+xarray "xenomorphic type" type))
-  (unless (length-resolvable? len)
-    (raise-argument-error '+xarray "length-resolvable?" len))
-  (new class [type type] [len len]))
+  (new class [type type]
+       [len len]
+       [length-type 'count]))
 
 (module+ test
   (require rackunit "number.rkt" "generic.rkt")

xenomorph/xenomorph/test/lazy-array-test.rkt

@@ -1,11 +1,12 @@
 #lang racket/base
 (require rackunit
-         racket/dict
+         racket/class
          racket/stream
          "../array.rkt"
          "../helper.rkt"
          "../number.rkt"
-         "../lazy-array.rkt")
+         "../lazy-array.rkt"
+         "../generic.rkt")
 
 #|
 approximates
@@ -17,7 +18,6 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
    (define xla (+xlazy-array uint8 4))
    (define arr (decode xla))
-   (check-false (xarray? arr))
    (check-equal? (stream-length arr) 4)
    (check-equal? (pos (current-input-port)) 4)
    (check-equal? (stream-ref arr 0) 1)
@@ -28,8 +28,10 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 (test-case
  "decode should decode items lazily with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define xla (+xlazy-array uint8 4))
-   (set-post-decode! xla (λ (val) (* 2 val)))
+   (define myxla% (class xlazy-array%
+                    (super-new)
+                    (define/override (post-decode str) (stream-map (λ (i) (* 2 i)) str))))
+   (define xla (+xlazy-array uint8 4 #:subclass myxla%))
    (define arr (decode xla))
    (check-false (xarray? arr))
    (check-equal? (stream-length arr) 4)
@@ -70,7 +72,9 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 (test-case
  "encode should work with xlazy-arrays with pre-encode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define xla (+xlazy-array uint8 4))
-   (set-pre-encode! xla (λ (vals) (map (λ (val) (* 2 val)) vals)))
+   (define myxla% (class xlazy-array%
+                    (super-new)
+                    (define/override (pre-encode str) (stream-map (λ (val) (* 2 val)) str))))
+   (define xla (+xlazy-array uint8 4 #:subclass myxla%))
    (define arr (decode xla))  
    (check-equal? (encode xla arr #f) (bytes 2 4 6 8))))