hide some details

xenomorph/xenomorph/array.rkt

@@ -17,7 +17,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
   (class xenobase%
     (super-new)
     (init-field type len)
-    (unless (xenomorphic? type)
+    (unless (is-a? type xenobase%)
       (raise-argument-error '+xarray "xenomorphic type" type))
     (unless (length-resolvable? len)
       (raise-argument-error '+xarray "length-resolvable?" len))))
@@ -104,7 +104,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
        [length-type (if count-bytes? 'bytes length-type-arg)]))
   
 (module+ test
-  (require rackunit)
+  (require rackunit "generic.rkt")
   (check-equal? (decode (+xarray uint16be 3) #"ABCDEF") '(16706 17220 17734))
   (check-equal? (encode (+xarray uint16be 3) '(16706 17220 17734) #f) #"ABCDEF")
   (check-equal? (size (+xarray uint16be) '(1 2 3)) 6)

xenomorph/xenomorph/generic.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require racket/generic)
+(provide (all-defined-out))
+
+(define-generics xenomorphic
+  (encode xenomorphic val [port] #:parent [parent])
+  (decode xenomorphic [port] #:parent [parent])
+  (size xenomorphic [item] #:parent [parent]))

xenomorph/xenomorph/helper.rkt

@@ -1,25 +1,18 @@
 #lang debug racket/base
-(require racket/generic
-         racket/private/generic-methods
+(require racket/private/generic-methods
          racket/dict
          racket/port
-         racket/class)
+         racket/class
+         "generic.rkt")
 (provide (all-defined-out))
 
-(define (->output-port arg)
-  (if (output-port? arg) arg (open-output-bytes)))
-
-(define (->input-port arg)
-  (cond
-    [(bytes? arg) (open-input-bytes arg)]
-    [(input-port? arg) arg]
-    [else (raise-argument-error '->input-port "byte string or input port" arg)]))
 
 (define private-keys '(parent _startOffset _currentOffset _length))
+
 (define (dump-mutable x)
   (define h (make-hasheq))
   (for ([(k v) (in-dict (dump x))])
-    (hash-set! h k v))
+       (hash-set! h k v))
   h)
 
 (define (dump x)
@@ -28,7 +21,7 @@
     [(output-port? x) (get-output-bytes x)]
     [(dict? x) (for/hasheq ([(k v) (in-dict x)]
                             #:unless (memq k private-keys))
-                 (values k v))]
+                           (values k v))]
     [(list? x) (map dump x)]
     [else x]))
 
@@ -37,56 +30,29 @@
     (file-position p new-pos))
   (file-position p))
 
-(struct xbase ([pre-encode #:auto] [post-decode #:auto]) #:transparent #:mutable
-  #:auto-value values)
-
-(define (pre-encode xb val)
-  ((xbase-pre-encode xb) val))
-
-(define (set-pre-encode! xb func)
-  (set-xbase-pre-encode! xb func))
-
-(define (post-decode xb val)
-  ((xbase-post-decode xb) val))
-
-(define (set-post-decode! xb func)
-  (set-xbase-post-decode! xb func))
-
-(define-syntax-rule (define/post-decode (ID X VAL . ARGS) . BODY)
-  (define (ID X VAL . ARGS) (post-decode X (let () . BODY))))
-
-(define-syntax-rule (define/pre-encode (ID X VAL . ARGS) . BODY)
-  (define (ID X val-in . ARGS) (let ([VAL (pre-encode X val-in)]) . BODY)))
-
-(define-syntax-rule (define/finalize-size ID+ARGS . BODY) (define ID+ARGS (finalize-size (let () . BODY)))) 
-
-(define-generics xenomorphic
-  (encode xenomorphic val [port] #:parent [parent])
-  (decode xenomorphic [port] #:parent [parent])
-  (size xenomorphic [item] #:parent [parent]))
-
-(define (finalize-size size)
-  (cond
-    [(void? size) 0]
-    [(and (integer? size) (not (negative? size))) size]
-    [else (raise-argument-error 'size "nonnegative integer" size)]))
-
 (define xenomorphic<%>
   (interface* ()
               ([(generic-property gen:xenomorphic)
                 (generic-method-table gen:xenomorphic                                      
                                       (define (decode xo [port-arg (current-input-port)] #:parent [parent #f])
-                                        (send xo xxdecode (->input-port port-arg) parent))
+                                        (define port
+                                          (cond
+                                            [(input-port? port-arg) port-arg]
+                                            [(bytes? port-arg) (open-input-bytes port-arg)]
+                                            [else (raise-argument-error 'decode "byte string or input port" port-arg)]))
+                                        (send xo xxdecode port parent))
                                       
                                       (define (encode xo val [port-arg (current-output-port)]
                                                       #:parent [parent #f])
-                                        (define port (->output-port port-arg))
+                                        (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
                                         (send xo xxencode val port parent)
                                         (unless port-arg (get-output-bytes port)))
                                       
                                       (define (size xo [val #f] #:parent [parent #f])
                                         (send xo xxsize val parent)))])))
 
+(define (xenomorphic-type? x) (is-a? x xenobase%))
+
 (define xenobase%
   (class* object% (xenomorphic<%>)
     (super-new)
@@ -99,7 +65,10 @@
       (when (bytes? encode-result) (write-bytes encode-result output-port)))
     
     (define/pubment (xxsize [val #f] [parent #f])
-      (finalize-size (inner 0 xxsize val parent)))
+      (define size (inner 0 xxsize val parent))
+      (unless (and (integer? size) (not (negative? size)))
+        (raise-argument-error 'size "nonnegative integer" size))
+      size)
     
     (define/public (post-decode val) val)
     (define/public (pre-encode val) val)))

xenomorph/xenomorph/number.rkt

@@ -99,7 +99,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 (define uint32le (+xint 4 #:signed #f #:endian 'le))
 
 (module+ test
-  (require rackunit)
+  (require rackunit "generic.rkt")
   (check-exn exn:fail:contract? (λ () (+xint 'not-a-valid-type)))
   (check-exn exn:fail:contract? (λ () (encode uint8 256 #f)))
   (check-not-exn (λ () (encode uint8 255 #f)))

xenomorph/xenomorph/test/array-test.rkt

@@ -5,6 +5,7 @@
          "../array.rkt"
          "../number.rkt"
          "../pointer.rkt"
+         "../generic.rkt"
          sugar/unstable/dict)
 
 #|

xenomorph/xenomorph/util.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require racket/dict "number.rkt" "helper.rkt")
+(require racket/dict "number.rkt" "helper.rkt" "generic.rkt")
 (provide (all-defined-out))
 
 (define (length-resolvable? x)