From c9f87e364b4cfbf6f78889d77d78fc06ff64bd2e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 12 Dec 2018 15:31:05 -0800 Subject: [PATCH] add kwarg to `size` --- xenomorph/xenomorph/redo/array.rkt | 8 +- xenomorph/xenomorph/redo/bitfield.rkt | 2 +- xenomorph/xenomorph/redo/buffer.rkt | 2 +- xenomorph/xenomorph/redo/enum.rkt | 2 +- xenomorph/xenomorph/redo/helper.rkt | 2 +- xenomorph/xenomorph/redo/lazy-array.rkt | 8 +- xenomorph/xenomorph/redo/number.rkt | 6 +- xenomorph/xenomorph/redo/optional.rkt | 4 +- xenomorph/xenomorph/redo/pointer.rkt | 8 +- xenomorph/xenomorph/redo/reserved.rkt | 6 +- xenomorph/xenomorph/redo/string.rkt | 2 +- xenomorph/xenomorph/redo/struct.rkt | 6 +- .../xenomorph/redo/test/pointer-test.rkt | 106 +++++++++--------- xenomorph/xenomorph/redo/versioned-struct.rkt | 10 +- 14 files changed, 86 insertions(+), 86 deletions(-) diff --git a/xenomorph/xenomorph/redo/array.rkt b/xenomorph/xenomorph/redo/array.rkt index 31ecd383..e7dc7ea6 100644 --- a/xenomorph/xenomorph/redo/array.rkt +++ b/xenomorph/xenomorph/redo/array.rkt @@ -51,7 +51,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (let ([parent (mhash 'pointers null 'startOffset (pos port) 'parent parent)]) - (dict-set! parent 'pointerOffset (+ (pos port) (size xa array parent))) + (dict-set! parent 'pointerOffset (+ (pos port) (size xa array #:parent parent))) (encode (xarray-base-len xa) (length array)) ; encode length at front (encode-items parent) (for ([ptr (in-list (dict-ref parent 'pointers))]) ; encode pointer data at end @@ -59,7 +59,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee [else (encode-items parent)]) (unless port-arg (get-output-bytes port)))) -(define (xarray-size xa [val #f] [parent #f]) +(define (xarray-size xa [val #f] #:parent [parent #f]) (when val (unless (sequence? val) (raise-argument-error 'xarray-size "sequence" val))) (cond @@ -67,9 +67,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (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))))] + (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)]) + [item-size (size (xarray-base-type xa) #f #:parent parent)]) (* item-size item-count))])) (struct xarray-base (type len) #:transparent) diff --git a/xenomorph/xenomorph/redo/bitfield.rkt b/xenomorph/xenomorph/redo/bitfield.rkt index e4f4d1aa..7a346e7c 100644 --- a/xenomorph/xenomorph/redo/bitfield.rkt +++ b/xenomorph/xenomorph/redo/bitfield.rkt @@ -26,7 +26,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee (encode (xbitfield-type xb) bit-int) (unless port-arg (get-output-bytes port)))) -(define (xbitfield-size xb [val #f] [parent #f]) +(define (xbitfield-size xb [val #f] #:parent [parent #f]) (size (xbitfield-type xb))) (struct xbitfield (type flags) #:transparent diff --git a/xenomorph/xenomorph/redo/buffer.rkt b/xenomorph/xenomorph/redo/buffer.rkt index 388e8e67..b3d8a16b 100644 --- a/xenomorph/xenomorph/redo/buffer.rkt +++ b/xenomorph/xenomorph/redo/buffer.rkt @@ -23,7 +23,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee (write-bytes buf) (unless port-arg (get-output-bytes port)))) -(define (xbuffer-size xb [val #f] [parent #f]) +(define (xbuffer-size xb [val #f] #:parent [parent #f]) (when val (unless (bytes? val) (raise-argument-error 'xbuffer-size "bytes" val))) (if (bytes? val) diff --git a/xenomorph/xenomorph/redo/enum.rkt b/xenomorph/xenomorph/redo/enum.rkt index 3ce6a41c..d96c3219 100644 --- a/xenomorph/xenomorph/redo/enum.rkt +++ b/xenomorph/xenomorph/redo/enum.rkt @@ -13,7 +13,7 @@ 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 #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 b3594a05..fc4ceb95 100644 --- a/xenomorph/xenomorph/redo/helper.rkt +++ b/xenomorph/xenomorph/redo/helper.rkt @@ -27,6 +27,6 @@ (define-generics xenomorphic (encode xenomorphic val [port] #:parent [parent]) (decode xenomorphic [port] #:parent [parent]) - (size xenomorphic [item] [parent])) + (size xenomorphic [item] #:parent [parent])) (struct lazy-thunk (proc) #:transparent) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/lazy-array.rkt b/xenomorph/xenomorph/redo/lazy-array.rkt index 623c2a7f..5d3cbc5d 100644 --- a/xenomorph/xenomorph/redo/lazy-array.rkt +++ b/xenomorph/xenomorph/redo/lazy-array.rkt @@ -22,18 +22,18 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee (define res (for/stream ([index (in-range decoded-len)]) (define type (xarray-base-type xla)) (define orig-pos (pos port)) - (pos port (+ starting-pos (* (size type #f parent) index))) + (pos port (+ starting-pos (* (size type #f #:parent parent) index))) (define new-item (decode type port #:parent parent)) (pos port orig-pos) new-item)) - (pos port (+ (pos port) (* decoded-len (size (xarray-base-type xla) #f parent)))) + (pos port (+ (pos port) (* decoded-len (size (xarray-base-type xla) #f #:parent parent)))) res))) (define (xlazy-array-encode xla val [port-arg (current-output-port)] #:parent [parent #f]) (xarray-encode xla (if (stream? val) (stream->list val) val) port-arg #:parent parent)) -(define (xlazy-array-size xla [val #f] [parent #f]) - (xarray-size xla (if (stream? val) (stream->list val) val) parent)) +(define (xlazy-array-size xla [val #f] #:parent [parent #f]) + (xarray-size xla (if (stream? val) (stream->list val) val) #:parent parent)) ;; xarray-base holds type and len fields (struct xlazy-array xarray-base () #:transparent diff --git a/xenomorph/xenomorph/redo/number.rkt b/xenomorph/xenomorph/redo/number.rkt index 3e9db853..dc0fcb11 100644 --- a/xenomorph/xenomorph/redo/number.rkt +++ b/xenomorph/xenomorph/redo/number.rkt @@ -61,7 +61,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:methods gen:xenomorphic [(define decode xint-decode) (define encode xint-encode) - (define size (λ (i [item #f] [parent #f]) (xint-size i)))]) + (define size (λ (i [item #f] #:parent [parent #f]) (xint-size i)))]) (define (+xint [size 2] #:signed [signed #true] #:endian [endian system-endian]) (unless (exact-positive-integer? size) @@ -175,7 +175,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:methods gen:xenomorphic [(define decode xfloat-decode) (define encode xfloat-encode) - (define size (λ (i [item #f] [parent #f]) (xfloat-size i)))]) + (define size (λ (i [item #f] #:parent [parent #f]) (xfloat-size i)))]) (define (+xfloat [size 4] #:endian [endian system-endian]) (unless (exact-positive-integer? size) @@ -208,7 +208,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:methods gen:xenomorphic [(define decode xfixed-decode) (define encode xfixed-encode) - (define size (λ (i [item #f] [parent #f]) (xint-size i)))]) + (define size (λ (i [item #f] #:parent [parent #f]) (xint-size i)))]) (define (+xfixed [size 2] #:signed [signed #true] #:endian [endian system-endian] [fracbits (/ (* size 8) 2)]) (unless (exact-positive-integer? size) diff --git a/xenomorph/xenomorph/redo/optional.rkt b/xenomorph/xenomorph/redo/optional.rkt index 178ad064..74d07fc9 100644 --- a/xenomorph/xenomorph/redo/optional.rkt +++ b/xenomorph/xenomorph/redo/optional.rkt @@ -26,9 +26,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee (encode (xoptional-type xo) val #:parent parent)) (unless port-arg (get-output-bytes port)))) -(define (xoptional-size xo [val #f] [parent #f]) +(define (xoptional-size xo [val #f] #:parent [parent #f]) (if (resolve-condition xo parent) - (size (xoptional-type xo) val parent) + (size (xoptional-type xo) val #:parent parent) 0)) (struct xoptional (type condition) #:transparent diff --git a/xenomorph/xenomorph/redo/pointer.rkt b/xenomorph/xenomorph/redo/pointer.rkt index c4d9ab55..8b86ed09 100644 --- a/xenomorph/xenomorph/redo/pointer.rkt +++ b/xenomorph/xenomorph/redo/pointer.rkt @@ -66,7 +66,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [else (error 'unknown-pointer-style)])] [relative (+ (case (pointer-style xp) [(local parent) (dict-ref new-parent 'startOffset)] - [(immediate) (+ (pos port) (size (xpointer-offset-type xp) val parent))] + [(immediate) (+ (pos port) (size (xpointer-offset-type xp) val #:parent parent))] [(global) 0]) ((relative-getter-or-0 xp) (dict-ref parent 'val #f)))]) (encode (xpointer-offset-type xp) (- (dict-ref new-parent 'pointerOffset) relative)) @@ -75,10 +75,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee (list (mhasheq 'type type 'val val 'parent parent)))) - (dict-set! new-parent 'pointerOffset (+ (dict-ref new-parent 'pointerOffset) (size type val parent))))))) + (dict-set! new-parent 'pointerOffset (+ (dict-ref new-parent 'pointerOffset) (size type val #:parent parent))))))) (unless port-arg (get-output-bytes port))) -(define (xpointer-size xp [val #f] [parent #f]) +(define (xpointer-size xp [val #f] #:parent [parent #f]) (let*-values ([(parent) (case (pointer-style xp) [(local immediate) parent] [(parent) (dict-ref parent 'parent)] @@ -87,7 +87,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [(type val) (resolve-void-pointer (xpointer-type xp) val)]) (when (and val parent) (dict-set! parent 'pointerSize (and (dict-ref parent 'pointerSize #f) - (+ (dict-ref parent 'pointerSize) (size type val parent))))) + (+ (dict-ref parent 'pointerSize) (size type val #:parent parent))))) (size (xpointer-offset-type xp)))) (struct xpointer (offset-type type options) #:transparent diff --git a/xenomorph/xenomorph/redo/reserved.rkt b/xenomorph/xenomorph/redo/reserved.rkt index 8c4e5cc9..e64c23c4 100644 --- a/xenomorph/xenomorph/redo/reserved.rkt +++ b/xenomorph/xenomorph/redo/reserved.rkt @@ -9,15 +9,15 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee (define (xreserved-decode xo [port-arg (current-input-port)] #:parent [parent #f]) (define port (->input-port port-arg)) - (pos port (+ (pos port) (size xo #f parent))) + (pos port (+ (pos port) (size xo #f #:parent parent))) (void)) (define (xreserved-encode xo val [port-arg (current-output-port)] #:parent [parent #f]) (define port (if (output-port? port-arg) port-arg (open-output-bytes))) - (write-bytes (make-bytes (size xo val parent) 0) port) + (write-bytes (make-bytes (size xo val #:parent parent) 0) port) (unless port-arg (get-output-bytes port))) -(define (xreserved-size xo [val #f] [parent #f]) +(define (xreserved-size xo [val #f] #:parent [parent #f]) (* (size (xreserved-type xo)) (resolve-length (xreserved-count xo) #f #:parent parent))) (struct xreserved (type count) #:transparent diff --git a/xenomorph/xenomorph/redo/string.rkt b/xenomorph/xenomorph/redo/string.rkt index 14cb7e91..159b738f 100644 --- a/xenomorph/xenomorph/redo/string.rkt +++ b/xenomorph/xenomorph/redo/string.rkt @@ -67,7 +67,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee (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 #f]) +(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)) diff --git a/xenomorph/xenomorph/redo/struct.rkt b/xenomorph/xenomorph/redo/struct.rkt index 7ff77770..3c817423 100644 --- a/xenomorph/xenomorph/redo/struct.rkt +++ b/xenomorph/xenomorph/redo/struct.rkt @@ -65,13 +65,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (unless (d:dict? res) (raise-result-error 'xstruct-decode "dict" res)) res))) -(define (xstruct-size xs [val #f] [parent-arg #f] [include-pointers #t]) +(define (xstruct-size xs [val #f] #:parent [parent-arg #f] [include-pointers #t]) (define parent (mhasheq 'parent parent-arg 'val val 'pointerSize 0)) (+ (for/sum ([(key type) (d:in-dict (xstruct-fields xs))] #:when (xenomorphic? type)) - (size type (and val (d:dict-ref val key)) parent)) + (size type (and val (d:dict-ref val key)) #:parent parent)) (if include-pointers (d:dict-ref parent 'pointerSize) 0))) (define (xstruct-encode xs val-arg [port-arg (current-output-port)] #:parent [parent-arg #f]) @@ -95,7 +95,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee 'pointerSize 0)) ; deliberately use `xstruct-size` instead of `size` to use extra arg - (d:dict-set! parent 'pointerOffset (+ (pos port) (xstruct-size xs val parent #f))) + (d:dict-set! parent 'pointerOffset (+ (pos port) (xstruct-size xs val #:parent parent #f))) (for ([(key type) (d:in-dict (xstruct-fields xs))]) (encode type (d:dict-ref val key) #:parent parent)) diff --git a/xenomorph/xenomorph/redo/test/pointer-test.rkt b/xenomorph/xenomorph/redo/test/pointer-test.rkt index 79312f3b..70f07175 100644 --- a/xenomorph/xenomorph/redo/test/pointer-test.rkt +++ b/xenomorph/xenomorph/redo/test/pointer-test.rkt @@ -45,7 +45,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "decode should support offsets relative to a property on the parent" (parameterize ([current-input-port (open-input-bytes (bytes 1 0 0 0 0 53))]) - (check-equal? (decode (+xpointer uint8 uint8 (mhash 'relativeTo (λ (ctx) (dict-ref (dict-ref ctx 'parent) 'ptr)))) + (check-equal? (decode (+xpointer uint8 uint8 (mhash 'relativeTo (λ (parent) (dict-ref (dict-ref parent 'parent) 'ptr)))) #:parent (mhash '_startOffset 0 'parent (mhash 'ptr 4))) 53))) @@ -64,38 +64,38 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "size" - (let ([ctx (mhash 'pointerSize 0)]) - (check-equal? (size (+xpointer uint8 uint8) 10 ctx) 1) - (check-equal? (dict-ref ctx 'pointerSize) 1))) + (let ([parent (mhash 'pointerSize 0)]) + (check-equal? (size (+xpointer uint8 uint8) 10 #:parent parent) 1) + (check-equal? (dict-ref parent 'pointerSize) 1))) (test-case "size should add to immediate pointerSize" - (let ([ctx (mhash 'pointerSize 0)]) - (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'immediate)) 10 ctx) 1) - (check-equal? (dict-ref ctx 'pointerSize) 1))) + (let ([parent (mhash 'pointerSize 0)]) + (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'immediate)) 10 #:parent parent) 1) + (check-equal? (dict-ref parent 'pointerSize) 1))) (test-case "size should add to parent pointerSize" - (let ([ctx (mhash 'parent (mhash 'pointerSize 0))]) - (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'parent)) 10 ctx) 1) - (check-equal? (dict-ref (dict-ref ctx 'parent) 'pointerSize) 1))) + (let ([parent (mhash 'parent (mhash 'pointerSize 0))]) + (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'parent)) 10 #:parent parent) 1) + (check-equal? (dict-ref (dict-ref parent 'parent) 'pointerSize) 1))) (test-case "size should add to global pointerSize" - (let ([ctx (mhash 'parent (mhash 'parent (mhash 'parent (mhash 'pointerSize 0))))]) - (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'global)) 10 ctx) 1) - (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref ctx 'parent) 'parent) 'parent) 'pointerSize) 1))) + (let ([parent (mhash 'parent (mhash 'parent (mhash 'parent (mhash 'pointerSize 0))))]) + (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'global)) 10 #:parent parent) 1) + (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointerSize) 1))) (test-case "size should handle void pointers" - (let ([ctx (mhash 'pointerSize 0)]) - (check-equal? (size (+xpointer uint8 'void) (+xvoid-pointer uint8 50) ctx) 1) - (check-equal? (dict-ref ctx 'pointerSize) 1))) + (let ([parent (mhash 'pointerSize 0)]) + (check-equal? (size (+xpointer uint8 'void) (+xvoid-pointer uint8 50) #:parent parent) 1) + (check-equal? (dict-ref parent 'pointerSize) 1))) (test-case "size should throw if no type and not a void pointer" - (let ([ctx (mhash 'pointerSize 0)]) - (check-exn exn:fail:contract? (λ () (size (+xpointer uint8 'void) 30 ctx))))) + (let ([parent (mhash 'pointerSize 0)]) + (check-exn exn:fail:contract? (λ () (size (+xpointer uint8 'void) 30 #:parent parent))))) (test-case "size should return a fixed size without a value" @@ -104,107 +104,107 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "encode should handle null pointers" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'pointerSize 0 + (define parent (mhash 'pointerSize 0 'startOffset 0 'pointerOffset 0 'pointers null)) - (encode (+xpointer uint8 uint8) #f #:parent ctx) - (check-equal? (dict-ref ctx 'pointerSize) 0) + (encode (+xpointer uint8 uint8) #f #:parent parent) + (check-equal? (dict-ref parent 'pointerSize) 0) (check-equal? (dump (current-output-port)) (bytes 0)))) (test-case "encode should handle local offsets" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'pointerSize 0 + (define parent (mhash 'pointerSize 0 'startOffset 0 'pointerOffset 1 'pointers null)) - (encode (+xpointer uint8 uint8) 10 #:parent ctx) - (check-equal? (dict-ref ctx 'pointerOffset) 2) - (check-equal? (dict-ref ctx 'pointers) (list (mhasheq 'type uint8 + (encode (+xpointer uint8 uint8) 10 #:parent parent) + (check-equal? (dict-ref parent 'pointerOffset) 2) + (check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 'val 10 - 'parent ctx))) + 'parent parent))) (check-equal? (dump (current-output-port)) (bytes 1)))) (test-case "encode should handle immediate offsets" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'pointerSize 0 + (define parent (mhash 'pointerSize 0 'startOffset 0 'pointerOffset 1 'pointers null)) - (encode (+xpointer uint8 uint8 (mhash 'type 'immediate)) 10 #:parent ctx) - (check-equal? (dict-ref ctx 'pointerOffset) 2) - (check-equal? (dict-ref ctx 'pointers) (list (mhasheq 'type uint8 + (encode (+xpointer uint8 uint8 (mhash 'type 'immediate)) 10 #:parent parent) + (check-equal? (dict-ref parent 'pointerOffset) 2) + (check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 'val 10 - 'parent ctx))) + 'parent parent))) (check-equal? (dump (current-output-port)) (bytes 0)))) (test-case "encode should handle offsets relative to parent" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'parent (mhash 'pointerSize 0 + (define parent (mhash 'parent (mhash 'pointerSize 0 'startOffset 3 'pointerOffset 5 'pointers null))) - (encode (+xpointer uint8 uint8 (mhash 'type 'parent)) 10 #:parent ctx) - (check-equal? (dict-ref (dict-ref ctx 'parent) 'pointerOffset) 6) - (check-equal? (dict-ref (dict-ref ctx 'parent) 'pointers) (list (mhasheq 'type uint8 + (encode (+xpointer uint8 uint8 (mhash 'type 'parent)) 10 #:parent parent) + (check-equal? (dict-ref (dict-ref parent 'parent) 'pointerOffset) 6) + (check-equal? (dict-ref (dict-ref parent 'parent) 'pointers) (list (mhasheq 'type uint8 'val 10 - 'parent ctx))) + 'parent parent))) (check-equal? (dump (current-output-port)) (bytes 2)))) (test-case "encode should handle global offsets" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'parent + (define parent (mhash 'parent (mhash 'parent (mhash 'parent (mhash 'pointerSize 0 'startOffset 3 'pointerOffset 5 'pointers null))))) - (encode (+xpointer uint8 uint8 (mhash 'type 'global)) 10 #:parent ctx) - (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref ctx 'parent) 'parent) 'parent) 'pointerOffset) 6) - (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref ctx 'parent) 'parent) 'parent) 'pointers) + (encode (+xpointer uint8 uint8 (mhash 'type 'global)) 10 #:parent parent) + (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointerOffset) 6) + (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointers) (list (mhasheq 'type uint8 'val 10 - 'parent ctx))) + 'parent parent))) (check-equal? (dump (current-output-port)) (bytes 5)))) (test-case "encode should support offsets relative to a property on the parent" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'pointerSize 0 + (define parent (mhash 'pointerSize 0 'startOffset 0 'pointerOffset 10 'pointers null 'val (mhash 'ptr 4))) - (encode (+xpointer uint8 uint8 (mhash 'relativeTo (λ (ctx) (dict-ref ctx 'ptr)))) 10 #:parent ctx) - (check-equal? (dict-ref ctx 'pointerOffset) 11) - (check-equal? (dict-ref ctx 'pointers) (list (mhasheq 'type uint8 + (encode (+xpointer uint8 uint8 (mhash 'relativeTo (λ (parent) (dict-ref parent 'ptr)))) 10 #:parent parent) + (check-equal? (dict-ref parent 'pointerOffset) 11) + (check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 'val 10 - 'parent ctx))) + 'parent parent))) (check-equal? (dump (current-output-port)) (bytes 6)))) (test-case "encode should support void pointers" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'pointerSize 0 + (define parent (mhash 'pointerSize 0 'startOffset 0 'pointerOffset 1 'pointers null)) - (encode (+xpointer uint8 'void) (+xvoid-pointer uint8 55) #:parent ctx) - (check-equal? (dict-ref ctx 'pointerOffset) 2) - (check-equal? (dict-ref ctx 'pointers) (list (mhasheq 'type uint8 + (encode (+xpointer uint8 'void) (+xvoid-pointer uint8 55) #:parent parent) + (check-equal? (dict-ref parent 'pointerOffset) 2) + (check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 'val 55 - 'parent ctx))) + 'parent parent))) (check-equal? (dump (current-output-port)) (bytes 1)))) (test-case "encode should throw if not a void pointer instance" (parameterize ([current-output-port (open-output-bytes)]) - (define ctx (mhash 'pointerSize 0 + (define parent (mhash 'pointerSize 0 'startOffset 0 'pointerOffset 1 'pointers null)) - (check-exn exn:fail:contract? (λ () (encode (+xpointer uint8 'void) 44 #:parent ctx))))) + (check-exn exn:fail:contract? (λ () (encode (+xpointer uint8 'void) 44 #:parent parent))))) diff --git a/xenomorph/xenomorph/redo/versioned-struct.rkt b/xenomorph/xenomorph/redo/versioned-struct.rkt index e07e7929..973a4333 100644 --- a/xenomorph/xenomorph/redo/versioned-struct.rkt +++ b/xenomorph/xenomorph/redo/versioned-struct.rkt @@ -34,22 +34,22 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [else (_parse-fields port res fields) res]) port parent)) -(define (xversioned-struct-size xvs [val #f] [parent-arg #f] [include-pointers #t]) +(define (xversioned-struct-size xvs [val #f] #:parent [parent-arg #f] [include-pointers #t]) (unless val (raise-argument-error 'xversioned-struct-size "value" val)) (define parent (mhash 'parent parent-arg 'val val 'pointerSize 0)) (define version-size (if (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))) - (size (xversioned-struct-type xvs) (dict-ref val 'version) parent) + (size (xversioned-struct-type xvs) (dict-ref val 'version) #:parent parent) 0)) (define header-size (for/sum ([(key type) (in-dict (or (dict-ref (xversioned-struct-versions xvs) 'header #f) null))]) - (size type (and val (dict-ref val key)) parent))) + (size type (and val (dict-ref val key)) #:parent parent))) (define fields-size (let ([fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version)) (raise-argument-error 'xversioned-struct-size "valid version key" version))]) (for/sum ([(key type) (in-dict fields)]) - (size type (and val (dict-ref val key)) parent)))) + (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)) @@ -66,7 +66,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee 'parent parent-arg 'val val 'pointerSize 0)) - (dict-set! parent 'pointerOffset (+ (pos port) (xversioned-struct-size xvs val parent #f))) + (dict-set! parent 'pointerOffset (+ (pos port) (xversioned-struct-size xvs val #:parent parent #f))) (when (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))) (encode (xversioned-struct-type xvs) (dict-ref val 'version #f)))