diff --git a/xenomorph/xenomorph/struct.rkt b/xenomorph/xenomorph/struct.rkt index 56b5c528..9395521c 100644 --- a/xenomorph/xenomorph/struct.rkt +++ b/xenomorph/xenomorph/struct.rkt @@ -50,7 +50,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (super-new) (init-field [(@fields fields)]) - (define/augment (xxdecode port parent [len 0]) + (define/augride (xxdecode 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)) @@ -61,7 +61,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (define/override (decode port parent) (dict->mutable-hash (xxdecode port parent))) - (define/augment (xxencode val port [parent-arg #f]) + (define/augride (xxencode val 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)) @@ -80,7 +80,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (for ([ptr (in-list (dict-ref parent 'pointers))]) (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port (dict-ref ptr 'parent)))) - (define/augment (xxsize [val #f] [parent-arg #f] [include-pointers #t]) + (define/augride (xxsize [val #f] [parent-arg #f] [include-pointers #t]) (define parent (mhasheq 'parent parent-arg 'val val 'pointerSize 0)) diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index 9215e3c0..2667a36a 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -14,7 +14,12 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (class xstruct% (super-new) (init-field [(@type type)] [(@versions versions)]) - (inherit-field [@fields fields]) + + (unless (for/or ([proc (list integer? procedure? xenomorphic-type? symbol?)]) + (proc @type)) + (raise-argument-error '+xversioned-struct "integer, procedure, symbol, or xenomorphic" @type)) + (unless (and (dict? @versions) (andmap (λ (v) (or (dict? v) (xstruct? v))) (dict-values @versions))) + (raise-argument-error '+xversioned-struct "dict of dicts or structish" @versions)) (define version-getter (cond [(procedure? @type) @type] @@ -30,18 +35,17 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (raise-argument-error 'xversioned-struct-encode "valid version key" version)) (if (xstruct? field-object) (get-field fields field-object) field-object)) - (define/augment (xxdecode port parent [length 0]) + (define/override (xxdecode port parent [length 0]) (define res (xstruct-setup port parent length)) (dict-set! res 'version (cond [(integer? @type) @type] - #;[forced-version] ; for testing purposes: pass an explicit version [(or (symbol? @type) (procedure? @type)) (unless parent (raise-argument-error 'xversioned-struct-decode "valid parent" parent)) (version-getter parent)] [else (send @type xxdecode port)])) - + (when (dict-ref @versions 'header #f) (xstruct-parse-fields port res (dict-ref @versions 'header))) @@ -54,7 +58,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [else (xstruct-parse-fields port res fields) res])) - (define/augment (xxencode encode-me port [parent-arg #f]) + (define/override (xxencode encode-me port [parent-arg #f]) (unless (dict? encode-me) (raise-argument-error 'xversioned-struct-encode "dict" encode-me)) (define parent (mhash 'pointers null @@ -68,17 +72,17 @@ 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 xxencode (dict-ref encode-me key) port parent))) + (send type xxencode (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 xxencode (dict-ref encode-me key) port parent)) + (send type xxencode (dict-ref encode-me key) port parent)) (for ([ptr (in-list (dict-ref parent 'pointers))]) - (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port (dict-ref ptr 'parent)))) + (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port (dict-ref ptr 'parent)))) - (define/augment (xxsize [val #f] [parent-arg #f] [include-pointers #t]) + (define/override (xxsize [val #f] [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)) @@ -89,20 +93,15 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (send @type xxsize (dict-ref val 'version) parent)))) (define header-size (for/sum ([(key type) (in-dict (or (dict-ref @versions 'header #f) null))]) - (send type xxsize (and val (dict-ref val key)) parent))) + (send type xxsize (and val (dict-ref val key)) parent))) (define fields-size (for/sum ([(key type) (in-dict (extract-fields-dict val))]) - (send type xxsize (and val (dict-ref val key)) parent))) + (send type xxsize (and val (dict-ref val key)) parent))) (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0)) (+ version-size header-size fields-size pointer-size)))) (define (xversioned-struct? x) (is-a? x xversioned-struct%)) (define (+xversioned-struct #:subclass [class xversioned-struct%] type [versions (dictify)]) - (unless (for/or ([proc (list integer? procedure? xenomorphic-type? symbol?)]) - (proc type)) - (raise-argument-error '+xversioned-struct "integer, procedure, symbol, or xenomorphic" type)) - (unless (and (dict? versions) (andmap (λ (v) (or (dict? v) (xstruct? v))) (dict-values versions))) - (raise-argument-error '+xversioned-struct "dict of dicts or structish" versions)) - (new class [type type] [versions versions])) + (new class [type type] [versions versions][fields #f]))