diff --git a/xenomorph/xenomorph/array.rkt b/xenomorph/xenomorph/array.rkt index 48f26cd1..28822a4e 100644 --- a/xenomorph/xenomorph/array.rkt +++ b/xenomorph/xenomorph/array.rkt @@ -63,13 +63,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (send @type x:encode item port parent)))) (cond [(x:int? @len) - (define new-parent (mhash 'pointers null + (define new-parent (mhash x:pointers-key null 'startOffset (pos port) x:parent-key parent)) - (hash-set! new-parent 'pointerOffset (+ (pos port) (x:size array new-parent))) + (hash-set! new-parent x:pointer-offset-key (+ (pos port) (x:size array new-parent))) (send @len x:encode (length array) port) ; encode length at front (encode-items new-parent) - (for ([ptr (in-list (hash-ref new-parent 'pointers))]) ; encode pointer data at end + (for ([ptr (in-list (hash-ref new-parent x:pointers-key))]) ; encode pointer data at end (send (hash-ref ptr 'type) x:encode (hash-ref ptr 'val) port))] [else (encode-items parent)])) diff --git a/xenomorph/xenomorph/helper.rkt b/xenomorph/xenomorph/helper.rkt index 178acb6a..5d97d93e 100644 --- a/xenomorph/xenomorph/helper.rkt +++ b/xenomorph/xenomorph/helper.rkt @@ -11,8 +11,12 @@ (define x:current-offset-key 'x:current-offset) (define x:length-key 'x:length) (define x:parent-key 'x:parent) +(define x:pointer-size-key 'x:pointer-size) +(define x:pointers-key 'x:pointers) +(define x:pointer-offset-key 'x:pointer-offset) -(define private-keys (list x:parent-key x:start-offset-key x:current-offset-key x:length-key)) +(define private-keys (list x:parent-key x:start-offset-key x:current-offset-key x:length-key x:pointer-size-key + x:pointers-key x:pointer-offset-key)) (define (hash-ref* d . keys) (for/fold ([d d]) diff --git a/xenomorph/xenomorph/pointer.rkt b/xenomorph/xenomorph/pointer.rkt index a952fc85..bc183393 100644 --- a/xenomorph/xenomorph/pointer.rkt +++ b/xenomorph/xenomorph/pointer.rkt @@ -69,12 +69,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [(local parent) (hash-ref new-parent 'startOffset)] [(immediate) (+ (pos port) (send @offset-type x:size val-in parent))] [(global) 0]))) - (send @offset-type x:encode (- (hash-ref new-parent 'pointerOffset) relative) port) + (send @offset-type x:encode (- (hash-ref new-parent x:pointer-offset-key) relative) port) (define-values (type val) (resolve-pointer @type val-in)) - (hash-update! new-parent 'pointers + (hash-update! new-parent x:pointers-key (λ (ptrs) (append ptrs (list (mhasheq 'type type 'val val x:parent-key parent))))) - (hash-set! new-parent 'pointerOffset - (+ (hash-ref new-parent 'pointerOffset) (send type x:size val parent)))] + (hash-set! new-parent x:pointer-offset-key + (+ (hash-ref new-parent x:pointer-offset-key) (send type x:size val parent)))] [else (send @offset-type x:encode @null-value port)])) (define/augment (x:size [val-in #f] [parent #f]) @@ -85,9 +85,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [else (error 'unknown-pointer-style)])) (define-values (type val) (resolve-pointer @type val-in)) (when (and val new-parent) - (hash-set! new-parent 'pointerSize - (and (hash-ref new-parent 'pointerSize #f) - (+ (hash-ref new-parent 'pointerSize) (send type x:size val new-parent))))) + (hash-set! new-parent x:pointer-size-key + (and (hash-ref new-parent x:pointer-size-key #f) + (+ (hash-ref new-parent x:pointer-size-key) (send type x:size val new-parent))))) (send @offset-type x:size)))) (define (x:pointer [offset-arg #f] [type-arg #f] diff --git a/xenomorph/xenomorph/struct.rkt b/xenomorph/xenomorph/struct.rkt index 92696987..f8966892 100644 --- a/xenomorph/xenomorph/struct.rkt +++ b/xenomorph/xenomorph/struct.rkt @@ -70,25 +70,25 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (raise-argument-error 'xstruct-encode (format "dict that contains superset of xstruct keys: ~a" (dict-keys @fields)) (dict-keys val))) - (define parent (mhash 'pointers empty + (define parent (mhash x:pointers-key empty 'startOffset (pos port) x:parent-key parent-arg 'val val - 'pointerSize 0)) - (dict-set! parent 'pointerOffset (+ (pos port) (x:size val parent #f))) + x:pointer-size-key 0)) + (dict-set! parent x:pointer-offset-key (+ (pos port) (x:size val parent #f))) (for ([(key type) (in-dict @fields)]) (send type x:encode (dict-ref val key) port parent)) - (for ([ptr (in-list (dict-ref parent 'pointers))]) + (for ([ptr (in-list (dict-ref parent x:pointers-key))]) (send (dict-ref ptr 'type) x:encode (dict-ref ptr 'val) port (dict-ref ptr x:parent-key)))) (define/augride (x:size [val #f] [parent-arg #f] [include-pointers #t]) (define parent (mhasheq x:parent-key parent-arg 'val val - 'pointerSize 0)) + x:pointer-size-key 0)) (define fields-size (for/sum ([(key type) (in-dict @fields)] #:when (xenomorphic-type? type)) (send type x:size (and val (dict-ref val key)) parent))) - (define pointers-size (if include-pointers (dict-ref parent 'pointerSize) 0)) + (define pointers-size (if include-pointers (dict-ref parent x:pointer-size-key) 0)) (+ fields-size pointers-size)))) (define (x:struct? x) (is-a? x x:struct%)) diff --git a/xenomorph/xenomorph/test/pointer-test.rkt b/xenomorph/xenomorph/test/pointer-test.rkt index 35822923..ee09b23b 100644 --- a/xenomorph/xenomorph/test/pointer-test.rkt +++ b/xenomorph/xenomorph/test/pointer-test.rkt @@ -57,37 +57,37 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "pointer: size" - (let ([parent (mhash 'pointerSize 0)]) + (let ([parent (mhash x:pointer-size-key 0)]) (check-equal? (size (x:pointer) 10 #:parent parent) 1) - (check-equal? (hash-ref parent 'pointerSize) 1))) + (check-equal? (hash-ref parent x:pointer-size-key) 1))) (test-case "pointer: size should add to immediate pointerSize" - (let ([parent (mhash 'pointerSize 0)]) + (let ([parent (mhash x:pointer-size-key 0)]) (check-equal? (size (x:pointer #:relative-to 'immediate) 10 #:parent parent) 1) - (check-equal? (hash-ref parent 'pointerSize) 1))) + (check-equal? (hash-ref parent x:pointer-size-key) 1))) (test-case "pointer: size should add to parent pointerSize" - (let ([parent (mhash x:parent-key (mhash 'pointerSize 0))]) + (let ([parent (mhash x:parent-key (mhash x:pointer-size-key 0))]) (check-equal? (size (x:pointer #:relative-to 'parent) 10 #:parent parent) 1) - (check-equal? (hash-ref* parent x:parent-key 'pointerSize) 1))) + (check-equal? (hash-ref* parent x:parent-key x:pointer-size-key) 1))) (test-case "pointer: size should add to global pointerSize" - (let ([parent (mhash x:parent-key (mhash x:parent-key (mhash x:parent-key (mhash 'pointerSize 0))))]) + (let ([parent (mhash x:parent-key (mhash x:parent-key (mhash x:parent-key (mhash x:pointer-size-key 0))))]) (check-equal? (size (x:pointer #:relative-to 'global) 10 #:parent parent) 1) - (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key 'pointerSize) 1))) + (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key x:pointer-size-key) 1))) (test-case "pointer: size should handle void pointers" - (let ([parent (mhash 'pointerSize 0)]) + (let ([parent (mhash x:pointer-size-key 0)]) (check-equal? (size (x:pointer uint8 'void) (x:void-pointer uint8 50) #:parent parent) 1) - (check-equal? (hash-ref parent 'pointerSize) 1))) + (check-equal? (hash-ref parent x:pointer-size-key) 1))) (test-case "pointer: size should throw if no type and not a void pointer" - (let ([parent (mhash 'pointerSize 0)]) + (let ([parent (mhash x:pointer-size-key 0)]) (check-exn exn:fail:contract? (λ () (size (x:pointer uint8 'void) 30 #:parent parent))))) (test-case @@ -97,24 +97,24 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "pointer: encode should handle null pointers" (parameterize ([current-output-port (open-output-bytes)]) - (define parent (mhash 'pointerSize 0 + (define parent (mhash x:pointer-size-key 0 'startOffset 0 - 'pointerOffset 0 - 'pointers null)) + x:pointer-offset-key 0 + x:pointers-key null)) (encode (x:pointer) #f #:parent parent) - (check-equal? (hash-ref parent 'pointerSize) 0) + (check-equal? (hash-ref parent x:pointer-size-key) 0) (check-equal? (get-output-bytes (current-output-port)) (bytes 0)))) (test-case "pointer: encode should handle local offsets" (parameterize ([current-output-port (open-output-bytes)]) - (define parent (mhash 'pointerSize 0 + (define parent (mhash x:pointer-size-key 0 'startOffset 0 - 'pointerOffset 1 - 'pointers null)) + x:pointer-offset-key 1 + x:pointers-key null)) (encode (x:pointer) 10 #:parent parent) - (check-equal? (hash-ref parent 'pointerOffset) 2) - (check-equal? (hash-ref parent 'pointers) (list (mhasheq 'type uint8 + (check-equal? (hash-ref parent x:pointer-offset-key) 2) + (check-equal? (hash-ref parent x:pointers-key) (list (mhasheq 'type uint8 'val 10 x:parent-key parent))) (check-equal? (get-output-bytes (current-output-port)) (bytes 1)))) @@ -122,13 +122,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "pointer: encode should handle immediate offsets" (parameterize ([current-output-port (open-output-bytes)]) - (define parent (mhash 'pointerSize 0 + (define parent (mhash x:pointer-size-key 0 'startOffset 0 - 'pointerOffset 1 - 'pointers null)) + x:pointer-offset-key 1 + x:pointers-key null)) (encode (x:pointer #:relative-to 'immediate) 10 #:parent parent) - (check-equal? (hash-ref parent 'pointerOffset) 2) - (check-equal? (hash-ref parent 'pointers) (list (mhasheq 'type uint8 + (check-equal? (hash-ref parent x:pointer-offset-key) 2) + (check-equal? (hash-ref parent x:pointers-key) (list (mhasheq 'type uint8 'val 10 x:parent-key parent))) (check-equal? (get-output-bytes (current-output-port)) (bytes 0)))) @@ -136,13 +136,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "pointer: encode should handle offsets relative to parent" (parameterize ([current-output-port (open-output-bytes)]) - (define parent (mhash x:parent-key (mhash 'pointerSize 0 + (define parent (mhash x:parent-key (mhash x:pointer-size-key 0 'startOffset 3 - 'pointerOffset 5 - 'pointers null))) + x:pointer-offset-key 5 + x:pointers-key null))) (encode (x:pointer #:relative-to 'parent) 10 #:parent parent) - (check-equal? (hash-ref* parent x:parent-key 'pointerOffset) 6) - (check-equal? (hash-ref* parent x:parent-key 'pointers) (list (mhasheq 'type uint8 + (check-equal? (hash-ref* parent x:parent-key x:pointer-offset-key) 6) + (check-equal? (hash-ref* parent x:parent-key x:pointers-key) (list (mhasheq 'type uint8 'val 10 x:parent-key parent))) (check-equal? (get-output-bytes (current-output-port)) (bytes 2)))) @@ -152,13 +152,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (parameterize ([current-output-port (open-output-bytes)]) (define parent (mhash x:parent-key (mhash x:parent-key - (mhash x:parent-key (mhash 'pointerSize 0 + (mhash x:parent-key (mhash x:pointer-size-key 0 'startOffset 3 - 'pointerOffset 5 - 'pointers null))))) + x:pointer-offset-key 5 + x:pointers-key null))))) (encode (x:pointer #:relative-to 'global) 10 #:parent parent) - (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key 'pointerOffset) 6) - (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key 'pointers) + (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key x:pointer-offset-key) 6) + (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key x:pointers-key) (list (mhasheq 'type uint8 'val 10 x:parent-key parent))) @@ -167,20 +167,20 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (test-case "pointer: encode should support void pointers" (parameterize ([current-output-port (open-output-bytes)]) - (define parent (mhash 'pointerSize 0 + (define parent (mhash x:pointer-size-key 0 'startOffset 0 - 'pointerOffset 1 - 'pointers null)) + x:pointer-offset-key 1 + x:pointers-key null)) (encode (x:pointer uint8 'void) (x:void-pointer uint8 55) #:parent parent) - (check-equal? (hash-ref parent 'pointerOffset) 2) - (check-equal? (hash-ref parent 'pointers) (list (mhasheq 'type uint8 'val 55 x:parent-key parent))) + (check-equal? (hash-ref parent x:pointer-offset-key) 2) + (check-equal? (hash-ref parent x:pointers-key) (list (mhasheq 'type uint8 'val 55 x:parent-key parent))) (check-equal? (get-output-bytes (current-output-port)) (bytes 1)))) (test-case "pointer: encode should throw if not a void pointer instance" (parameterize ([current-output-port (open-output-bytes)]) - (define parent (mhash 'pointerSize 0 + (define parent (mhash x:pointer-size-key 0 'startOffset 0 - 'pointerOffset 1 - 'pointers null)) + x:pointer-offset-key 1 + x:pointers-key null)) (check-exn exn:fail:contract? (λ () (encode (x:pointer uint8 'void) 44 #:parent parent))))) diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index ecfb34d1..fb32fa24 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -64,12 +64,12 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define/override (x:encode encode-me port [parent-arg #f]) (unless (dict? encode-me) (raise-argument-error 'xversioned-struct-encode "dict" encode-me)) - (define parent (mhash 'pointers null + (define parent (mhash x:pointers-key null 'startOffset (pos port) x:parent-key parent-arg 'val encode-me - 'pointerSize 0)) - (dict-set! parent 'pointerOffset (+ (pos port) (x:size encode-me parent #f))) + x:pointer-size-key 0)) + (dict-set! parent x:pointer-offset-key (+ (pos port) (x:size encode-me parent #f))) (unless (or (symbol? @type) (procedure? @type)) (send @type x:encode (dict-ref encode-me x:version-key #f) port parent)) (define maybe-header-dict (dict-ref @versions 'header #f)) @@ -82,13 +82,13 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys encode-me))) (for ([(key type) (in-dict fields)]) (send type x:encode (dict-ref encode-me key) port parent)) - (for ([ptr (in-list (dict-ref parent 'pointers))]) + (for ([ptr (in-list (dict-ref parent x:pointers-key))]) (send (dict-ref ptr 'type) x:encode (dict-ref ptr 'val) port (dict-ref ptr x:parent-key)))) (define/override (x:size [val #f] [parent-arg #f] [include-pointers #t]) (unless val (raise-argument-error 'xversioned-struct-size "value" val)) - (define parent (mhash x:parent-key parent-arg 'val val 'pointerSize 0)) + (define parent (mhash x:parent-key parent-arg 'val val x:pointer-size-key 0)) (define version-size (let ([struct-type @type]) (if (or (symbol? struct-type) (procedure? struct-type)) @@ -100,7 +100,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define fields-size (for/sum ([(key type) (in-dict (extract-fields-dict val))]) (send type x:size (and val (dict-ref val key)) parent))) - (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0)) + (define pointer-size (if include-pointers (dict-ref parent x:pointer-size-key) 0)) (+ version-size header-size fields-size pointer-size)))) (define (x:versioned-struct? x) (is-a? x x:versioned-struct%))