numbers pass

xenomorph/xenomorph/helper.rkt

@@ -72,34 +72,35 @@
     [else (raise-argument-error 'size "nonnegative integer" size)]))
 
 
-(define codec<%>
+(define xenomorphic<%>
   (interface* ()
               ([(generic-property gen:xenomorphic)
                 (generic-method-table gen:xenomorphic                                      
-                                      (define (decode o [port-arg (current-input-port)] #:parent [parent #f])
+                                      (define (decode xo [port-arg (current-input-port)] #:parent [parent #f])
-                                        (send o xxdecode (->input-port port-arg) parent))
+                                        (send xo xxdecode (->input-port port-arg) parent))
                                       
-                                      (define (encode o val [port-arg (current-output-port)] #:parent [parent #f])
+                                      (define (encode xo val [port-arg (current-output-port)]
+                                                      #:parent [parent #f])
                                         (define port (->output-port port-arg))
-                                        (send o xxencode val port parent)
+                                        (send xo xxencode val port parent)
                                         (unless port-arg (get-output-bytes port)))
                                       
-                                      (define (size o [val #f] #:parent [parent #f])
+                                      (define (size xo [val #f] #:parent [parent #f])
-                                        (send o xxsize val parent)))])))
+                                        (send xo xxsize val parent)))])))
 
 (define xenobase%
-  (class* object% (codec<%>)
+  (class* object% (xenomorphic<%>)
     (super-new)
     
     (define/pubment (xxdecode input-port [parent #f])
-      (post-decode (inner (void) xxdecode input-port parent)))
+      (post-decode (inner (error 'xxdecode-not-augmented) xxdecode input-port parent)))
     
     (define/pubment (xxencode val output-port [parent #f])
-      (define encode-result (inner (void) xxencode (pre-encode val) output-port parent))
+      (define encode-result (inner (error 'xxencode-not-augmented) xxencode (pre-encode val) output-port parent))
       (when (bytes? encode-result) (write-bytes encode-result output-port)))
     
     (define/pubment (xxsize [val #f] [parent #f])
-      (finalize-size (inner (void) xxsize val parent)))
+      (finalize-size (inner 0 xxsize val parent)))
     
     (define/public (post-decode val) val)
     (define/public (pre-encode val) val)))

xenomorph/xenomorph/number.rkt

@@ -23,60 +23,55 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 
 (define system-endian (if (system-big-endian?) 'be 'le))
 
-#;(define/pre-encode (xint-encode i val [port-arg (current-output-port)] #:parent [parent #f])
+(define xnumber%
-    )
+  (class* xenobase% ()
-
+    (super-new)
-#;(define/post-decode (xint-decode i [port-arg (current-input-port)] #:parent [parent #f])
+    (init-field size endian)
-    (unless (xint? i)
+    (unless (exact-positive-integer? size)
-      (raise-argument-error 'decode "xint instance" i))
+      (raise-argument-error 'xenomorph "exact positive integer" size))
-    )
+    (unless (memq endian '(le be))
-
+      (raise-argument-error 'xenomorph "'le or 'be" endian))
-(struct xnumber xbase () #:transparent)
+    (field [bits (* size 8)])
-(define xnumber% (class* xenobase% () (super-new)))
+    (define/augment (xxsize . _) size)))
-
+
-(define xint% (class* xnumber% ()
+(define (xint? x) (is-a? x xint%))
-                (super-new)
+
-                (init-field size signed endian)
+(define xint%
-                
+  (class* xnumber% ()
-                (define/augment (xxdecode port . _)
+    (super-new)
-                  (define bs ((if (eq? endian system-endian) values reverse-bytes) (read-bytes size port)))
+    (init-field signed)
-                  (define uint (for/sum ([b (in-bytes bs)]
+    (inherit-field endian size bits)
-                                         [i (in-naturals)])
+    
-                                 (arithmetic-shift b (* 8 i))))
+    ;; if a signed integer has n bits, it can contain a number
-                  (if signed (unsigned->signed uint (bits this)) uint))
+    ;; between - (expt 2 (sub1 n)) and (sub1 (expt 2 (sub1 n)).
+    (define signed-max (sub1 (arithmetic-shift 1 (sub1 bits))))
+    (define signed-min (sub1 (- signed-max)))
+    (define delta (if signed 0 signed-min))
+    (field [bound-min (- signed-min delta)]
+           [bound-max (- signed-max delta)])
                 
-                (define/augment (xxencode val . _)
+    (define/augment (xxdecode port . _)
-                  (define-values (bound-min bound-max) (bounds this))
+      (define bs ((if (eq? endian system-endian) values reverse-bytes) (read-bytes size port)))
-                  (unless (<= bound-min val bound-max)
+      (define uint (for/sum ([b (in-bytes bs)]
-                    (raise-argument-error 'encode
+                             [i (in-naturals)])
-                                          (format "value that fits within ~a ~a-byte int (~a to ~a)" (if signed "signed" "unsigned") size bound-min bound-max) val))
+                     (arithmetic-shift b (* 8 i))))
-                  (for/fold ([bs null]
+      (if signed (unsigned->signed uint bits) uint))
-                             [val (exact-if-possible val)]
-                             #:result (apply bytes ((if (eq? endian 'be) values reverse) bs)))
-                            ([i (in-range size)])
-                    (values (cons (bitwise-and val #xff) bs) (arithmetic-shift val -8))))
                 
-                (define/augment (xxsize . _) size)))
+    (define/augment (xxencode val . _)
-
+      (unless (<= bound-min val bound-max)
-
+        (raise-argument-error 'encode
-(define (+xint [size 2] #:signed [signed #true] #:endian [endian system-endian])
+                              (format "value that fits within ~a ~a-byte int (~a to ~a)" (if signed "signed" "unsigned") size bound-min bound-max) val))
-  (unless (exact-positive-integer? size)
+      (for/fold ([bs null]
-    (raise-argument-error '+xint "exact positive integer" size))
+                 [val (exact-if-possible val)]
-  (unless (memq endian '(le be))
+                 #:result (apply bytes ((if (eq? endian 'be) values reverse) bs)))
-    (raise-argument-error '+xint "'le or 'be" endian))
+                ([i (in-range size)])
-  (make-object xint% size signed endian))
+        (values (cons (bitwise-and val #xff) bs) (arithmetic-shift val -8))))))
-
+
-(define (bits i) (* (get-field size i) 8))
+(define (+xint [size 2]
-
+               #:signed [signed #true]
-(define (bounds i)
+               #:endian [endian system-endian]
-  #;(unless (xint? i)
+               #:subclass [class xint%])
-      (raise-argument-error 'bounds "integer instance" i))
+  (new class [size size] [signed signed] [endian endian]))
-  ;; if a signed integer has n bits, it can contain a number
-  ;; between - (expt 2 (sub1 n)) and (sub1 (expt 2 (sub1 n)).
-  (let* ([signed-max (sub1 (arithmetic-shift 1 (sub1 (bits i))))]
-         [signed-min (sub1 (- signed-max))]
-         [delta (if (get-field signed i) 0 signed-min)])
-    (values (- signed-min delta) (- signed-max delta))))
 
 (define int8 (+xint 1))
 (define int16 (+xint 2))
@@ -146,24 +141,19 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
   (check-equal? (encode int8 -1 #f) (bytes 255))
   (check-equal? (encode int8 127 #f) (bytes 127)))
 
-(define xfloat% (class* xnumber% ()
+(define xfloat%
-                  (super-new)
+  (class* xnumber% ()
-                  (init-field size endian)
+    (super-new)
+    (inherit-field size endian)
                 
-                  (define/augment (xxdecode port . _)
+    (define/augment (xxdecode port . _)
-                    (floating-point-bytes->real (read-bytes size port) (eq? endian 'be)))
+      (floating-point-bytes->real (read-bytes size port) (eq? endian 'be)))
                 
-                  (define/augment (xxencode val . _)
+    (define/augment (xxencode val . _)
-                    (real->floating-point-bytes val size (eq? endian 'be)))
+      (real->floating-point-bytes val size (eq? endian 'be)))))
-                
-                  (define/augment (xxsize . _) size)))
 
 (define (+xfloat [size 4] #:endian [endian system-endian])
-  (unless (exact-positive-integer? size)
+  (new xfloat% [size size] [endian endian]))
-    (raise-argument-error '+xfloat "exact positive integer" size))
-  (unless (memq endian '(le be))
-    (raise-argument-error '+xfloat "'le or 'be" endian))
-  (make-object xfloat% size endian))
 
 (define float (+xfloat 4))
 (define floatbe (+xfloat 4 #:endian 'be))
@@ -172,3 +162,36 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 (define double (+xfloat 8))
 (define doublebe (+xfloat 8 #:endian 'be))
 (define doublele (+xfloat 8 #:endian 'le))
+
+(define xfixed%
+  (class xint%
+    (super-new)
+    (init-field fracbits)
+    (unless (exact-positive-integer? fracbits)
+      (raise-argument-error '+xfixed "exact positive integer for fracbits" fracbits))
+
+    (define fixed-shift (arithmetic-shift 1 fracbits))
+                
+    (define/override (post-decode int)
+      (exact-if-possible (/ int fixed-shift 1.0)))
+                
+    (define/override (pre-encode val)
+      (exact-if-possible (floor (* val fixed-shift))))))
+
+(define (+xfixed [size 2]
+                 #:signed [signed #true]
+                 #:endian [endian system-endian]
+                 #:fracbits [fracbits (/ (* size 8) 2)])  
+  (new xfixed% [size size] [signed signed] [endian endian] [fracbits fracbits]))
+
+(define fixed16 (+xfixed 2))
+(define fixed16be (+xfixed 2 #:endian 'be))
+(define fixed16le (+xfixed 2 #:endian 'le))
+(define fixed32 (+xfixed 4))
+(define fixed32be (+xfixed 4 #:endian 'be))
+(define fixed32le (+xfixed 4 #:endian 'le))
+
+(module+ test
+  (define bs (encode fixed16be 123.45 #f))
+  (check-equal? bs #"{s")
+  (check-equal? (ceiling (* (decode fixed16be bs) 100)) 12345.0))

xenomorph/xenomorph/test/number-test.rkt

@@ -1,5 +1,8 @@
 #lang racket/base
-(require rackunit "../number.rkt" "../helper.rkt")
+(require rackunit
+         racket/class
+         "../number.rkt"
+         "../helper.rkt")
 
 #|
 approximates
@@ -19,14 +22,16 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee
 
 (test-case
  "uint8: decode with post-decode, size, encode with pre-encode"
- (define myuint8 (+xint 1 #:signed #f))
+ (define myuint8% (class xint%
+                   (super-new)
+                   (define/override (post-decode int) #xdeadbeef)
+                   (define/override (pre-encode val) #xcc)))
+ (define myuint8 (+xint 1 #:signed #f #:subclass myuint8%))
  (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff))])
-   (set-post-decode! myuint8 (λ (b) #xdeadbeef))
    (check-equal? (decode myuint8) #xdeadbeef)
    (check-equal? (decode myuint8) #xdeadbeef))
  (check-equal? (size myuint8) 1)
  (let ([port (open-output-bytes)])
-   (set-pre-encode! myuint8 (λ (b) #xcc))
    (encode myuint8 #xab port)
    (encode myuint8 #xff port)
    (check-equal? (get-output-bytes port) (bytes #xcc #xcc))))