size finalizer

xenomorph/xenomorph/redo/array.rkt

@@ -62,15 +62,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 (define (xarray-size xa [val #f] #:parent [parent #f])
   (when val (unless (sequence? val)
               (raise-argument-error 'xarray-size "sequence" val)))
-  (cond
-    [val (let-values ([(parent len-size) (if (xint? (xarray-base-len xa))
-                                             (values (mhasheq 'parent parent) (size (xarray-base-len xa)))
-                                             (values parent 0))])
-           (+ len-size (for/sum ([item val])
-                         (size (xarray-base-type xa) item #:parent parent))))]
-    [else (let ([item-count (resolve-length (xarray-base-len xa) #f #:parent parent)]
-                [item-size (size (xarray-base-type xa) #f #:parent parent)])
-            (* item-size item-count))]))
+  (finalize-size
+   (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)])))
 
 (struct xarray-base (type len) #:transparent)
 (struct xarray xarray-base (length-type) #:transparent

xenomorph/xenomorph/redo/buffer.rkt

@@ -26,9 +26,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
 (define (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)))
+  (finalize-size
+   (if (bytes? val)
+       (bytes-length val)
+       (resolve-length (xbuffer-len xb) val #:parent parent))))
 
 (struct xbuffer (len) #:transparent
   #:methods gen:xenomorphic

xenomorph/xenomorph/redo/enum.rkt

@@ -13,7 +13,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
   (define index (decode (xenum-type xe)))
   (or (list-ref (xenum-options xe) index) index)))
 
-(define (xenum-size xe [val #f] #:parent [parent #f]) (size (xenum-type xe)))
+(define (xenum-size xe [val #f] #:parent [parent #f])
+  (size (xenum-type xe)))
 
 (define (xenum-encode xe val [port-arg (current-output-port)] #:parent [parent #f])
   (define port (if (output-port? port-arg) port-arg (open-output-bytes)))

xenomorph/xenomorph/redo/helper.rkt

@@ -15,7 +15,7 @@
     [(input-port? x) (port->bytes x)]
     [(output-port? x) (get-output-bytes x)]
     [(dict? x) (for/list ([(k v) (in-dict x)])
-                         (cons (dump k) (dump v)))]
+                 (cons (dump k) (dump v)))]
     [(list? x) (map dump x)]
     [else x]))
 
@@ -24,9 +24,17 @@
     (file-position p new-pos))
   (file-position p))
 
+(struct xbase (pre-encode post-decode) #:transparent #:mutable)
+
 (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)]))
+
 (struct lazy-thunk (proc) #:transparent)

xenomorph/xenomorph/redo/optional.rkt

@@ -16,20 +16,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee
 (define (xoptional-decode xo [port-arg (current-input-port)] #:parent [parent #f])
   (define port (->input-port port-arg))
   (parameterize ([current-input-port port])
-  (when (resolve-condition xo parent)
-    (decode (xoptional-type xo) #:parent parent))))
+    (when (resolve-condition xo parent)
+      (decode (xoptional-type xo) #:parent parent))))
 
 (define (xoptional-encode xo val [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])
-  (when (resolve-condition xo parent)
-    (encode (xoptional-type xo) val #:parent parent))
-  (unless port-arg (get-output-bytes port))))
+    (when (resolve-condition xo parent)
+      (encode (xoptional-type xo) val #:parent parent))
+    (unless port-arg (get-output-bytes port))))
 
 (define (xoptional-size xo [val #f] #:parent [parent #f])
-  (if (resolve-condition xo parent)
-      (size (xoptional-type xo) val #:parent parent)
-      0))
+  (finalize-size
+   (when (resolve-condition xo parent)
+     (size (xoptional-type xo) val #:parent parent))))
 
 (struct xoptional (type condition) #:transparent
   #:methods gen:xenomorphic

xenomorph/xenomorph/redo/pointer.rkt

@@ -107,4 +107,4 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
 
 ;; A pointer whose type is determined at decode time
 (struct xvoid-pointer (type value) #:transparent)
-(define +xvoid-pointer xvoid-pointer)
+(define +xvoid-pointer xvoid-pointer)

xenomorph/xenomorph/redo/reserved.rkt

@@ -18,7 +18,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
   (unless port-arg (get-output-bytes port)))
 
 (define (xreserved-size xo [val #f] #:parent [parent #f])
-  (* (size (xreserved-type xo)) (resolve-length (xreserved-count xo) #f #:parent parent)))
+  (define item-size (size (xreserved-type xo)))
+  (define count (resolve-length (xreserved-count xo) #f #:parent parent))
+  (finalize-size (* item-size count)))
 
 (struct xreserved (type count) #:transparent
   #:methods gen:xenomorphic

xenomorph/xenomorph/redo/string.rkt

@@ -42,42 +42,44 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
 (define (xstring-decode xs [port-arg (current-input-port)] #:parent [parent #f])
   (define port (->input-port port-arg))
   (parameterize ([current-input-port port])
-  (let ([len (or (resolve-length (xstring-len xs) #:parent parent) (count-nonzero-chars port))]
-        [encoding (if (procedure? (xstring-encoding xs))
-                      (or ((xstring-encoding xs) parent) 'ascii)
-                      (xstring-encoding xs))]
-        [adjustment (if (and (not (xstring-len xs)) (bytes-left-in-port? port)) 1 0)])
-    (define string (read-encoded-string len encoding))
-    (pos port (+ (pos port) adjustment))
-    string)))
+    (let ([len (or (resolve-length (xstring-len xs) #:parent parent) (count-nonzero-chars port))]
+          [encoding (if (procedure? (xstring-encoding xs))
+                        (or ((xstring-encoding xs) parent) 'ascii)
+                        (xstring-encoding xs))]
+          [adjustment (if (and (not (xstring-len xs)) (bytes-left-in-port? port)) 1 0)])
+      (define string (read-encoded-string len encoding))
+      (pos port (+ (pos port) adjustment))
+      string)))
 
 (define (xstring-encode xs val [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])
-  (let* ([val (format "~a" val)]
-         [encoding (if (procedure? (xstring-encoding xs))
-                       (or ((xstring-encoding xs) (and parent (dict-ref parent val)) 'ascii))
-                       (xstring-encoding xs))])
-    (define encoded-length (byte-length val encoding))
-    (when (and (exact-nonnegative-integer? (xstring-len xs)) (> encoded-length (xstring-len xs)))
-      (raise-argument-error 'xstring-encode (format "string no longer than ~a" (xstring-len xs)) val)) 
-    (when (xint? (xstring-len xs))
-      (encode (xstring-len xs) encoded-length))
-    (write-encoded-string val encoding)
-    (when (not (xstring-len xs)) (write-byte #x00)) ; null terminated when no len
-    (unless port-arg (get-output-bytes port))))) 
+    (let* ([val (format "~a" val)]
+           [encoding (if (procedure? (xstring-encoding xs))
+                         (or ((xstring-encoding xs) (and parent (dict-ref parent val)) 'ascii))
+                         (xstring-encoding xs))])
+      (define encoded-length (byte-length val encoding))
+      (when (and (exact-nonnegative-integer? (xstring-len xs)) (> encoded-length (xstring-len xs)))
+        (raise-argument-error 'xstring-encode (format "string no longer than ~a" (xstring-len xs)) val)) 
+      (when (xint? (xstring-len xs))
+        (encode (xstring-len xs) encoded-length))
+      (write-encoded-string val encoding)
+      (when (not (xstring-len xs)) (write-byte #x00)) ; null terminated when no len
+      (unless port-arg (get-output-bytes port))))) 
 
 (define (xstring-size xs [val #f] #:parent [parent #f])
-  (if (not val)
-      (resolve-length (xstring-len xs) #f #:parent parent)
-      (let* ([encoding (if (procedure? (xstring-encoding xs))
-                           (or ((xstring-encoding xs) (and parent (dict-ref parent val)) 'ascii))
-                           (xstring-encoding xs))]
-             [encoding (if (eq? encoding 'utf16be) 'utf16le encoding)])
-        (+ (byte-length val encoding) (cond
-                                        [(not (xstring-len xs)) 1]
-                                        [(xint? (xstring-len xs)) (size (xstring-len xs))]
-                                        [else 0])))))
+  (finalize-size
+   (cond
+     [val (define encoding (if (procedure? (xstring-encoding xs))
+                               (or ((xstring-encoding xs) (and parent (dict-ref parent val)) 'ascii))
+                               (xstring-encoding xs)))
+          (define string-size (byte-length val (if (eq? encoding 'utf16be) 'utf16le encoding)))
+          (define strlen-size (cond
+                                [(not (xstring-len xs)) 1]
+                                [(xint? (xstring-len xs)) (size (xstring-len xs))]
+                                [else 0]))
+          (+ string-size strlen-size)]
+     [else (resolve-length (xstring-len xs) #f #:parent parent)])))
 
 (struct xstring (len encoding) #:transparent
   #:methods gen:xenomorphic

xenomorph/xenomorph/redo/struct.rkt

@@ -69,10 +69,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
   (define parent (mhasheq 'parent parent-arg
                        'val val
                        'pointerSize 0))
-  (+ (for/sum ([(key type) (d:in-dict (xstruct-fields xs))]
+  (define fields-size (for/sum ([(key type) (d:in-dict (xstruct-fields xs))]
                #:when (xenomorphic? type))
-       (size type (and val (d:dict-ref val key)) #:parent parent))
-     (if include-pointers (d:dict-ref parent 'pointerSize) 0)))
+       (size type (and val (d:dict-ref val key)) #:parent parent)))
+  (define pointers-size (if include-pointers (d:dict-ref parent 'pointerSize) 0))
+  (finalize-size (+ fields-size pointers-size)))
 
 (define (xstruct-encode xs val-arg [port-arg (current-output-port)] #:parent [parent-arg #f])
   (unless (d:dict? val-arg)

xenomorph/xenomorph/redo/versioned-struct.rkt

@@ -51,7 +51,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
       (for/sum ([(key type) (in-dict fields)])
         (size type (and val (dict-ref val key)) #:parent parent))))
   (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0))
-  (+ version-size header-size fields-size pointer-size))
+  (finalize-size (+ version-size header-size fields-size pointer-size)))
 
 (define (xversioned-struct-encode xvs val-arg [port-arg (current-output-port)] #:parent [parent-arg #f])
   (define port (if (output-port? port-arg) port-arg (open-output-bytes)))