buffer done

xenomorph/xenomorph/bitfield.rkt

@@ -13,18 +13,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
     (init-field type flags)
 
     (define/augment (xxdecode port parent)
-
-    (define flag-hash (mhasheq))
+      (define flag-hash (mhasheq))
       (define val (send type xxdecode port))
       (for ([(flag idx) (in-indexed flags)]
             #:when flag)
-           (hash-set! flag-hash flag (bitwise-bit-set? val idx)))
+        (hash-set! flag-hash flag (bitwise-bit-set? val idx)))
       flag-hash)
 
     (define/augment (xxencode flag-hash port [parent #f])
       (define bit-int (for/sum ([(flag idx) (in-indexed flags)]
                                 #:when (and flag (dict-ref flag-hash flag #f)))
-                               (arithmetic-shift 1 idx)))
+                        (arithmetic-shift 1 idx)))
       (send type xxencode bit-int port))
     
     (define/augment (xxsize [val #f] [parent #f])

xenomorph/xenomorph/buffer.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require "helper.rkt" "util.rkt" "number.rkt")
+(require racket/class "helper.rkt" "util.rkt" "number.rkt")
 (provide (all-defined-out))
 
 #|
@@ -7,39 +7,33 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
 |#
 
-(define/post-decode (xbuffer-decode xb [port-arg (current-input-port)] #:parent [parent #f])
-  (define port (->input-port port-arg))
-  (parameterize ([current-input-port port])
-    (define decoded-len (resolve-length (xbuffer-len xb) #:parent parent))
-    (read-bytes decoded-len)))
+(define xbuffer%
+  (class xenobase%
+    (super-new)
+    (init-field len)
 
-(define/pre-encode (xbuffer-encode xb buf [port-arg (current-output-port)] #:parent [parent #f])
-  (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
-  (parameterize ([current-output-port port])
-    (unless (bytes? buf)
-      (raise-argument-error 'xbuffer-encode "bytes" buf))
-    (when (xint? (xbuffer-len xb))
-      (encode (xbuffer-len xb) (bytes-length buf)))
-    (write-bytes buf)
-    (unless port-arg (get-output-bytes port))))
+    (define/augment (xxdecode port parent)
+      (define decoded-len (resolve-length len #:parent parent))
+      (read-bytes decoded-len))
 
-(define/finalize-size (xbuffer-size xb [val #f] #:parent [parent #f])
-  (when val (unless (bytes? val)
-              (raise-argument-error 'xbuffer-size "bytes" val)))
-  (if (bytes? val)
-      (bytes-length val)
-      (resolve-length (xbuffer-len xb) val #:parent parent)))
-
-(struct xbuffer xbase (len) #:transparent
-  #:methods gen:xenomorphic
-  [(define decode xbuffer-decode)
-   (define xdecode xbuffer-decode)
-   (define encode xbuffer-encode)
-   (define size xbuffer-size)])
+    (define/augment (xxencode buf port [parent #f])
+      (unless (bytes? buf)
+        (raise-argument-error 'xbuffer-encode "bytes" buf))
+      (when (xint? len)
+        (send len xxencode (bytes-length buf) port))
+      (write-bytes buf port))
+    
+    (define/augment (xxsize [val #f] [parent #f])
+      (when val (unless (bytes? val)
+                  (raise-argument-error 'xbuffer-size "bytes" val)))
+      (if (bytes? val)
+          (bytes-length val)
+          (resolve-length len val #:parent parent)))))
 
 (define (+xbuffer [len-arg #f]
-                  #:length [len-kwarg #f])
+                  #:length [len-kwarg #f]
+                  #:subclass [class xbuffer%])
   (define len (or len-arg len-kwarg #xffff))
   (unless (length-resolvable? len)
     (raise-argument-error '+xbuffer "resolvable length" len))
-  (xbuffer len))
+  (new class [len len]))

xenomorph/xenomorph/test/buffer-test.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
 (require rackunit
+         racket/class
          sugar/unstable/dict
          "../buffer.rkt"
          "../number.rkt"
-         "../helper.rkt")
+         "../helper.rkt"
+         "../generic.rkt")
 
 #|
 approximates
@@ -24,8 +26,10 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
 (test-case
  "buffer should decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
-   (define buf (+xbuffer #:length 2))
-   (set-post-decode! buf (λ (bs) (bytes 1 2)))
+   (define myboof% (class xbuffer%
+                         (super-new)
+                         (define/override (post-decode val) (bytes 1 2))))
+   (define buf (+xbuffer #:length 2 #:subclass myboof%))
    (check-equal? (decode buf) (bytes 1 2))
    (check-equal? (decode buf) (bytes 1 2))))
 
@@ -33,8 +37,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
  "buffer should decode with parent key length"
  (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
    (define buf (+xbuffer #:length 'len))
-   (check-equal? (xdecode buf #:parent (hash 'len 3)) (bytes #xab #xff #x1f))
-   (check-equal? (xdecode buf #:parent (hash 'len 1)) (bytes #xb6))))
+   (check-equal? (decode buf #:parent (hash 'len 3)) (bytes #xab #xff #x1f))
+   (check-equal? (decode buf #:parent (hash 'len 1)) (bytes #xb6))))
 
 (test-case
  "size should return size"
@@ -53,8 +57,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
 
 (test-case
  "encode should encode with pre-encode"
- (let ([buf (+xbuffer 2)])
-   (set-pre-encode! buf (λ (bs) (bytes 1 2)))
+ (let ()
+   (define myboof% (class xbuffer%
+                         (super-new)
+                         (define/override (pre-encode val) (bytes 1 2))))
+   (define buf (+xbuffer 2 #:subclass myboof%))
    (check-equal? (bytes-append
                   (encode buf (bytes #xab #xff) #f)
                   (encode buf (bytes #x1f #xb6) #f)) (bytes 1 2 1 2))))