portify

pitfall/xenomorph/private/array.rkt

@@ -29,13 +29,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
                          [else (· stream length_)]))
        (for/list ([i (in-naturals)]
                   #:break (= (· stream pos) end-pos))
-         (send type decode stream ctx))]
+                 (send type decode stream ctx))]
       ;; we have decoded-len, which is treated as count of items
       [else (for/list ([i (in-range decoded-len)])
-              (send type decode stream ctx))]))
+                      (send type decode stream ctx))]))
   
 
-  (define/override (size [val #f] [ctx #f])
+  (define/augride (size [val #f] [ctx #f])
     (when val (unless (countable? val)
                 (raise-argument-error 'Array:size "list or countable" val)))
     (cond
@@ -43,37 +43,37 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
                                             (values (mhasheq 'parent ctx) (send len size))
                                             (values ctx 0))])
              (+ len-size (for/sum ([item (in-list (countable->list val))])
-                           (send type size item ctx))))]
+                                  (send type size item ctx))))]
       [else (let ([item-count (resolve-length len #f ctx)]
                   [item-size (send type size #f ctx)])
               (* item-size item-count))]))
   
 
-  (define/augride (encode stream array [parent #f])
+  (define/augride (encode port array [parent #f])
     (when array (unless (countable? array)
                   (raise-argument-error 'Array:encode "list or countable" array)))
 
     (define (encode-items ctx)
-      (for ([item (in-list (countable->list array))])
-        (send type encode stream item ctx)))
+      (define results (for/list ([item (in-list (countable->list array))])
+                                (send type encode port item ctx)))
+      (unless port (apply bytes-append results)))
 
     (cond
       [(NumberT? len) (define ctx (mhash 'pointers null
-                                         'startOffset (· stream pos)
+                                         'startOffset (· port pos)
                                          'parent parent))
-                      (ref-set! ctx 'pointerOffset (+ (· stream pos) (size array ctx)))
-                      (send len encode stream (length array)) ; encode length at front
+                      (ref-set! ctx 'pointerOffset (+ (· port pos) (size array ctx)))
+                      (send len encode port (length array)) ; encode length at front
                       (encode-items ctx)
                       (for ([ptr (in-list (· ctx pointers))]) ; encode pointer data at end
-                        (send (· ptr type) encode stream (· ptr val)))]
+                           (send (· ptr type) encode port (· ptr val)))]
       [else (encode-items parent)])))
 
 (define-values (Array Array? +Array) (values ArrayT ArrayT? +ArrayT))
 
 (test-module
- (define stream (+DecodeStream #"ABCDEFG"))
  (define A (+Array uint16be 3))
- (check-equal? (send A decode stream) '(16706 17220 17734))
- (check-equal? (send A encode #f '(16706 17220 17734)) #"ABCDEF")
- (check-equal? (send (+Array uint16be) size '(1 2 3)) 6)
- (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))
+ (check-equal? (decode A #"ABCDEFG") '(16706 17220 17734))
+ (check-equal? (encode A '(16706 17220 17734) #f) #"ABCDEF")
+ (check-equal? (size (+Array uint16be) '(1 2 3)) 6)
+ (check-equal? (size (+Array doublebe) '(1 2 3 4 5)) 40))

pitfall/xenomorph/private/base.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
-(require racket/class sugar/class racket/generic racket/private/generic-methods)
+(require racket/class sugar/class racket/generic racket/private/generic-methods "generic.rkt")
+(require sugar/debug)
 (provide (all-defined-out))
 
 (define-generics codable
@@ -35,16 +36,49 @@
                                       (define (dump o) (send o dump)))])))
 
 
-(define RestructureBase
+(define xenomorph-base%
   (class* object% (codable<%> sizable<%> dumpable<%>)
     (super-new)
     (field [_hash (make-hash)]
            [_list null])
-    (define/public (decode stream . args) (void))
-    (define/public (encode . xs) (void))
-    (define/public (size . xs) (void))
-    (define/public (process . args) (void))
-    (define/public (preEncode . args) (void))
+
+    (define/pubment (decode port [parent #f])
+      (when parent (unless (indexable? parent)
+                     (raise-argument-error 'Xenomorph "indexable" parent)))
+      (define ip (cond
+                   [(bytes? port) (open-input-bytes port)]
+                   [(input-port? port) port]
+                   [else (raise-argument-error 'Xenomorph "bytes or input port" port)]))
+      (post-decode (inner (void) decode ip parent)))
+    
+    (define/pubment (encode port val-in [parent #f])
+      #;(report* port val-in parent)
+      (define val (pre-encode val-in))
+      (when parent (unless (indexable? parent)
+                     (raise-argument-error 'Xenomorph "indexable" parent)))
+      (define op (cond
+                   [(output-port? port) port]
+                   [(not port) (open-output-bytes)]
+                   [else (raise-argument-error 'Xenomorph "output port or #f" port)]))
+      (define encode-result (inner (void) encode port val parent))
+      (when (bytes? encode-result)
+        (write-bytes encode-result op))
+      (when (not port) (get-output-bytes op)))
+    
+    (define/pubment (size [val #f] [parent #f])
+      (when parent (unless (indexable? parent)
+                     (raise-argument-error 'Xenomorph "indexable" parent)))
+      (define result (inner (void) size val parent))
+      (when result (unless (and (integer? result) (not (negative? result)))
+                     (raise-argument-error 'Xenomorph "integer" result)))
+      result)
+    
+    (define/public (post-decode val) val)
+    (define/public (pre-encode val) val)
     (define/public (dump) (void))))
 
-(define-class-predicates RestructureBase)
+(define-class-predicates xenomorph-base%)
+
+(define-subclass xenomorph-base% (RestructureBase))
+(define-subclass RestructureBase (Streamcoder))
+

pitfall/xenomorph/private/bitfield.rkt

@@ -19,19 +19,19 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
       (hash-set! flag-hash flag (bitwise-bit-set? val i)))
     flag-hash)
 
-  (define/override (size . _) (send type size))
+  (define/augment (size . _) (send type size))
 
-  (define/augment (encode stream flag-hash [ctx #f])
-    (define bitfield-integer (for/sum ([(flag i) (in-indexed flags)]
+  (define/augment (encode port flag-hash [ctx #f])
+    (define bit-int (for/sum ([(flag i) (in-indexed flags)]
                                        #:when (and flag (ref flag-hash flag)))
                                (arithmetic-shift 1 i)))
-    (send type encode stream bitfield-integer)))
+    (send type encode port bit-int)))
 
 
 (test-module
  (require "number.rkt" "stream.rkt")
  (define bfer (+Bitfield uint16be '(bold italic underline #f shadow condensed extended)))
- (define bf (send bfer decode (+DecodeStream #"\0\25")))
+ (define bf (send bfer decode #"\0\25"))
  (check-equal? (length (ref-keys bf)) 6) ; omits #f flag
  (check-true (ref bf 'bold))
  (check-true (ref bf 'underline))
@@ -39,7 +39,4 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
  (check-false (ref bf 'italic))
  (check-false (ref bf 'condensed))
  (check-false (ref bf 'extended))
-
- (define os (+EncodeStream))
- (send bfer encode os bf)
- (check-equal? (send os dump) #"\0\25"))
+ (check-equal? (encode bfer bf #f) #"\0\25"))

pitfall/xenomorph/private/buffer.rkt

@@ -21,18 +21,18 @@ A Restructure RBuffer object is separate.
 
 (define-subclass RestructureBase (RBuffer [len #xffff])
   
-  (define/override (decode port [parent #f])
+  (define/augment (decode port [parent #f])
     (define decoded-len (resolve-length len port parent))
     (read-bytes decoded-len port))
 
-  (define/override (size [val #f] [parent #f])
+  (define/augment (size [val #f] [parent #f])
     (when val (unless (bytes? val)
                 (raise-argument-error 'Buffer:size "bytes" val)))
     (if val
         (bytes-length val)
         (resolve-length len val parent)))
 
-  (define/override (encode port buf [parent #f])
+  (define/augment (encode port buf [parent #f])
     (unless (bytes? buf)
       (raise-argument-error 'Buffer:encode "bytes" buf))
     (define op (or port (open-output-bytes)))

pitfall/xenomorph/private/enum.rkt

@@ -13,7 +13,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
     (define index (send type decode stream))
     (or (list-ref options index) index))
 
-  (define/override (size . _) (send type size))
+  (define/augment (size . _) (send type size))
 
   (define/augment (encode stream val [ctx #f])
     (define index (index-of options val))

pitfall/xenomorph/private/number.rkt

@@ -1,5 +1,5 @@
 #lang reader (submod "racket.rkt" reader)
-(require "stream.rkt" "sizes.rkt" (for-syntax "sizes.rkt" racket/match))
+(require "sizes.rkt" (for-syntax "sizes.rkt" racket/match))
 (provide (all-defined-out))
 
 #|
@@ -21,7 +21,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 (define (exact-if-possible x) (if (integer? x) (inexact->exact x) x))
 (define system-endian (if (system-big-endian?) 'be 'le))
 
-(define-subclass Streamcoder (Integer [type 'uint16] [endian system-endian])
+(define-subclass xenomorph-base% (Integer [type 'uint16] [endian system-endian])
   (getter-field [number-type (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))])
   (define _signed? (signed-type? type))
 
@@ -34,7 +34,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 
   (define bits (* _size 8))
   
-  (define/override (size . args) _size)
+  (define/augment (size . args) _size)
 
   (define-values (bound-min bound-max)
     ;; if a signed integer has n bits, it can contain a number between - (expt 2 (sub1 n)) and (sub1 (expt 2 (sub1 n)).
@@ -43,44 +43,44 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
            [delta (if _signed? 0 signed-min)])
       (values (- signed-min delta) (- signed-max delta))))
 
-  (define/augment (decode stream . args)
-    (define bstr (send stream readBuffer _size))
+  (define/augment (decode port [parent #f])
+    (define bstr (read-bytes _size port))
     (define bs ((if (eq? endian system-endian) identity reverse) (bytes->list bstr)))
     (define unsigned-int (for/sum ([(b i) (in-indexed bs)])
                            (arithmetic-shift b (* 8 i))))
-    (post-decode unsigned-int))
+    unsigned-int)
 
-  (define/public (post-decode unsigned-int)
-    (if _signed? (unsigned->signed unsigned-int bits) unsigned-int))
+  (define/override (post-decode unsigned-val)
+    (if _signed? (unsigned->signed unsigned-val bits) unsigned-val))
 
-  (define/public (pre-encode val-in)
-    (exact-if-possible val-in))
+  (define/override (pre-encode val)
+    (exact-if-possible val))
 
-  (define/augment (encode stream val-in [parent #f])
-    (define val (pre-encode val-in))
+  (define/augment (encode port val [parent #f])
     (unless (<= bound-min val bound-max)
       (raise-argument-error 'Integer:encode (format "value within range of ~a ~a-byte int (~a to ~a)" (if _signed? "signed" "unsigned") _size bound-min bound-max) val))
     (define-values (bs _) (for/fold ([bs empty] [n val])
                                     ([i (in-range _size)])
                             (values (cons (bitwise-and n #xff) bs) (arithmetic-shift n -8))))
-    (define bstr (apply bytes ((if (eq? endian 'be) identity reverse) bs)))
-    (send stream write bstr)))
+    (apply bytes ((if (eq? endian 'be) identity reverse) bs))))
 
 (define-values (NumberT NumberT? +NumberT) (values Integer Integer? +Integer))
 (define-values (Number Number? +Number) (values Integer Integer? +Integer))
 
-(define-subclass Streamcoder (Float _size [endian system-endian])
+
+(define-subclass xenomorph-base% (Float _size [endian system-endian])
   (define byte-size (/ _size 8))
   
-  (define/augment (decode stream . args) ;  convert int to float
-    (define bs (send stream readBuffer byte-size))
+  (define/augment (decode port [parent #f]) ;  convert int to float
+    (define bs (read-bytes byte-size port))
     (floating-point-bytes->real bs (eq? endian 'be)))
 
-  (define/augment (encode stream val-in [parent #f]) ; convert float to int
-    (define bs (real->floating-point-bytes val-in byte-size (eq? endian 'be)))
-    (send stream write bs))
+  (define/augment (encode val [parent #f]) ; convert float to int
+    (define bs (real->floating-point-bytes val byte-size (eq? endian 'be)))
+    bs)
+
+  (define/augment (size . args) byte-size))
 
-  (define/override (size . args) byte-size))
 
 (define-instance float (make-object Float 32))
 (define-instance floatbe (make-object Float 32 'be))
@@ -111,34 +111,34 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 
 (test-module
  (check-exn exn:fail:contract? (λ () (+Integer 'not-a-valid-type)))
- (check-exn exn:fail:contract? (λ () (send uint8 encode (+EncodeStream) 256)))
- (check-not-exn (λ () (send uint8 encode (+EncodeStream) 255)))
- (check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) 256)))
- (check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) 255)))
- (check-not-exn (λ () (send int8 encode (+EncodeStream) 127)))
- (check-not-exn (λ () (send int8 encode (+EncodeStream) -128)))
- (check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) -129)))
- (check-exn exn:fail:contract? (λ () (send uint16 encode (+EncodeStream) (add1 #xffff))))
- (check-not-exn (λ () (send uint16 encode (+EncodeStream) #xffff)))
+ (check-exn exn:fail:contract? (λ () (encode uint8 256 #f)))
+ (check-not-exn (λ () (encode uint8 255 #f)))
+ (check-exn exn:fail:contract? (λ () (encode int8 256 #f)))
+ (check-exn exn:fail:contract? (λ () (encode int8 255 #f)))
+ (check-not-exn (λ () (encode int8 127 #f)))
+ (check-not-exn (λ () (encode int8 -128 #f )))
+ (check-exn exn:fail:contract? (λ () (encode int8 -129 #f)))
+ (check-exn exn:fail:contract? (λ () (encode uint16 (add1 #xffff) #f)))
+ (check-not-exn (λ () (encode uint16 #xffff #f)))
  
  (let ([o (+Integer 'uint16 'le)]
-       [ip (+DecodeStream (bytes 1 2 3 4))]
+       [ip (open-input-bytes (bytes 1 2 3 4))]
        [op (open-output-bytes)])
    (check-equal? (send o decode ip) 513) ;; 1000 0000  0100 0000
    (check-equal? (send o decode ip) 1027)  ;; 1100 0000 0010 0000
-   (send o encode op 513)
+   (encode o 513 op)
    (check-equal? (get-output-bytes op) (bytes 1 2))
-   (send o encode op 1027)
+   (encode o 1027 op)
    (check-equal? (get-output-bytes op) (bytes 1 2 3 4)))
 
  (let ([o (+Integer 'uint16 'be)]
-       [ip (+DecodeStream (bytes 1 2 3 4))]
+       [ip (open-input-bytes (bytes 1 2 3 4))]
        [op (open-output-bytes)])
    (check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000 
    (check-equal? (send o decode ip) 772) ;; 0010 0000 1100 0000
-   (send o encode op 258)
+   (encode o 258 op)
    (check-equal? (get-output-bytes op) (bytes 1 2))
-   (send o encode op 772)
+   (encode o 772 op)
    (check-equal? (get-output-bytes op) (bytes 1 2 3 4))))
 
 
@@ -172,17 +172,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 (make-int-types)
 
 (test-module
- (check-equal? (send uint8 size) 1)
- (check-equal? (send uint16 size) 2)
- (check-equal? (send uint32 size) 4)
- (check-equal? (send double size) 8)
+ (check-equal? (size uint8) 1)
+ (check-equal? (size uint16) 2)
+ (check-equal? (size uint32) 4)
+ (check-equal? (size double) 8)
 
- (define bs (send fixed16be encode #f 123.45))
+ (define bs (encode fixed16be 123.45 #f))
  (check-equal? bs #"{s")
- (check-equal? (ceiling (* (send fixed16be decode bs) 100)) 12345.0)
+ (check-equal? (ceiling (* (decode fixed16be  bs) 100)) 12345.0)
 
- (check-equal? (send int8 decode (bytes 127)) 127)
- (check-equal? (send int8 decode (bytes 255)) -1)
+ (check-equal? (decode int8  (bytes 127)) 127)
+ (check-equal? (decode int8 (bytes 255)) -1)
 
- (check-equal? (send int8 encode #f -1) (bytes 255))
- (check-equal? (send int8 encode #f 127) (bytes 127)))
+ (check-equal? (encode int8 -1 #f) (bytes 255))
+ (check-equal? (encode int8 127 #f) (bytes 127)))

pitfall/xenomorph/private/reserved.rkt

@@ -13,7 +13,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
     (send stream pos (+ (· stream pos) (size #f parent)))
     (void))
 
-  (define/override (size [val #f] [parent #f])
+  (define/augment (size [val #f] [parent #f])
     (* (send type size) (resolve-length count #f parent)))
 
   (define/augment (encode stream val [parent #f])

pitfall/xenomorph/private/stream.rkt

@@ -196,35 +196,12 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
  (check-exn exn:fail? (λ () (send ds read 1))))
 
 
-;; Streamcoder is a helper class that checks / converts stream arguments before decode / encode
-;; not a subclass of DecodeStream or EncodeStream, however.
-(define-subclass RestructureBase (Streamcoder)
-  (define/overment (decode x [parent #f])
-    (when parent (unless (indexable? parent)
-                   (raise-argument-error 'Streamcoder:decode "hash or indexable" x)))
-    (define stream (cond
-                     [(bytes? x) (+DecodeStream x)]
-                     [(input-port? x) (+DecodeStream (port->bytes x))]
-                     [else x]))
-    (unless (DecodeStream? stream)
-      (raise-argument-error 'Streamcoder:decode "bytes or input port or DecodeStream" x))
-    (inner (void) decode stream parent))
-
-  (define/overment (encode x [val #f] [parent #f])
-    (define stream (cond
-                     [(output-port? x) (+EncodeStream x)]
-                     [(not x) (+EncodeStream)]
-                     [else x]))
-    (unless (EncodeStream? stream)
-      (raise-argument-error 'Streamcoder:encode "output port or EncodeStream" x))
-    (inner (void) encode stream val parent)
-    (when (not x) (send stream dump))))
 
 (test-module
- (define-subclass Streamcoder (Dummy)
+ (define-subclass xenomorph-base% (Dummy)
    (define/augment (decode stream parent) "foo")
    (define/augment (encode stream val parent) "bar")
-   (define/override (size) 42))
+   (define/augment (size) 42))
 
  (define d (+Dummy))
  (check-true (Dummy? d))

pitfall/xenomorph/private/string.rkt

@@ -37,7 +37,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
       (when (not len) (send stream writeUInt8 #x00)))) ; null terminated when no len
 
   
-  (define/override (size [val #f] [parent #f])
+  (define/augment (size [val #f] [parent #f])
     (if (not val)
         (resolve-length len #f parent)
         (let* ([encoding (if (procedure? encoding)
@@ -54,8 +54,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
 
 (test-module
    (require "stream.rkt")
-   (define stream (+DecodeStream #"\2BCDEF"))
    (define S (+String uint8 'utf8))
-   (check-equal? (send S decode stream) "BC")
+   (check-equal? (send S decode #"\2BCDEF") "BC")
    (check-equal? (send S encode #f "Mike") #"\4Mike")
    (check-equal? (send (+String) size "foobar") 7)) ; null terminated when no len