diff --git a/xenomorph/xenomorph/helper.rkt b/xenomorph/xenomorph/helper.rkt index 8e54f951..5b7b41a9 100644 --- a/xenomorph/xenomorph/helper.rkt +++ b/xenomorph/xenomorph/helper.rkt @@ -6,6 +6,8 @@ "generic.rkt") (provide (all-defined-out)) +(define x:version-key 'x:version) + (define (dict-ref* d . keys) (for/fold ([d d]) ([k (in-list keys)]) @@ -16,7 +18,7 @@ (file-position p new-pos)) (file-position p)) -(define x:enomorphic<%> +(define xenomorphic<%> (interface* () ([(generic-property gen:xenomorphic) (generic-method-table @@ -58,7 +60,7 @@ [else CLASS])) (define xenobase% - (class* object% (x:enomorphic<%>) + (class* object% (xenomorphic<%>) (super-new) (define/pubment (x:decode input-port [parent #f]) diff --git a/xenomorph/xenomorph/test/versioned-struct-test.rkt b/xenomorph/xenomorph/test/versioned-struct-test.rkt index 2200a9dc..3269b50b 100644 --- a/xenomorph/xenomorph/test/versioned-struct-test.rkt +++ b/xenomorph/xenomorph/test/versioned-struct-test.rkt @@ -25,9 +25,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'age uint8 'gender uint8)))]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) - (check-equal? (decode vstruct) (mhasheq 'name "roxyb" 'age 21 'version 0))) + (check-equal? (decode vstruct) (mhasheq 'name "roxyb" 'age 21 x:version-key 0))) (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 馃\x15\x00"))]) - (check-equal? (decode vstruct) (mhasheq 'name "roxyb 馃" 'age 21 'version 1 'gender 0))))) + (check-equal? (decode vstruct) (mhasheq 'name "roxyb 馃" 'age 21 x:version-key 1 'gender 0))))) (test-case "versioned struct: decode should throw for unknown version" @@ -54,17 +54,17 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe (check-equal? (decode vstruct) (mhasheq 'name "roxyb" 'age 21 'alive 1 - 'version 0))) + x:version-key 0))) (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 馃\x00"))]) (check-equal? (decode vstruct) (mhasheq 'name "roxyb 馃" 'age 21 - 'version 1 + x:version-key 1 'alive 1 'gender 0))))) (test-case "versioned struct: decode should support parent version key" - (let ([vstruct (x:versioned-struct 'version + (let ([vstruct (x:versioned-struct x:version-key (dictify 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 'age uint8) @@ -72,11 +72,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'age uint8 'gender uint8)))]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")]) - (check-equal? (decode vstruct #:parent (mhash 'version 0)) - (mhasheq 'name "roxyb" 'age 21 'version 0))) + (check-equal? (decode vstruct #:parent (mhash x:version-key 0)) + (mhasheq 'name "roxyb" 'age 21 x:version-key 0))) (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 馃\x15\x00"))]) - (check-equal? (decode vstruct #:parent (mhash 'version 1)) - (mhasheq 'name "roxyb 馃" 'age 21 'version 1 'gender 0))))) + (check-equal? (decode vstruct #:parent (mhash x:version-key 1)) + (mhasheq 'name "roxyb 馃" 'age 21 x:version-key 1 'gender 0))))) (test-case "versioned struct: decode should support sub versioned structs" @@ -90,14 +90,14 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 1 (dictify 'name (x:string uint8) 'isDessert uint8)))))]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) - (check-equal? (decode vstruct #:parent (mhash 'version 0)) - (mhasheq 'name "roxyb" 'age 21 'version 0))) + (check-equal? (decode vstruct #:parent (mhash x:version-key 0)) + (mhasheq 'name "roxyb" 'age 21 x:version-key 0))) (parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")]) - (check-equal? (decode vstruct #:parent (mhash 'version 0)) - (mhasheq 'name "pasta" 'version 0))) + (check-equal? (decode vstruct #:parent (mhash x:version-key 0)) + (mhasheq 'name "pasta" x:version-key 0))) (parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")]) - (check-equal? (decode vstruct #:parent (mhash 'version 0)) - (mhasheq 'name "ice cream" 'isDessert 1 'version 1))))) + (check-equal? (decode vstruct #:parent (mhash x:version-key 0)) + (mhasheq 'name "ice cream" 'isDessert 1 x:version-key 1))))) (test-case "versioned struct: decode should support process hook" @@ -111,7 +111,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'gender uint8)))]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) (check-equal? (decode vstruct) - (mhasheq 'name "roxyb" 'processed "true" 'age 21 'version 0))))) + (mhasheq 'name "roxyb" 'processed "true" 'age 21 x:version-key 0))))) (test-case "versioned struct: size should compute the correct size" @@ -124,11 +124,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'gender uint8)))]) (check-equal? (size vstruct (mhasheq 'name "roxyb" 'age 21 - 'version 0)) 8) + x:version-key 0)) 8) (check-equal? (size vstruct (mhasheq 'name "roxyb 馃" 'gender 0 'age 21 - 'version 1)) 14))) + x:version-key 1)) 14))) (test-case "versioned struct: size should throw for unknown version" @@ -139,7 +139,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 'age uint8 'gender uint8)))]) - (check-exn exn:fail:contract? (位 () (size vstruct (mhasheq 'name "roxyb" 'age 21 'version 5)))))) + (check-exn exn:fail:contract? (位 () (size vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 5)))))) (test-case "versioned struct: size should support common header block" @@ -150,8 +150,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)) 1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 'gender uint8)))]) - (check-equal? (size struct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 0)) 9) - (check-equal? (size struct (mhasheq 'name "roxyb 馃" 'gender 0 'age 21 'alive 1 'version 1)) 15))) + (check-equal? (size struct (mhasheq 'name "roxyb" 'age 21 'alive 1 x:version-key 0)) 9) + (check-equal? (size struct (mhasheq 'name "roxyb 馃" 'gender 0 'age 21 'alive 1 x:version-key 1)) 15))) (test-case "versioned struct: size should compute the correct size with pointers" @@ -165,7 +165,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe #:type (x:string uint8)))))]) (check-equal? (size vstruct (mhasheq 'name "roxyb" 'age 21 - 'version 1 + x:version-key 1 'ptr "hello")) 15))) (test-case @@ -189,8 +189,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'age uint8 'gender uint8)))] [op (open-output-bytes)]) - (encode vstruct (mhasheq 'name "roxyb" 'age 21 'version 0) op) - (encode vstruct (mhasheq 'name "roxyb 馃" 'age 21 'gender 0 'version 1) op) + (encode vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 0) op) + (encode vstruct (mhasheq 'name "roxyb 馃" 'age 21 'gender 0 x:version-key 1) op) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 馃\x15\x00")))) (test-case @@ -203,7 +203,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'age uint8 'gender uint8)))] [op (open-output-bytes)]) - (check-exn exn:fail:contract? (位 () (encode vstruct op (mhasheq 'name "roxyb" 'age 21 'version 5)))))) + (check-exn exn:fail:contract? (位 () (encode vstruct op (mhasheq 'name "roxyb" 'age 21 x:version-key 5)))))) (test-case "versioned struct: encode should support common header block" @@ -215,8 +215,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 'gender uint8)))] [op (open-output-bytes)]) - (encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 0) op) - (encode vstruct (mhasheq 'name "roxyb 馃" 'gender 0 'age 21 'alive 1 'version 1) op) + (encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 x:version-key 0) op) + (encode vstruct (mhasheq 'name "roxyb 馃" 'gender 0 'age 21 'alive 1 x:version-key 1) op) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 馃\x00")))) (test-case @@ -230,7 +230,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'ptr (x:pointer #:offset-type uint8 #:type (x:string uint8)))))] [op (open-output-bytes)]) - (encode vstruct (mhasheq 'version 1 'name "roxyb" 'age 21 'ptr "hello") op) + (encode vstruct (mhasheq x:version-key 1 'name "roxyb" 'age 21 'ptr "hello") op) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello")))) @@ -244,7 +244,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe 'age uint8 'gender uint8)))] [op (open-output-bytes)]) - (set-pre-encode! vstruct (位 (val) (dict-set! val 'version (if (dict-ref val 'gender #f) 1 0)) val)) - (encode vstruct (mhasheq 'name "roxyb" 'age 21 'version 0) op) + (set-pre-encode! vstruct (位 (val) (dict-set! val x:version-key (if (dict-ref val 'gender #f) 1 0)) val)) + (encode vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 0) op) (encode vstruct (mhasheq 'name "roxyb 馃" 'age 21 'gender 0) op) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 馃\x15\x00")))) \ No newline at end of file diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index 11dfed6d..28ad4a38 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang debug racket/base (require "helper.rkt" "struct.rkt" racket/dict racket/class @@ -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)) @@ -30,14 +30,17 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [(symbol? @type) (位 (parent version) (dict-set! parent @type version))])) (define (extract-fields-dict val) - (define field-object (dict-ref @versions (dict-ref val 'version #f) #f)) - (unless field-object - (raise-argument-error 'xversioned-struct-encode "valid version key" version)) + (define version-key + (or (dict-ref val x:version-key #f) + (raise-argument-error 'xversioned-struct-encode "value for version key" x:version-key))) + (define field-object + (or (dict-ref @versions version-key #f) + (raise-argument-error 'xversioned-struct-encode (format "valid field version: ~v" (dict-keys @versions)) version-key))) (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 'version + (dict-set! res x:version-key (cond [(integer? @type) @type] [(or (symbol? @type) (procedure? @type)) @@ -50,7 +53,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (xstruct-parse-fields port res (dict-ref @versions 'header))) (define fields - (or (dict-ref @versions (dict-ref res 'version #f) #f) + (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 @@ -68,19 +71,19 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee 'pointerSize 0)) (dict-set! parent 'pointerOffset (+ (pos port) (x:size encode-me parent #f))) (unless (or (symbol? @type) (procedure? @type)) - (send @type x:encode (dict-ref encode-me 'version #f) port parent)) + (send @type x:encode (dict-ref encode-me x:version-key #f) port parent)) (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 'pointers))]) - (send (dict-ref ptr 'type) x:encode (dict-ref ptr 'val) port (dict-ref ptr 'parent)))) + (send (dict-ref ptr 'type) x:encode (dict-ref ptr 'val) port (dict-ref ptr 'parent)))) (define/override (x:size [val #f] [parent-arg #f] [include-pointers #t]) (unless val @@ -90,13 +93,13 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (let ([struct-type @type]) (if (or (symbol? struct-type) (procedure? struct-type)) 0 - (send @type x:size (dict-ref val 'version) parent)))) + (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 'pointerSize) 0)) (+ version-size header-size fields-size pointer-size))))