From ac885f26d08699b7f2a555114e63f623cef8dbd0 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 17 Dec 2018 20:44:35 -0800 Subject: [PATCH] [bust] --- xenomorph/xenomorph/helper.rkt | 7 ++-- xenomorph/xenomorph/struct.rkt | 48 ++++++++++++------------ xenomorph/xenomorph/versioned-struct.rkt | 39 ++++++++++--------- 3 files changed, 46 insertions(+), 48 deletions(-) diff --git a/xenomorph/xenomorph/helper.rkt b/xenomorph/xenomorph/helper.rkt index 21f120c4..9cab704e 100644 --- a/xenomorph/xenomorph/helper.rkt +++ b/xenomorph/xenomorph/helper.rkt @@ -9,13 +9,14 @@ (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:pointer-size-key 'x:ptr-size) (define x:pointers-key 'x:pointers) -(define x:pointer-offset-key 'x:pointer-offset) +(define x:pointer-offset-key 'x:ptr-offset) +(define x:pointer-type-key 'x:ptr-type) (define x:val-key 'x:val) (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)) + x:pointers-key x:pointer-offset-key x:pointer-type-key x:val-key)) (define (hash-ref* d . keys) (for/fold ([d d]) diff --git a/xenomorph/xenomorph/struct.rkt b/xenomorph/xenomorph/struct.rkt index 63a4ff37..0aac6de2 100644 --- a/xenomorph/xenomorph/struct.rkt +++ b/xenomorph/xenomorph/struct.rkt @@ -13,7 +13,7 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee |# -(define (xstruct-setup port parent len) +(define (setup port parent len) (define mheq (make-hasheq)) (dict-set*! mheq x:parent-key parent @@ -22,19 +22,18 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee x:length-key len) mheq) -(define (xstruct-parse-fields port sdr fields-arg) +(define (parse-fields! port mheq fields-arg) (define fields (if (x:struct? fields-arg) (get-field fields fields-arg) fields-arg)) (unless (assocs? fields) (raise-argument-error 'xstruct-parse-fields "assocs" fields)) - (for/fold ([sdr sdr]) - ([(key type) (in-dict fields)]) + (for ([(key type) (in-dict fields)]) (define val (if (procedure? type) - (type sdr) - (send type x:decode port sdr))) + (type mheq) + (send type x:decode port mheq))) (unless (void? val) - (dict-set! sdr key val)) - (dict-set! sdr x:current-offset-key (- (pos port) (dict-ref sdr x:start-offset-key))) - sdr)) + (hash-set! mheq key val)) + (hash-set! mheq x:current-offset-key (- (pos port) (hash-ref mheq x:start-offset-key)))) + mheq) (define (dict->mutable-hash x) (define h (make-hasheq)) @@ -52,34 +51,33 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (raise-argument-error '+xstruct "dict" @fields))) (define/augride (x:decode port parent [len 0]) - ;; xstruct-setup and xstruct-parse-fields are separate to cooperate with VersionedStruct - (define decoded-hash - (xstruct-parse-fields port (xstruct-setup port parent len) @fields)) - (unless (dict? decoded-hash) - (raise-result-error 'xstruct-decode "dict" decoded-hash)) - decoded-hash) + (define res (setup port parent len)) + (parse-fields! port res @fields) + (unless (dict? res) + (raise-result-error 'xstruct-decode "dict" res)) + res) (define/override (decode port parent) (dict->mutable-hash (x:decode port parent))) - (define/augride (x:encode val port [parent-arg #f]) + (define/augride (x:encode field-data port [parent-arg #f]) ;; check keys first, since `size` also relies on keys being valid - (unless (dict? val) - (raise-result-error 'xstruct-encode "dict" val)) - (unless (andmap (λ (key) (memq key (dict-keys val))) (dict-keys @fields)) + (unless (dict? field-data) + (raise-result-error 'xstruct-encode "dict" field-data)) + (unless (andmap (λ (field-key) (memq field-key (dict-keys field-data))) (dict-keys @fields)) (raise-argument-error 'xstruct-encode (format "dict that contains superset of xstruct keys: ~a" - (dict-keys @fields)) (dict-keys val))) + (dict-keys @fields)) (dict-keys field-data))) (define parent (mhash x:pointers-key empty x:start-offset-key (pos port) x:parent-key parent-arg - x:val-key val + x:val-key field-data x:pointer-size-key 0)) - (dict-set! parent x:pointer-offset-key (+ (pos port) (x:size val parent #f))) + (hash-set! parent x:pointer-offset-key (+ (pos port) (x:size field-data 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 x:pointers-key))]) - (send (dict-ref ptr 'type) x:encode (dict-ref ptr x:val-key) port (dict-ref ptr x:parent-key)))) + (send type x:encode (dict-ref field-data key) port parent)) + (for ([ptr (in-list (hash-ref parent x:pointers-key))]) + (send (dict-ref ptr x:pointer-type-key) x:encode (dict-ref ptr x:val-key) 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 diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index e7e80958..615ffa19 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -16,7 +16,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (init-field [(@type type)] [(@versions versions)]) (unless (for/or ([proc (list integer? procedure? xenomorphic-type? symbol?)]) - (proc @type)) + (proc @type)) (raise-argument-error '+xversioned-struct "integer, procedure, symbol, or xenomorphic" @type)) (unless (and (dict? @versions) (andmap (λ (v) (or (dict? v) (x:struct? v))) (dict-values @versions))) (raise-argument-error '+xversioned-struct "dict of dicts or structish" @versions)) @@ -39,27 +39,26 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (if (x:struct? field-object) (get-field fields field-object) field-object)) (define/override (x:decode port parent [length 0]) - (define res (xstruct-setup port parent length)) - (dict-set! res x:version-key - (cond - [(integer? @type) @type] - [(or (symbol? @type) (procedure? @type)) - (unless parent - (raise-argument-error 'xversioned-struct-decode "valid parent" parent)) - (version-getter parent)] - [else (send @type x:decode port)])) + (define res (setup port parent length)) + (define which-version (cond + [(integer? @type) @type] + [(or (symbol? @type) (procedure? @type)) + (unless parent + (raise-argument-error 'xversioned-struct-decode "valid parent" parent)) + (version-getter parent)] + [else (send @type x:decode port parent)])) + (dict-set! res x:version-key which-version) + + (cond + [(dict-ref @versions 'header #f) => (λ (header-val) (parse-fields! port res header-val))]) - (when (dict-ref @versions 'header #f) - (xstruct-parse-fields port res (dict-ref @versions 'header))) - (define fields (or (dict-ref @versions (dict-ref res x:version-key #f) #f) (raise-argument-error 'xversioned-struct-decode "valid version key" (cons version @versions)))) (cond [(x:versioned-struct? fields) (send fields x:decode port parent)] - [else (xstruct-parse-fields port res fields) - res])) + [else (parse-fields! port res fields)])) (define/override (x:encode encode-me port [parent-arg #f]) (unless (dict? encode-me) @@ -75,15 +74,15 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define maybe-header-dict (dict-ref @versions 'header #f)) (when maybe-header-dict (for ([(key type) (in-dict maybe-header-dict)]) - (send type x:encode (dict-ref encode-me key) port parent))) + (send type x:encode (dict-ref encode-me key) port parent))) (define fields (extract-fields-dict encode-me)) (unless (andmap (λ (key) (member key (dict-keys encode-me))) (dict-keys fields)) (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)) + (send type x:encode (dict-ref encode-me key) port parent)) (for ([ptr (in-list (dict-ref parent x:pointers-key))]) - (send (dict-ref ptr 'type) x:encode (dict-ref ptr x:val-key) port (dict-ref ptr x:parent-key)))) + (send (dict-ref ptr 'type) x:encode (dict-ref ptr x:val-key) port (dict-ref ptr x:parent-key)))) (define/override (x:size [val #f] [parent-arg #f] [include-pointers #t]) (unless val @@ -96,10 +95,10 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (send @type x:size (dict-ref val x:version-key) parent)))) (define header-size (for/sum ([(key type) (in-dict (or (dict-ref @versions 'header #f) null))]) - (send type x:size (and val (dict-ref val key)) parent))) + (send type x:size (and val (dict-ref val key)) parent))) (define fields-size (for/sum ([(key type) (in-dict (extract-fields-dict val))]) - (send type x:size (and val (dict-ref val key)) parent))) + (send type x:size (and val (dict-ref val key)) parent))) (define pointer-size (if include-pointers (dict-ref parent x:pointer-size-key) 0)) (+ version-size header-size fields-size pointer-size))))