resume in pointer

xenomorph/xenomorph/array.rkt

@@ -1,5 +1,11 @@
 #lang debug racket/base
-(require racket/dict racket/sequence "helper.rkt" "number.rkt" "util.rkt" sugar/unstable/dict)
+(require racket/dict
+         racket/class
+         racket/sequence
+         "helper.rkt"
+         "number.rkt"
+         "util.rkt"
+         sugar/unstable/dict)
 (provide (all-defined-out))
 
 #|
@@ -7,94 +13,96 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 |#
 
-(define/post-decode (xarray-decode xa [port-arg (current-input-port)] #:parent [parent #f])
-  (define port (->input-port port-arg))
-  (parameterize ([current-input-port port])
-    (define new-parent (if (xint? (xarray-base-len xa))
-                           (mhasheq 'parent parent
-                                    '_startOffset (pos port)
-                                    '_currentOffset 0
-                                    '_length (xarray-base-len xa))
-                           parent))
-    (define decoded-len (resolve-length (xarray-base-len xa) #:parent parent))
-    (cond
-      [(or (not decoded-len) (eq? (xarray-length-type xa) 'bytes))
-       (define end-pos (cond
-                         ;; decoded-len is byte length
-                         [decoded-len (+ (pos port) decoded-len)]
-                         ;; no decoded-len, but parent has length
-                         [(and parent (not (zero? (dict-ref parent '_length)))) (+ (dict-ref parent '_startOffset) (dict-ref parent '_length))]
-                         ;; no decoded-len or parent, so consume whole stream
-                         [else +inf.0]))
-       (for/list ([i (in-naturals)]
-                  #:break (or (eof-object? (peek-byte)) (= (pos port) end-pos)))
-         (xdecode (xarray-base-type xa) #:parent new-parent))]
-      ;; we have decoded-len, which is treated as count of items
-      [else (for/list ([i (in-range decoded-len)])
-              (xdecode (xarray-base-type xa) #:parent new-parent))])))
+(define xarray-base%
+  (class* xenobase% ()
+    (super-new)
+    (init-field type len)
+    (unless (xenomorphic? type)
+      (raise-argument-error '+xarray "xenomorphic type" type))
+    (unless (length-resolvable? len)
+      (raise-argument-error '+xarray "length-resolvable?" len))))
 
-(define/pre-encode (xarray-encode xa array [port-arg (current-output-port)] #:parent [parent #f])
-  (unless (sequence? array)
-    (raise-argument-error 'xarray-encode "sequence" array))
-  (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
-  (parameterize ([current-output-port port])
-    (define (encode-items parent)
-      ;; todo: should array with fixed length stop encoding after it reaches max?
-      ;; cf. xstring, which rejects input that is too big for fixed length.
-      (let* (#;[items (sequence->list array)]
-             #;[item-count (length items)]
-             #;[max-items (if (number? (xarray-len xa)) (xarray-len xa) item-count)])
-        (for ([item array])
-          (encode (xarray-base-type xa) item #:parent parent))))
-    (cond
-      [(xint? (xarray-base-len xa))
-       (let ([parent (mhash 'pointers null
-                            'startOffset (pos port)
-                            'parent parent)])
-         (dict-set! parent 'pointerOffset (+ (pos port) (size xa array #:parent parent)))
-         (encode (xarray-base-len xa) (length array)) ; encode length at front
-         (encode-items parent)
-         (for ([ptr (in-list (dict-ref parent 'pointers))]) ; encode pointer data at end
-           (encode (dict-ref ptr 'type) (dict-ref ptr 'val))))]
-      [else (encode-items parent)])
-    (unless port-arg (get-output-bytes port))))
+(define xarray%
+  (class* xarray-base% ()
+    (super-new)
+    (init-field length-type)
+    (unless (memq length-type '(bytes count))
+      (raise-argument-error '+xarray "'bytes or 'count" length-type))
 
-(define/finalize-size (xarray-size xa [val #f] #:parent [parent #f])
-  (when val (unless (sequence? val)
-              (raise-argument-error 'xarray-size "sequence" val)))
-  (cond
-    [val (define-values (new-parent len-size) (if (xint? (xarray-base-len xa))
-                                                  (values (mhasheq 'parent parent) (size (xarray-base-len xa)))
-                                                  (values parent 0)))
-         (define items-size (for/sum ([item val])
-                              (size (xarray-base-type xa) item #:parent new-parent)))
-         (+ items-size len-size)]
-    [else (define item-count (resolve-length (xarray-base-len xa) #f #:parent parent))
-          (define item-size (size (xarray-base-type xa) #f #:parent parent))
-          (* item-size item-count)]))
+    (inherit-field type len)
 
-(struct xarray-base xbase (type len) #:transparent)
-(struct xarray xarray-base (length-type) #:transparent
-  #:methods gen:xenomorphic
-  [(define decode xarray-decode)
-   (define xdecode xarray-decode)
-   (define encode xarray-encode)
-   (define size xarray-size)])
+    (define/augment (xxdecode port parent . _)
+      (define new-parent (if (xint? len)
+                             (mhasheq 'parent parent
+                                      '_startOffset (pos port)
+                                      '_currentOffset 0
+                                      '_length len)
+                             parent))
+      (define decoded-len (resolve-length len #:parent parent))
+      (cond
+        [(or (not decoded-len) (eq? length-type 'bytes))
+         (define end-pos (cond
+                           ;; decoded-len is byte length
+                           [decoded-len (+ (pos port) decoded-len)]
+                           ;; no decoded-len, but parent has length
+                           [(and parent (not (zero? (dict-ref parent '_length))))
+                            (+ (dict-ref parent '_startOffset) (dict-ref parent '_length))]
+                           ;; no decoded-len or parent, so consume whole stream
+                           [else +inf.0]))
+         (for/list ([i (in-naturals)]
+                    #:break (or (eof-object? (peek-byte)) (= (pos port) end-pos)))
+           (send type xxdecode port new-parent))]
+        ;; we have decoded-len, which is treated as count of items
+        [else (for/list ([i (in-range decoded-len)])
+                (send type xxdecode port new-parent))]))
+
+    (define/augment (xxencode array port [parent #f])
+      (unless (sequence? array)
+        (raise-argument-error 'xarray-encode "sequence" array))
+      (define (encode-items parent)
+        ;; todo: should array with fixed length stop encoding after it reaches max?
+        ;; cf. xstring, which rejects input that is too big for fixed length.
+        (let* (#;[items (sequence->list array)]
+               #;[item-count (length items)]
+               #;[max-items (if (number? (xarray-len xa)) (xarray-len xa) item-count)])
+          (for ([item array])
+            (send type xxencode item port parent))))
+      (cond
+        [(xint? len)
+         (let ([parent (mhash 'pointers null
+                              'startOffset (pos port)
+                              'parent parent)])
+           (dict-set! parent 'pointerOffset (+ (pos port) (xxsize array parent)))
+           (send len xxencode (length array) port) ; encode length at front
+           (encode-items parent)
+           (for ([ptr (in-list (dict-ref parent 'pointers))]) ; encode pointer data at end
+             (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port)))]
+        [else (encode-items parent)]))
+
+    (define/augment (xxsize [val #f] [parent #f])
+      (when val (unless (sequence? val)
+                  (raise-argument-error 'xarray-size "sequence" val)))
+      (cond
+        [val (define-values (new-parent len-size)
+               (if (xint? len)
+                   (values (mhasheq 'parent parent) (send len xxsize))
+                   (values parent 0)))
+             (define items-size (for/sum ([item val])
+                                  (send type xxsize item new-parent)))
+             (+ items-size len-size)]
+        [else (define item-count (resolve-length len #f #:parent parent))
+              (define item-size (send type xxsize #f parent))
+              (* item-size item-count)]))))
 
 (define (+xarray [type-arg #f] [len-arg #f] [length-type-arg 'count]
-                 #:type [type-kwarg #f] #:length [len-kwarg #f] #:count-bytes [count-bytes? #f])
-  (define type (or type-arg type-kwarg))
-  (define len (or len-arg len-kwarg))
-  (define length-type (if count-bytes? 'bytes length-type-arg))
-  (unless (xenomorphic? type)
-    (raise-argument-error '+xarray "xenomorphic type" type))
-  (unless (length-resolvable? len)
-    (raise-argument-error '+xarray "length-resolvable?" len))
-  (unless (memq length-type '(bytes count))
-    (raise-argument-error '+xarray "'bytes or 'count" length-type))
-  (xarray type len length-type))
+                 #:type [type-kwarg #f]
+                 #:length [len-kwarg #f]
+                 #:count-bytes [count-bytes? #f]
+                 #:subclass [class xarray%])
+  (new class [type (or type-arg type-kwarg)]
+       [len (or len-arg len-kwarg)]
+       [length-type (if count-bytes? 'bytes length-type-arg)]))
   
-
 (module+ test
   (require rackunit)
   (check-equal? (decode (+xarray uint16be 3) #"ABCDEF") '(16706 17220 17734))

xenomorph/xenomorph/pointer.rkt

@@ -2,6 +2,7 @@
 (require "helper.rkt"
          "number.rkt"
          racket/dict
+         racket/class
          racket/promise
          sugar/unstable/dict)
 (provide (all-defined-out))
@@ -16,7 +17,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
     [(dict-ref parent 'parent #f) => find-top-parent]
     [else parent]))
 
-(define/post-decode (xpointer-decode xp [port-arg (current-input-port)] #:parent [parent #f])
+#;(define/post-decode (xpointer-decode xp [port-arg (current-input-port)] #:parent [parent #f])
   (define port (->input-port port-arg))
   (parameterize ([current-input-port port])
     (define offset (xdecode (xpointer-offset-type xp) #:parent parent))
@@ -53,7 +54,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
     [(xvoid-pointer? val) (values (xvoid-pointer-type val) (xvoid-pointer-value val))]
     [else (raise-argument-error 'Pointer:size "VoidPointer" val)]))
 
-(define/pre-encode (xpointer-encode xp val [port-arg (current-output-port)] #:parent [parent #f])
+#;(define/pre-encode (xpointer-encode xp val [port-arg (current-output-port)] #:parent [parent #f])
   (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
   (unless parent ; todo: furnish default pointer context? adapt from Struct?
     (raise-argument-error 'xpointer-encode "valid pointer context" parent))
@@ -78,7 +79,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
             (dict-set! new-parent 'pointerOffset (+ (dict-ref new-parent 'pointerOffset) (size type val #:parent  parent)))))))
   (unless port-arg (get-output-bytes port)))
 
-(define (xpointer-size xp [val #f] #:parent [parent #f])
+#;(define (xpointer-size xp [val #f] #:parent [parent #f])
   (let*-values ([(parent) (case (pointer-relative-to xp)
                             [(local immediate) parent]
                             [(parent) (dict-ref parent 'parent)]
@@ -90,7 +91,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
                                           (+ (dict-ref parent 'pointerSize) (size type val #:parent parent)))))
     (size (xpointer-offset-type xp))))
 
-(struct xpointer xbase (offset-type type options) #:transparent
+(define xpointer%
+  (class* xenobase% ()
+    (super-new)
+    (init-field offset-type type options)
+
+    (define pointer-relative-to (dict-ref options 'relative-to))
+(define allow-null (dict-ref options 'allowNull)) 
+(define null-value (dict-ref options 'nullValue))
+(define pointer-lazy? (dict-ref options 'lazy))
+
+
+    ))
+
+#;(struct xpointer xbase (offset-type type options) #:transparent
   #:methods gen:xenomorphic
   [(define decode xpointer-decode)
    (define xdecode xpointer-decode)
@@ -111,14 +125,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
                            'lazy lazy?
                            'allowNull allow-null?
                            'nullValue null-value))
-  (define offset-type (or offset-arg offset-kwarg uint8))
   (define type-in (or type-arg type-kwarg uint8))
-  (xpointer offset-type (case type-in [(void) #f][else type-in]) options))
+  (new xpointer%
+       [offset-type (or offset-arg offset-kwarg uint8)]
+       [type (case type-in [(void) #f][else type-in])]
+       [options options]))
 
-(define (pointer-relative-to xp) (dict-ref (xpointer-options xp) 'relative-to))
-(define (allow-null xp) (dict-ref (xpointer-options xp) 'allowNull)) 
-(define (null-value xp) (dict-ref (xpointer-options xp) 'nullValue))
-(define (pointer-lazy? xp) (dict-ref (xpointer-options xp) 'lazy))
 
 ;; A pointer whose type is determined at decode time
 (struct xvoid-pointer (type value) #:transparent)

xenomorph/xenomorph/test/array-test.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
 (require rackunit
+         racket/class
          "../helper.rkt"
          "../array.rkt"
          "../number.rkt"
@@ -19,8 +20,10 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
 (test-case 
  "decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define xa (+xarray #:type uint8 #:length 4))
-   (set-post-decode! xa (λ (val . _) (map (λ (x) (* 2 x)) val)))
+   (define myarray% (class xarray%
+                   (super-new)
+                   (define/override (post-decode val) (map (λ (x) (* 2 x)) val))))
+   (define xa (+xarray #:type uint8 #:length 4 #:subclass myarray%))
    (check-equal? (decode xa) '(2 4 6 8))))
 
 (test-case 
@@ -31,12 +34,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
 (test-case 
  "decode length from parent key"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (check-equal? (xdecode (+xarray #:type uint8 #:length 'len) #:parent (mhash 'len 4)) '(1 2 3 4))))
+   (check-equal? (send (+xarray #:type uint8 #:length 'len) xxdecode (current-input-port) (mhash 'len 4)) '(1 2 3 4))))
 
 (test-case 
  "decode byte count from parent key"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (check-equal? (xdecode (+xarray #:type uint16be #:length 'len #:count-bytes #t) #:parent (mhash 'len 4)) '(258 772))))
+   (check-equal? (send (+xarray #:type uint16be #:length 'len #:count-bytes #t) xxdecode (current-input-port) (mhash 'len 4)) '(258 772))))
 
 (test-case 
  "decode length as number before array"
@@ -61,12 +64,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
 (test-case 
  "decode to the end of parent if no length given"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (check-equal? (xdecode (+xarray #:type uint8) #:parent (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))))
+   (check-equal? (send (+xarray #:type uint8) xxdecode (current-input-port) (mhash '_length 4 '_startOffset 0)) '(1 2 3 4))))
 
 (test-case 
  "decode to the end of the stream if parent exists, but its length is 0"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (check-equal? (xdecode (+xarray #:type uint8) #:parent (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5))))
+   (check-equal? (send (+xarray #:type uint8) xxdecode (current-input-port) (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5))))
 
 (test-case 
  "decode to the end of the stream if no parent and length is given"
@@ -92,8 +95,10 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
 (test-case 
  "encode with pre-encode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define xa (+xarray #:type uint8 #:length 4))
-   (set-pre-encode! xa (λ (val . _) (map (λ (x) (* 2 x)) val)))
+   (define myarray% (class xarray%
+                   (super-new)
+                   (define/override (pre-encode val) (map (λ (x) (* 2 x)) val))))
+   (define xa (+xarray #:type uint8 #:length 4 #:subclass myarray%))
    (check-equal? (encode xa '(1 2 3 4) #f) (bytes 2 4 6 8))))
 
 (test-case