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

versioned struct done

Browse Source
main
Matthew Butterick 6 years ago
parent dba2883573
commit a4385f8c13
3 changed files with 307 additions and 325 deletions
Show Stats Download Patch File Download Diff File

3
xenomorph/xenomorph/redo/struct.rkt
Unescape Escape View File

@ -101,7 +101,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(encode (d:dict-ref ptr 'type) (d:dict-ref ptr 'val) port #:parent (d:dict-ref ptr 'parent)))
(unless port-arg (get-output-bytes port)))
(struct xstruct (fields post-decode pre-encode) #:transparent #:mutable
(struct structish () #:transparent)
(struct xstruct structish (fields post-decode pre-encode) #:transparent #:mutable
#:methods gen:xenomorphic
[(define decode xstruct-decode)
(define encode xstruct-encode)

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

@ -1,9 +1,11 @@
#lang debug racket/base
(require rackunit
racket/dict
sugar/unstable/dict
"../helper.rkt"
"../number.rkt"
"../string.rkt"
"../pointer.rkt"
"../versioned-struct.rkt")
#|
@ -14,328 +16,259 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case
"decode should get version from number type"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode vstruct)) '((version . 0) (age . 21) (name . "roxyb"))))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 🤘\x15\x00"))])
(check-equal? (dump (decode vstruct)) '((version . 1) (age . 21) (name . "roxyb 🤘") (gender . 0))))))
#|
; it 'should throw for unknown version', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")])
(check-exn exn:fail:contract? (λ () (decode struct)))))
;
; it 'should support common header block', ->
(let ([struct (+VersionedStruct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+StringT uint8 'ascii))
1 (dictify 'name (+StringT uint8 'utf8)
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb"
'age 21
'alive 1
'version 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 🤘\x00"))])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb 🤘"
'age 21
'version 1
'alive 1
'gender 0))))
; it 'should support parent version key', ->
(let ([struct (+VersionedStruct 'version
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "roxyb"
'age 21
'version 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 🤘\x15\x00"))])
(check-equal? (dump (decode struct #:parent (mhash 'version 1))) (hasheq 'name "roxyb 🤘"
'age 21
'version 1
'gender 0))))
;
; it 'should support sub versioned structs', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8))
1 (dictify 'name (+StringT uint8)
'isDessert uint8)))))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "roxyb"
'age 21
'version 0)))
(parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "pasta"
'version 0)))
(parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "ice cream"
'isDessert 1
'version 1))))
;
; it 'should support process hook', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(set-field! post-decode struct (λ (o stream ctx) (ref-set! o 'processed "true") o))
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb"
'processed "true"
'age 21
'version 0))))
;
; describe 'size', ->
; it 'should compute the correct size', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(check-equal? (size struct (mhasheq 'name "roxyb"
'age 21
'version 0)) 8)
(check-equal? (size struct (mhasheq 'name "roxyb 🤘"
'gender 0
'age 21
'version 1)) 14))
;
; it 'should throw for unknown version', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size struct (mhasheq 'name "roxyb"
'age 21
'version 5)))))
;
; it 'should support common header block', ->
(let ([struct (+VersionedStruct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+StringT uint8 'ascii))
1 (dictify 'name (+StringT uint8 '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))
; it 'should compute the correct size with pointers', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'ptr (+Pointer uint8 (+StringT uint8)))))])
(check-equal? (size struct (mhasheq 'name "roxyb"
'age 21
'version 1
'ptr "hello")) 15))
(test-case
"decode should throw for unknown version"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")])
(check-exn exn:fail:contract? (λ () (decode vstruct))))))
;
; it 'should throw if no value is given', ->
(test-case
"decode should support common header block"
(let ([vstruct (+xversioned-struct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+xstring uint8 'ascii))
1 (dictify 'name (+xstring uint8 'utf8)
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")])
(check-equal? (dump (decode vstruct)) '((version . 0) (name . "roxyb") (age . 21) (alive . 1))))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 🤘\x00"))])
(check-equal? (dump (decode vstruct)) '((version . 1)
(gender . 0)
(name . "roxyb 🤘")
(age . 21)
(alive . 1))))))
(test-case
"decode should support parent version key"
(let ([vstruct (+xversioned-struct 'version
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (dump (decode vstruct #:parent (mhash 'version 0)))
'((version . 0) (age . 21) (name . "roxyb"))))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 🤘\x15\x00"))])
(check-equal? (dump (decode vstruct #:parent (mhash 'version 1)))
'((version . 1) (age . 21) (name . "roxyb 🤘") (gender . 0))))))
(test-case
"decode should support sub versioned structs"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8))
1 (dictify 'name (+xstring uint8)
'isDessert uint8)))))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode vstruct #:parent (mhash 'version 0)))
'((version . 0) (age . 21) (name . "roxyb"))))
(parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")])
(check-equal? (dump (decode vstruct #:parent (mhash 'version 0)))
'((version . 0) (name . "pasta"))))
(parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")])
(check-equal? (dump (decode vstruct #:parent (mhash 'version 0)))
'((version . 1) (isDessert . 1) (name . "ice cream"))))))
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size struct))))
(test-case
"decode should support process hook"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(set-xversioned-struct-post-decode! vstruct (λ (o stream ctx) (dict-set! o 'processed "true") o))
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode vstruct))
'((processed . "true") (version . 0) (age . 21) (name . "roxyb"))))))
(test-case
"size should compute the correct size"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(check-equal? (size vstruct (mhasheq 'name "roxyb"
'age 21
'version 0)) 8)
(check-equal? (size vstruct (mhasheq 'name "roxyb 🤘"
'gender 0
'age 21
'version 1)) 14)))
(test-case
"size should throw for unknown version"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size vstruct (mhasheq 'name "roxyb"
'age 21
'version 5))))))
; describe 'encode', ->
; it 'should encode objects to buffers', (done) ->
(test-case
"size should support common header block"
(let ([struct (+xversioned-struct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+xstring uint8 'ascii))
1 (dictify 'name (+xstring uint8 '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)))
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))]
[port (open-output-bytes)])
(encode struct (mhasheq 'name "roxyb"
'age 21
'version 0) port)
(encode struct (mhasheq 'name "roxyb 🤘"
'age 21
'gender 0
'version 1) port)
(check-equal? (dump port) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00")))
(test-case
"size should compute the correct size with pointers"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'ptr (+xpointer uint8 (+xstring uint8)))))])
(check-equal? (size vstruct (mhasheq 'name "roxyb"
'age 21
'version 1
'ptr "hello")) 15)))
(test-case
"size should throw if no value is given"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size vstruct)))))
;
; it 'should throw for unknown version', ->
(test-case
"encode should encode objects to buffers"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'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)
(check-equal? (dump op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00"))))
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))]
[port (open-output-bytes)])
(check-exn exn:fail:contract? (λ () (encode struct port (mhasheq 'name "roxyb"
(test-case
"encode should throw for unknown version"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))]
[op (open-output-bytes)])
(check-exn exn:fail:contract? (λ () (encode vstruct op (mhasheq 'name "roxyb"
'age 21
'version 5)))))
; it 'should support common header block', (done) ->
(let ([struct (+VersionedStruct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+StringT uint8 'ascii))
1 (dictify 'name (+StringT uint8 'utf8)
'gender uint8)))]
[stream (open-output-bytes)])
(encode struct (mhasheq 'name "roxyb"
'age 21
'alive 1
'version 0) stream)
(encode struct (mhasheq 'name "roxyb 🤘"
'gender 0
'age 21
'alive 1
'version 1) stream)
(check-equal? (dump stream) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 🤘\x00")))
; it 'should encode pointer data after structure', (done) ->
'version 5))))))
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'ptr (+Pointer uint8 (+StringT uint8)))))]
[stream (open-output-bytes)])
(encode struct (mhasheq 'version 1
'name "roxyb"
'age 21
'ptr "hello") stream)
(check-equal? (dump stream) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello")))
; it 'should support preEncode hook', (done) ->
(test-case
"encode should support common header block"
(let ([vstruct (+xversioned-struct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+xstring uint8 'ascii))
1 (dictify 'name (+xstring uint8 '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)
(check-equal? (dump op) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 🤘\x00"))))
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))]
[stream (open-output-bytes)])
(set-field! pre-encode struct (λ (val port) (ref-set! val 'version (if (ref val 'gender) 1 0)) val))
(encode struct (mhasheq 'name "roxyb"
'age 21
'version 0) stream)
(encode struct (mhasheq 'name "roxyb 🤘"
'age 21
'gender 0) stream)
(check-equal? (dump stream) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00")))
(test-case
"encode should encode pointer data after structure"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'ptr (+xpointer uint8 (+xstring uint8)))))]
[op (open-output-bytes)])
(encode vstruct (mhasheq 'version 1
'name "roxyb"
'age 21
'ptr "hello") op)
(check-equal? (dump op) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello"))))
|#
(test-case
"encode should support preEncode hook"
(let ([vstruct (+xversioned-struct uint8
(dictify
0 (dictify 'name (+xstring uint8 'ascii)
'age uint8)
1 (dictify 'name (+xstring uint8 'utf8)
'age uint8
'gender uint8)))]
[stream (open-output-bytes)])
(set-xversioned-struct-pre-encode! vstruct
(λ (val port) (dict-set! val 'version (if (dict-ref val 'gender #f) 1 0)) val))
(encode vstruct (mhasheq 'name "roxyb"
'age 21
'version 0) stream)
(encode vstruct (mhasheq 'name "roxyb 🤘"
'age 21
'gender 0) stream)
(check-equal? (dump stream) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00"))))

86
xenomorph/xenomorph/redo/versioned-struct.rkt
Unescape Escape View File

@ -14,13 +14,13 @@ https://github.com/mbuttrackerick/restructure/blob/master/src/VersionedStruct.co
(define res (_setup port parent length))
(dict-set! res 'version
(cond
#;[forced-version] ; for testing purposes: pass an explicit version
[(or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))
(unless parent
(raise-argument-error 'xversioned-struct-decode "valid parent" parent))
((xversioned-struct-version-getter xvs) parent)]
[else (decode (xversioned-struct-type xvs) port)]))
(cond
#;[forced-version] ; for testing purposes: pass an explicit version
[(or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))
(unless parent
(raise-argument-error 'xversioned-struct-decode "valid parent" parent))
((xversioned-struct-version-getter xvs) parent)]
[else (decode (xversioned-struct-type xvs) port)]))
(when (dict-ref (xversioned-struct-versions xvs) 'header #f)
(_parse-fields port res (dict-ref (xversioned-struct-versions xvs) 'header)))
@ -28,20 +28,66 @@ https://github.com/mbuttrackerick/restructure/blob/master/src/VersionedStruct.co
(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)))))
(cond
[(xversioned-struct? fields) (decode fields port #:parent parent)]
[else (_parse-fields port res fields)
res]))
(define (xversioned-struct-size xvs [val #f] [parent #f])
42)
((xversioned-struct-post-decode xvs)
(cond
[(xversioned-struct? fields) (decode fields port #:parent parent)]
[else (_parse-fields port res fields)
res]) port parent))
(define (xversioned-struct-size xvs [val #f] [parent #f] [include-pointers #t])
(unless val
(raise-argument-error 'xversioned-struct-size "value" val))
(define ctx (mhash 'parent parent 'val val 'pointerSize 0))
(define version-size
(if (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs))))
(size (xversioned-struct-type xvs) (dict-ref val 'version) ctx)
0))
(define header-size
(for/sum ([(key type) (in-dict (or (dict-ref (xversioned-struct-versions xvs) 'header #f) null))])
(size type (and val (dict-ref val key)) ctx)))
(define fields-size
(let ([fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version))
(raise-argument-error 'xversioned-struct-size "valid version key" version))])
(for/sum ([(key type) (in-dict fields)])
(size type (and val (dict-ref val key)) ctx))))
(define pointer-size (if include-pointers (dict-ref ctx 'pointerSize) 0))
(+ version-size header-size fields-size pointer-size))
(define (xversioned-struct-encode xvs val-arg [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
42
(define val ((xversioned-struct-pre-encode xvs) val-arg port))
(unless (dict? val)
(raise-argument-error 'xversioned-struct-encode "dict" val))
(define ctx (mhash 'pointers null
'startOffset (pos port)
'parent parent
'val val
'pointerSize 0))
(dict-set! ctx 'pointerOffset (+ (pos port) (xversioned-struct-size xvs val ctx #f)))
(when (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs))))
(encode (xversioned-struct-type xvs) (dict-ref val 'version #f) port))
(when (dict-ref (xversioned-struct-versions xvs) 'header #f)
(for ([(key type) (in-dict (dict-ref (xversioned-struct-versions xvs) 'header))])
(encode type (dict-ref val key) port #:parent ctx)))
(define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version #f))
(raise-argument-error 'xversioned-struct-encode "valid version key" version)))
(unless (andmap (λ (key) (member key (dict-keys val))) (dict-keys fields))
(raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val)))
(for ([(key type) (in-dict fields)])
(encode type (dict-ref val key) port #:parent ctx))
(for ([ptr (in-list (dict-ref ctx 'pointers))])
(encode (dict-ref ptr 'type) (dict-ref ptr 'val) port #:parent (dict-ref ptr 'parent)))
(unless port-arg (get-output-bytes port)))
(struct xversioned-struct (type versions version-getter version-setter) #:transparent
(struct xversioned-struct structish (type versions version-getter version-setter pre-encode post-decode) #:transparent #:mutable
#:methods gen:xenomorphic
[(define decode xversioned-struct-decode)
(define encode xversioned-struct-encode)
@ -51,15 +97,17 @@ https://github.com/mbuttrackerick/restructure/blob/master/src/VersionedStruct.co
(unless (for/or ([proc (list integer? procedure? xenomorphic? 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 xstructs" 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))
(define version-getter (cond
[(procedure? type) type]
[(symbol? type) (λ (parent) (dict-ref parent type))]))
(define version-setter (cond
[(procedure? type) type]
[(symbol? type) (λ (parent version) (dict-set! parent type version))]))
(xversioned-struct type versions version-getter version-setter))
(define (no-op-pre-encode val port) val)
(define (no-op-post-decode xvs port ctx) xvs)
(xversioned-struct type versions version-getter version-setter no-op-pre-encode no-op-post-decode))
#|
(define-subclass Struct (VersionedStruct type [versions (dictify)])

Write Preview
Loading…
Cancel
Save