From 60ac5e801dbdb03a959192daf98605cd80c567da Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 13 Dec 2018 08:42:32 -0800 Subject: [PATCH] size finalizer --- xenomorph/xenomorph/redo/array.rkt | 20 +++--- xenomorph/xenomorph/redo/buffer.rkt | 7 ++- xenomorph/xenomorph/redo/enum.rkt | 3 +- xenomorph/xenomorph/redo/helper.rkt | 10 ++- xenomorph/xenomorph/redo/optional.rkt | 16 ++--- xenomorph/xenomorph/redo/pointer.rkt | 2 +- xenomorph/xenomorph/redo/reserved.rkt | 4 +- xenomorph/xenomorph/redo/string.rkt | 62 ++++++++++--------- xenomorph/xenomorph/redo/struct.rkt | 7 ++- xenomorph/xenomorph/redo/versioned-struct.rkt | 2 +- 10 files changed, 75 insertions(+), 58 deletions(-) diff --git a/xenomorph/xenomorph/redo/array.rkt b/xenomorph/xenomorph/redo/array.rkt index e7dc7ea6..3fa1167c 100644 --- a/xenomorph/xenomorph/redo/array.rkt +++ b/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 diff --git a/xenomorph/xenomorph/redo/buffer.rkt b/xenomorph/xenomorph/redo/buffer.rkt index b3d8a16b..03d85ee6 100644 --- a/xenomorph/xenomorph/redo/buffer.rkt +++ b/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 diff --git a/xenomorph/xenomorph/redo/enum.rkt b/xenomorph/xenomorph/redo/enum.rkt index d96c3219..5929cc30 100644 --- a/xenomorph/xenomorph/redo/enum.rkt +++ b/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))) diff --git a/xenomorph/xenomorph/redo/helper.rkt b/xenomorph/xenomorph/redo/helper.rkt index fc4ceb95..652bf1b9 100644 --- a/xenomorph/xenomorph/redo/helper.rkt +++ b/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) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/optional.rkt b/xenomorph/xenomorph/redo/optional.rkt index 74d07fc9..2ca2c0bc 100644 --- a/xenomorph/xenomorph/redo/optional.rkt +++ b/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 diff --git a/xenomorph/xenomorph/redo/pointer.rkt b/xenomorph/xenomorph/redo/pointer.rkt index 8b86ed09..842055a4 100644 --- a/xenomorph/xenomorph/redo/pointer.rkt +++ b/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) \ No newline at end of file +(define +xvoid-pointer xvoid-pointer) diff --git a/xenomorph/xenomorph/redo/reserved.rkt b/xenomorph/xenomorph/redo/reserved.rkt index e64c23c4..e477ad98 100644 --- a/xenomorph/xenomorph/redo/reserved.rkt +++ b/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 diff --git a/xenomorph/xenomorph/redo/string.rkt b/xenomorph/xenomorph/redo/string.rkt index 159b738f..e15525cc 100644 --- a/xenomorph/xenomorph/redo/string.rkt +++ b/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 diff --git a/xenomorph/xenomorph/redo/struct.rkt b/xenomorph/xenomorph/redo/struct.rkt index 3c817423..d5a16fdc 100644 --- a/xenomorph/xenomorph/redo/struct.rkt +++ b/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) diff --git a/xenomorph/xenomorph/redo/versioned-struct.rkt b/xenomorph/xenomorph/redo/versioned-struct.rkt index 973a4333..81d80edd 100644 --- a/xenomorph/xenomorph/redo/versioned-struct.rkt +++ b/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)))