diff --git a/xenomorph/xenomorph/pointer.rkt b/xenomorph/xenomorph/pointer.rkt index e0539b99..4cba41a8 100644 --- a/xenomorph/xenomorph/pointer.rkt +++ b/xenomorph/xenomorph/pointer.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang debug racket/base (require "base.rkt" "number.rkt" racket/dict @@ -23,6 +23,26 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [(xvoid-pointer? val) (values (xvoid-pointer-type val) (xvoid-pointer-value val))] [else (raise-argument-error 'x:pointer "VoidPointer" val)])) +(define (pointer-encode this val-in port parent) + (cond + [val-in + (define new-parent (case (get-field pointer-relative-to this) + [(local immediate) parent] + [(parent) (hash-ref parent x:parent-key)] + [(global) (find-top-parent parent)] + [else (error 'unknown-pointer-style)])) + (define relative (+ (case (get-field pointer-relative-to this) + [(local parent) (hash-ref new-parent x:start-offset-key)] + [(immediate) (+ (pos port) (send (get-field offset-type this) size val-in parent))] + [(global) 0]))) + (send (get-field offset-type this) encode (- (hash-ref new-parent x:pointer-offset-key) relative) port) + (define-values (type val) (resolve-pointer (get-field type this) val-in)) + (hash-update! new-parent x:pointers-key + (λ (ptrs) (append ptrs (list (x:ptr type val parent))))) + (hash-set! new-parent x:pointer-offset-key + (+ (hash-ref new-parent x:pointer-offset-key) (send type size val parent)))] + [else (send (get-field offset-type this) encode (get-field null-value this) port)])) + (define x:pointer% (class x:base% (super-new) @@ -58,24 +78,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee (define/augride (encode val-in port [parent #f]) (unless parent ; todo: furnish default pointer context? adapt from Struct? (raise-argument-error 'xpointer-encode "valid pointer context" parent)) - (cond - [val-in - (define new-parent (case @pointer-relative-to - [(local immediate) parent] - [(parent) (hash-ref parent x:parent-key)] - [(global) (find-top-parent parent)] - [else (error 'unknown-pointer-style)])) - (define relative (+ (case @pointer-relative-to - [(local parent) (hash-ref new-parent x:start-offset-key)] - [(immediate) (+ (pos port) (send @offset-type size val-in parent))] - [(global) 0]))) - (send @offset-type encode (- (hash-ref new-parent x:pointer-offset-key) relative) port) - (define-values (type val) (resolve-pointer @type val-in)) - (hash-update! new-parent x:pointers-key - (λ (ptrs) (append ptrs (list (x:ptr type val parent))))) - (hash-set! new-parent x:pointer-offset-key - (+ (hash-ref new-parent x:pointer-offset-key) (send type size val parent)))] - [else (send @offset-type encode @null-value port)])) + (pointer-encode this val-in port parent)) (define/augride (size [val-in #f] [parent #f]) (define new-parent (case @pointer-relative-to @@ -130,8 +133,8 @@ This allows the pointer to be calculated relative to a property on the parent. I ;; A pointer whose type is determined at decode time (define x:void-pointer% (class x:base% - (super-new) - (init-field type value))) + (super-new) + (init-field type value))) (define (x:void-pointer . args) (apply make-object x:void-pointer% args)) (define (xvoid-pointer? x) (is-a? x x:void-pointer%)) (define (xvoid-pointer-type x) (get-field type x)) diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index c761acba..6a29a4bd 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -57,7 +57,6 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [_ (parse-fields port res field-object)])) (define/override (pre-encode val) - #R (dict-keys val) (cond [(and (not (dict-has-key? val x:version-key)) (dict-has-key? val 'version)) (dict-set val x:version-key (dict-ref val 'version))] @@ -78,11 +77,11 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (send type encode (dict-ref field-data key) port parent)) (define fields (select-field-set field-data)) - (unless (andmap (λ (key) (member key (hash-keys field-data))) (dict-keys fields)) - (raise-argument-error 'x:versioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys field-data))) + (unless (andmap (λ (key) (member key (dict-keys field-data))) (dict-keys fields)) + (raise-argument-error 'x:versioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (dict-keys field-data))) (for ([(key type) (in-dict fields)]) - (send type encode (hash-ref field-data key) port parent)) - (for ([ptr (in-list (hash-ref parent x:pointers-key))]) + (send type encode (dict-ref field-data key) port parent)) + (for ([ptr (in-list (dict-ref parent x:pointers-key))]) (match ptr [(x:ptr type val parent) (send type encode val port parent)])))