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

resume in subversioned structs

Browse Source
main
Matthew Butterick 7 years ago
parent 61d3f26093
commit 1192f7692e
4 changed files with 171 additions and 71 deletions
Show Stats Download Patch File Download Diff File

3
pitfall/restructure/generic.rkt
Unescape Escape View File

@ -16,6 +16,9 @@
([hash? (define ref hash-ref)
(define ref-set! hash-set!)
(define ref-keys hash-keys)]
[dict? (define ref dict-ref)
(define ref-set! dict-set!)
(define ref-keys dict-keys)]
[object? (define (ref o i) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i))]) (dynamic-get-field i o)))
(define (ref-set! o i v) (with-handlers ([exn:fail:object? (λ (exn) (hash-set! (get-field _hash o) i v))]) (dynamic-set-field! i o v)))
(define (ref-keys o) (append (remove '_hash (field-names o)) (hash-keys (get-field _hash o))))]))

2
pitfall/restructure/main.rkt
Unescape Escape View File

@ -3,6 +3,7 @@
(r+p "base.rkt"
"number.rkt"
"struct.rkt"
"versioned-struct.rkt"
"string.rkt"
"array.rkt"
"lazy-array.rkt"
@ -14,6 +15,7 @@
(test-module
(require "number-test.rkt"
"struct-test.rkt"
"versioned-struct-test.rkt"
"string-test.rkt"
"array-test.rkt"
"lazy-array-test.rkt"

78
pitfall/restructure/versioned-struct-test.rkt
Unescape Escape View File

@ -30,6 +30,28 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
; name: 'devon 👍'
; age: 21
; gender: 0
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(let ([stream (+DecodeStream (+Buffer "\u0000\u0005devon\u0015"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon"
'age 21
'version 0)))
(let ([stream (+DecodeStream (+Buffer "\u0001\u000adevon 👍\u0015\u0000"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍"
'age 21
'version 1
'gender 0))))
;
; it 'should throw for unknown version', ->
; struct = new VersionedStruct uint8,
@ -44,6 +66,19 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
; stream = new DecodeStream new Buffer '\x05\x05devon\x15'
; should.throw ->
; struct.decode(stream)
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(let ([stream (+DecodeStream (+Buffer "\u0005\u0005devon\u0015"))])
(check-exn exn:fail:contract? (λ () (send struct decode stream)))))
;
; it 'should support common header block', ->
; struct = new VersionedStruct uint8,
@ -70,6 +105,29 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
; alive: 1
; name: 'devon 👍'
; gender: 0
(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)))])
(let ([stream (+DecodeStream (+Buffer "\u0000\u0015\u0001\u0005devon"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon"
'age 21
'alive 1
'version 0)))
(let ([stream (+DecodeStream (+Buffer "\u0001\u0015\u0001\u000adevon 👍\u0000"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍"
'age 21
'version 1
'alive 1
'gender 0))))
;
; it 'should support parent version key', ->
; struct = new VersionedStruct 'version',
@ -93,6 +151,26 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
; name: 'devon 👍'
; age: 21
; gender: 0
(let ([struct (+VersionedStruct 'version
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(let ([stream (+DecodeStream (+Buffer "\u0005devon\u0015"))])
(check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "devon"
'age 21
'version 0)))
(let ([stream (+DecodeStream (+Buffer "\u000adevon 👍\u0015\u0000" 'utf8))])
(check-equal? (send (send struct decode stream (mhash 'version 1)) ht) (mhasheq 'name "devon 👍"
'age 21
'version 1
'gender 0))))
;
; it 'should support sub versioned structs', ->
; struct = new VersionedStruct uint8,

159
pitfall/restructure/versioned-struct.rkt
Unescape Escape View File

@ -8,45 +8,47 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
|#
(define-subclass Struct (VersionedStruct type [versions (dictify)])
(unless ((disjoin integer? procedure? RestructureBase? symbol?) type)
(raise-argument-error 'VersionedStruct "integer, function, symbol, or Restructure object" type))
(unless (and (dict? versions) (andmap (λ (val) (or (dict? val) (Struct? val))) (map cdr versions)))
(raise-argument-error 'VersionedStruct "dict of dicts or Structs" versions))
(inherit _setup _parseFields process)
(inherit-field fields)
(field [forced-version #f])
(define/public-final (force-version! version)
(set! forced-version version))
(field [forced-version #f]
[versionGetter void]
[versionSetter void])
(when (symbol? type) ; instead of string
(set-field! versionGetter this (λ (parent) (ref parent type)))
(set-field! versionSetter this (λ (parent version) (ref-set! parent type version))))
(define/public (resolve-version [stream #f] [parent #f])
(cond
[forced-version] ; for testing purposes: pass an explicit version
[(integer? type) type]
[(symbol? type)
;; find the first Struct in the chain of ancestors
;; with the target key
(let loop ([x parent])
(cond
[(and x (Struct? x) (dict-ref (· x res) type #f))]
[(· x parent) => loop]
[else #f]))]
[(and (procedure? type) (positive? (procedure-arity type))) (type parent)]
[(RestructureBase? type) (send type decode stream)]
[else (raise-argument-error 'VersionedStruct:resolve-version "way of finding version" type)]))
(define/override (decode stream [parent #f] [length 0])
(set! res (send this _setup stream parent length))
(report res 'versioned-struct-res)
(define version (resolve-version stream parent))
(hash-set! res 'version version)
(define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions))))))
(define res (_setup stream parent length))
(ref-set! res 'version
(cond
[forced-version] ; for testing purposes: pass an explicit version
[(symbol? type) (unless parent
(raise-argument-error 'VersionedStruct:decode "valid parent" parent))
(versionGetter parent)]
[else (send type decode stream)]))
(when (dict-ref versions 'header #f)
(_parseFields stream res (ref versions 'header)))
(define fields (dict-ref versions (ref res 'version) (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions))))))
(cond
[(VersionedStruct? fields) (send fields decode stream parent)]
[else
(report res 'whatigot)
(send this _parseFields stream res fields)
(send this process res stream)
(_parseFields stream res fields)
(process res stream)
res]))
(define/public-final (force-version! version)
(set! forced-version version))
(define/override (encode stream input-hash [parent #f])
(unless (hash? input-hash)
@ -66,49 +68,64 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[else (send fields encode stream input-hash parent)]))
(define/override (size [input-hash (mhash)] [parent #f] [includePointers #t])
(when (and (not input-hash) (not forced-version))
(define/override (size [val (mhash)] [parent #f] [includePointers #t])
(unless (or val forced-version)
(error 'VersionedStruct-cannot-compute-size))
(define version (resolve-version #f parent))
(define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:size "valid version key" version))))
(cond
[(dict? fields)
(for/sum ([(key type) (in-dict fields)])
(define val (hash-ref input-hash key #f))
(define args (if val (list val) empty))
(send type size . args))]
[else (send fields size input-hash parent includePointers)])))
(test-module
(require "number.rkt")
(define (random-pick xs) (list-ref xs (random (length xs))))
(check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42)))
;; make random versioned structs and make sure we can round trip
(for ([i (in-range 20)])
(define field-types (for/list ([i (in-range 200)])
(random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
(define num-versions 20)
(define which-struct (random num-versions))
(define struct-versions (for/list ([v (in-range num-versions)])
(cons v (for/list ([num-type (in-list field-types)])
(cons (gensym) num-type)))))
(define vs (+VersionedStruct which-struct struct-versions))
(define struct-size (for/sum ([num-type (in-list (map cdr (dict-ref struct-versions which-struct)))])
(send num-type size)))
(define bs (apply bytes (for/list ([i (in-range struct-size)])
(random 256))))
(check-equal? (send vs encode #f (send vs decode bs)) bs))
(define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
(check-equal? (send s size) 3)
(define vs (+VersionedStruct (λ (p) 2) (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s))))
(check-equal? (send vs size) 6)
(define s2 (+Struct (dictify 'a vs)))
(check-equal? (send s2 size) 6)
(define vs2 (+VersionedStruct (λ (p) 2) (dictify 1 vs 2 vs)))
(check-equal? (send vs2 size) 6)
)
(define ctx (mhash 'parent parent
'val val
'pointerSize 0))
(define size 0)
(when (not (string? type))
(increment! size (send type size (ref val 'version) ctx)))
(when (ref versions 'header)
(increment! size
(for/sum ([(key type) (in-dict (ref versions 'header))])
(send type size (ref val key) ctx))))
(define fields (dict-ref versions (ref val 'version) (λ () (raise-argument-error 'VersionedStruct:encode "valid version key" version))))
(increment! size
(for/sum ([(key type) (in-dict (ref versions 'header))])
(send type size (ref val key) ctx)))
(when includePointers
(increment! size (ref ctx 'pointerSize)))
size))
#;(test-module
(require "number.rkt")
(define (random-pick xs) (list-ref xs (random (length xs))))
(check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42)))
;; make random versioned structs and make sure we can round trip
(for ([i (in-range 20)])
(define field-types (for/list ([i (in-range 200)])
(random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
(define num-versions 20)
(define which-struct (random num-versions))
(define struct-versions (for/list ([v (in-range num-versions)])
(cons v (for/list ([num-type (in-list field-types)])
(cons (gensym) num-type)))))
(define vs (+VersionedStruct which-struct struct-versions))
(define struct-size (for/sum ([num-type (in-list (map cdr (dict-ref struct-versions which-struct)))])
(send num-type size)))
(define bs (apply bytes (for/list ([i (in-range struct-size)])
(random 256))))
(check-equal? (send vs encode #f (send vs decode bs)) bs))
(define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
(check-equal? (send s size) 3)
(define vs (+VersionedStruct (λ (p) 2) (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s))))
(check-equal? (send vs size) 6)
(define s2 (+Struct (dictify 'a vs)))
(check-equal? (send s2 size) 6)
(define vs2 (+VersionedStruct (λ (p) 2) (dictify 1 vs 2 vs)))
(check-equal? (send vs2 size) 6)
)

Write Preview
Loading…
Cancel
Save