mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

support structs as field sources

Browse Source
main
Matthew Butterick 6 years ago
parent ecb3e4a1cf
commit f5d2309164
4 changed files with 84 additions and 104 deletions
Show Stats Download Patch File Download Diff File

63
xenomorph/xenomorph/struct.rkt
Unescape Escape View File

@ -14,39 +14,19 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
|# |#
(define (choose-dict d k) (define (xstruct-setup port parent len)
(if (memq k private-keys) (define mheq (make-hasheq))
(struct-dict-res-_pvt d) (d:dict-set*! mheq
(struct-dict-res-_kv d))) 'parent parent
(struct struct-dict-res (_kv _pvt) #:transparent
#:methods d:gen:dict
[(define (dict-set! d k v) (d:dict-set! (choose-dict d k) k v))
(define (dict-ref d k [thunk #f])
(define res (d:dict-ref (choose-dict d k) k thunk))
(force res))
(define (dict-remove! d k) (d:dict-remove! (choose-dict d k) k))
;; public keys only
(define (dict-keys d) (d:dict-keys (struct-dict-res-_kv d)))
(define (dict-iterate-first d) (and (pair? (dict-keys d)) 0))
(define (dict-iterate-next d i) (and (< (add1 i) (length (dict-keys d))) (add1 i)))
(define (dict-iterate-key d i) (list-ref (dict-keys d) i))
(define (dict-iterate-value d i) (dict-ref d (dict-iterate-key d i)))])
(define (+struct-dict-res [_kv (mhasheq)] [_pvt (mhasheq)])
(struct-dict-res _kv _pvt))
(define (_setup port parent len)
(define sdr (+struct-dict-res)) ; not mere hash
(d:dict-set*! sdr 'parent parent
'_startOffset (pos port) '_startOffset (pos port)
'_currentOffset 0 '_currentOffset 0
'_length len) '_length len)
sdr) mheq)
(define (_parse-fields port sdr fields) (define (xstruct-parse-fields port sdr fields-arg)
(define fields (if (xstruct? fields-arg) (xstruct-fields fields-arg) fields-arg))
(unless (assocs? fields) (unless (assocs? fields)
(raise-argument-error '_parse-fields "assocs" fields)) (raise-argument-error 'xstruct-parse-fields "assocs" fields))
(for/fold ([sdr sdr]) (for/fold ([sdr sdr])
([(key type) (d:in-dict fields)]) ([(key type) (d:in-dict fields)])
(define val (if (procedure? type) (define val (if (procedure? type)
@ -63,18 +43,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define (xstruct-xdecode xs [port-arg (current-input-port)] #:parent [parent #f] [len 0]) (define (xstruct-xdecode xs [port-arg (current-input-port)] #:parent [parent #f] [len 0])
(define port (->input-port port-arg)) (define port (->input-port port-arg))
(parameterize ([current-input-port port]) (parameterize ([current-input-port port])
;; _setup and _parse-fields are separate to cooperate with VersionedStruct ;; xstruct-setup and xstruct-parse-fields are separate to cooperate with VersionedStruct
(define res (define decoded-hash
(post-decode xs (post-decode xs
(let* ([sdr (_setup port parent len)] ; returns StructDictRes (let* ([mheq (xstruct-setup port parent len)] ; returns StructDictRes
[sdr (_parse-fields port sdr (xstruct-fields xs))]) [mheq (xstruct-parse-fields port mheq (xstruct-fields xs))])
sdr))) mheq)))
(unless (d:dict? res) (unless (d:dict? decoded-hash)
(raise-result-error 'xstruct-decode "dict" res)) (raise-result-error 'xstruct-decode "dict" decoded-hash))
res)) decoded-hash))
(define/finalize-size (xstruct-size xs [val #f] #:parent [parent-arg #f] (define/finalize-size (xstruct-size xs [val #f] #:parent [parent-arg #f] #:include-pointers [include-pointers #t])
#:include-pointers [include-pointers #t])
(define parent (mhasheq 'parent parent-arg (define parent (mhasheq 'parent parent-arg
'val val 'val val
'pointerSize 0)) 'pointerSize 0))
@ -90,9 +69,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define port (if (output-port? port-arg) port-arg (open-output-bytes))) (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port]) (parameterize ([current-output-port port])
;; check keys first, since `size` also relies on keys being valid ;; check keys first, since `size` also relies on keys being valid
(define val (let* ([val (pre-encode xs val-arg)] (define val (let* ([val (pre-encode xs val-arg)])
#;[val (inner res pre-encode val . args)]) (unless (d:dict? val)
(unless (d:dict? val) (raise-result-error 'xstruct-encode "dict" val)) (raise-result-error 'xstruct-encode "dict" val))
val)) val))
(unless (andmap (λ (key) (memq key (d:dict-keys val))) (d:dict-keys (xstruct-fields xs))) (unless (andmap (λ (key) (memq key (d:dict-keys val))) (d:dict-keys (xstruct-fields xs)))
(raise-argument-error 'xstruct-encode (raise-argument-error 'xstruct-encode

4
xenomorph/xenomorph/test/pointer-test.rkt
Unescape Escape View File

@ -53,8 +53,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
"decode should support decoding pointers lazily" "decode should support decoding pointers lazily"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))]) (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(define res (xdecode (+xstruct 'ptr (+xpointer #:lazy #t)))) (define res (xdecode (+xstruct 'ptr (+xpointer #:lazy #t))))
(check-true (promise? (dict-ref (struct-dict-res-_kv res) 'ptr))) (check-true (promise? (dict-ref res 'ptr)))
(check-equal? (dict-ref res 'ptr) 53))) (check-equal? (force (dict-ref res 'ptr)) 53)))
(test-case (test-case
"size" "size"

31
xenomorph/xenomorph/test/versioned-struct-test.rkt
Unescape Escape View File

@ -6,6 +6,7 @@
"../number.rkt" "../number.rkt"
"../string.rkt" "../string.rkt"
"../pointer.rkt" "../pointer.rkt"
"../struct.rkt"
"../versioned-struct.rkt") "../versioned-struct.rkt")
#| #|
@ -19,7 +20,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
@ -33,7 +34,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")])
@ -46,7 +47,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'header (dictify 'age uint8 'header (dictify 'age uint8
'alive uint8) 'alive uint8)
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb" (check-equal? (decode vstruct) (mhasheq 'name "roxyb"
@ -66,7 +67,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
@ -103,7 +104,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(set-post-decode! vstruct (λ (val) (dict-set! val 'processed "true") val)) (set-post-decode! vstruct (λ (val) (dict-set! val 'processed "true") val))
@ -117,7 +118,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(check-equal? (size vstruct (mhasheq 'name "roxyb" (check-equal? (size vstruct (mhasheq 'name "roxyb"
@ -134,7 +135,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender 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 'version 5))))))
@ -146,7 +147,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'header (dictify 'age uint8 'header (dictify 'age uint8
'alive uint8) 'alive uint8)
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'gender uint8)))]) 'gender uint8)))])
(check-equal? (size struct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 0)) 9) (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 🤘" 'gender 0 'age 21 'alive 1 'version 1)) 15)))
@ -157,7 +158,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'ptr (+xpointer #:offset-type uint8 'ptr (+xpointer #:offset-type uint8
#:type (+xstring uint8)))))]) #:type (+xstring uint8)))))])
@ -172,7 +173,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size vstruct))))) (check-exn exn:fail:contract? (λ () (size vstruct)))))
@ -183,7 +184,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
@ -197,7 +198,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
@ -210,7 +211,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'header (dictify 'age uint8 'header (dictify 'age uint8
'alive uint8) 'alive uint8)
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
(encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 0) op) (encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 0) op)
@ -223,7 +224,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'ptr (+xpointer #:offset-type uint8 'ptr (+xpointer #:offset-type uint8
#:type (+xstring uint8)))))] #:type (+xstring uint8)))))]
@ -238,7 +239,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(dictify (dictify
0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii) 0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8) 1 (+xstruct 'name (+xstring #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])

90
xenomorph/xenomorph/versioned-struct.rkt
Unescape Escape View File

@ -1,4 +1,4 @@
#lang racket/base #lang debug racket/base
(require "helper.rkt" "struct.rkt" (require "helper.rkt" "struct.rkt"
racket/dict racket/dict
sugar/unstable/dict) sugar/unstable/dict)
@ -14,7 +14,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(define/post-decode (xversioned-struct-xdecode xvs [port-arg (current-input-port)] #:parent [parent #f] [length 0]) (define/post-decode (xversioned-struct-xdecode xvs [port-arg (current-input-port)] #:parent [parent #f] [length 0])
(define port (->input-port port-arg)) (define port (->input-port port-arg))
(define res (_setup port parent length)) (define res (xstruct-setup port parent length))
(dict-set! res 'version (dict-set! res 'version
(cond (cond
@ -27,67 +27,67 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[else (xdecode (xversioned-struct-type xvs) port)])) [else (xdecode (xversioned-struct-type xvs) port)]))
(when (dict-ref (xversioned-struct-versions xvs) 'header #f) (when (dict-ref (xversioned-struct-versions xvs) 'header #f)
(_parse-fields port res (dict-ref (xversioned-struct-versions xvs) 'header))) (xstruct-parse-fields port res (dict-ref (xversioned-struct-versions xvs) 'header)))
(define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref res 'version #f) #f) (define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref res 'version #f) #f)
(raise-argument-error 'xversioned-struct-decode "valid version key" (cons version (xversioned-struct-versions xvs))))) (raise-argument-error 'xversioned-struct-decode "valid version key" (cons version (xversioned-struct-versions xvs)))))
(cond (cond
[(xversioned-struct? fields) (xdecode fields port #:parent parent)] [(xversioned-struct? fields) (xdecode fields port #:parent parent)]
[else (_parse-fields port res fields) [else (xstruct-parse-fields port res fields)
res])) res]))
(define (extract-fields-dict xvs val)
(define field-object (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version #f) #f))
(unless field-object
(raise-argument-error 'xversioned-struct-encode "valid version key" version))
(if (xstruct? field-object) (xstruct-fields field-object) field-object))
(define/finalize-size (xversioned-struct-size xvs [val #f] #:parent [parent-arg #f] [include-pointers #t]) (define/finalize-size (xversioned-struct-size xvs [val #f] #:parent [parent-arg #f] [include-pointers #t])
(unless val (unless val
(raise-argument-error 'xversioned-struct-size "value" val)) (raise-argument-error 'xversioned-struct-size "value" val))
(define parent (mhash 'parent parent-arg 'val val 'pointerSize 0)) (define parent (mhash 'parent parent-arg 'val val 'pointerSize 0))
(define version-size (define version-size
(if (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))) (let ([struct-type (xversioned-struct-type xvs)])
(size (xversioned-struct-type xvs) (dict-ref val 'version) #:parent parent) (if (or (symbol? struct-type) (procedure? struct-type))
0)) 0
(size (xversioned-struct-type xvs) (dict-ref val 'version) #:parent parent))))
(define header-size (define header-size
(for/sum ([(key type) (in-dict (or (dict-ref (xversioned-struct-versions xvs) 'header #f) null))]) (for/sum ([(key type) (in-dict (or (dict-ref (xversioned-struct-versions xvs) 'header #f) null))])
(size type (and val (dict-ref val key)) #:parent parent))) (size type (and val (dict-ref val key)) #:parent parent)))
(define fields-size (define fields-size
(let ([fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version)) (for/sum ([(key type) (in-dict (extract-fields-dict xvs val))])
(raise-argument-error 'xversioned-struct-size "valid version key" version))]) (size type (and val (dict-ref val key)) #:parent parent)))
(for/sum ([(key type) (in-dict fields)])
(size type (and val (dict-ref val key)) #:parent parent))))
(define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0)) (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0))
(+ version-size header-size fields-size pointer-size)) (+ version-size header-size fields-size pointer-size))
(define/pre-encode (xversioned-struct-encode xvs val [port-arg (current-output-port)] #:parent [parent-arg #f]) (define/pre-encode (xversioned-struct-encode xvs encode-me [port-arg (current-output-port)]
#:parent [parent-arg #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes))) (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port]) (parameterize ([current-output-port port])
(unless (dict? val) (unless (dict? encode-me)
(raise-argument-error 'xversioned-struct-encode "dict" val)) (raise-argument-error 'xversioned-struct-encode "dict" encode-me))
(define parent (mhash 'pointers null
(define parent (mhash 'pointers null 'startOffset (pos port)
'startOffset (pos port) 'parent parent-arg
'parent parent-arg 'val encode-me
'val val 'pointerSize 0))
'pointerSize 0)) (dict-set! parent 'pointerOffset (+ (pos port) (xversioned-struct-size xvs encode-me #:parent parent #f)))
(dict-set! parent 'pointerOffset (+ (pos port) (xversioned-struct-size xvs val #:parent parent #f))) (unless (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))
(encode (xversioned-struct-type xvs) (dict-ref encode-me 'version #f)))
(when (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))) (define maybe-header-dict (dict-ref (xversioned-struct-versions xvs) 'header #f))
(encode (xversioned-struct-type xvs) (dict-ref val 'version #f))) (when maybe-header-dict
(for ([(key type) (in-dict maybe-header-dict)])
(when (dict-ref (xversioned-struct-versions xvs) 'header #f) (encode type (dict-ref encode-me key) #:parent parent)))
(for ([(key type) (in-dict (dict-ref (xversioned-struct-versions xvs) 'header))])
(encode type (dict-ref val key) #:parent parent))) (define fields (extract-fields-dict xvs encode-me))
(unless (andmap (λ (key) (member key (dict-keys encode-me))) (dict-keys fields))
(define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version #f)) (raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys encode-me)))
(raise-argument-error 'xversioned-struct-encode "valid version key" version))) (for ([(key type) (in-dict fields)])
(encode type (dict-ref encode-me key) #:parent parent))
(unless (andmap (λ (key) (member key (dict-keys val))) (dict-keys fields)) (for ([ptr (in-list (dict-ref parent 'pointers))])
(raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val))) (encode (dict-ref ptr 'type) (dict-ref ptr 'val) #:parent (dict-ref ptr 'parent)))
(unless port-arg (get-output-bytes port))))
(for ([(key type) (in-dict fields)])
(encode type (dict-ref val key) #:parent parent))
(for ([ptr (in-list (dict-ref parent 'pointers))])
(encode (dict-ref ptr 'type) (dict-ref ptr 'val) #:parent (dict-ref ptr 'parent)))
(unless port-arg (get-output-bytes port))))
(struct xversioned-struct structish (type versions version-getter version-setter) #:transparent #:mutable (struct xversioned-struct structish (type versions version-getter version-setter) #:transparent #:mutable
#:methods gen:xenomorphic #:methods gen:xenomorphic
@ -98,7 +98,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(define (+xversioned-struct type [versions (dictify)]) (define (+xversioned-struct type [versions (dictify)])
(unless (for/or ([proc (list integer? procedure? xenomorphic? symbol?)]) (unless (for/or ([proc (list integer? procedure? xenomorphic? symbol?)])
(proc type)) (proc type))
(raise-argument-error '+xversioned-struct "integer, procedure, symbol, or xenomorphic" type)) (raise-argument-error '+xversioned-struct "integer, procedure, symbol, or xenomorphic" type))
(unless (and (dict? versions) (andmap (λ (v) (or (dict? v) (structish? v))) (dict-values versions))) (unless (and (dict? versions) (andmap (λ (v) (or (dict? v) (structish? v))) (dict-values versions)))
(raise-argument-error '+xversioned-struct "dict of dicts or structish" versions)) (raise-argument-error '+xversioned-struct "dict of dicts or structish" versions))

Write Preview
Loading…
Cancel
Save