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

reimplement struct with gen:dict

Browse Source
main
Matthew Butterick 7 years ago
parent e568b4bfaa
commit 9222ec6b0c
3 changed files with 42 additions and 39 deletions
Show Stats Download Patch File Download Diff File

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

@ -22,7 +22,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(let ([stream (+DecodeStream (+Buffer "\x05devon\x15"))] (let ([stream (+DecodeStream (+Buffer "\x05devon\x15"))]
[struct (+Struct (dictify 'name (+StringT uint8) [struct (+Struct (dictify 'name (+StringT uint8)
'age uint8))]) 'age uint8))])
(check-equal? (send (send struct decode stream) ht) (check-equal? (send (send struct decode stream) kv)
(mhasheq 'name "devon" 'age 21))) (mhasheq 'name "devon" 'age 21)))
@ -45,7 +45,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
[struct (+Struct (dictify 'name (+StringT uint8) [struct (+Struct (dictify 'name (+StringT uint8)
'age uint8))]) 'age uint8))])
(set-field! process struct (λ (o stream) (ref-set! o 'canDrink (>= (ref o 'age) 21)))) (set-field! process struct (λ (o stream) (ref-set! o 'canDrink (>= (ref o 'age) 21))))
(check-equal? (send (send struct decode stream) ht) (check-equal? (send (send struct decode stream) kv)
(mhasheq 'name "devon" 'age 32 'canDrink #t))) (mhasheq 'name "devon" 'age 32 'canDrink #t)))
@ -66,7 +66,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
[struct (+Struct (dictify 'name (+StringT uint8) [struct (+Struct (dictify 'name (+StringT uint8)
'age uint8 'age uint8
'canDrink (λ (o) (>= (ref o 'age) 21))))]) 'canDrink (λ (o) (>= (ref o 'age) 21))))])
(check-equal? (send (send struct decode stream) ht) (check-equal? (send (send struct decode stream) kv)
(mhasheq 'name "devon" 'age 32 'canDrink #t))) (mhasheq 'name "devon" 'age 32 'canDrink #t)))
@ -152,7 +152,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(let ([stream (+DecodeStream (+Buffer "\x05devon\x15"))] (let ([stream (+DecodeStream (+Buffer "\x05devon\x15"))]
[struct (+Struct (dictify 'name (+StringT uint8) [struct (+Struct (dictify 'name (+StringT uint8)
'age uint8))]) 'age uint8))])
(check-equal? (send (send struct decode stream) ht) (check-equal? (send (send struct decode stream) kv)
(mhasheq 'name "devon" 'age 21))) (mhasheq 'name "devon" 'age 21)))
; ;

53
pitfall/restructure/struct.rkt
Unescape Escape View File

@ -1,33 +1,36 @@
#lang restructure/racket #lang restructure/racket
(require racket/dict "stream.rkt" racket/private/generic-methods racket/struct) (require racket/dict "stream.rkt" racket/private/generic-methods racket/struct)
(provide (all-defined-out)) (provide (all-defined-out))
(require (prefix-in d: racket/dict))
#| #|
approximates approximates
https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
|# |#
(define hashable<%>
(define private-keys '(parent _startOffset _currentOffset _length))
(define dictable<%>
(interface* () (interface* ()
([(generic-property gen:indexable) ([(generic-property gen:dict)
(generic-method-table gen:indexable (generic-method-table gen:dict
(define (ref o i) (or (hash-ref (get-field kv o) i #f) (define (dict-set! d k v) (d:dict-set! (if (memq k private-keys)
(hash-ref (get-field _hash o) i #f))) (get-field pvt d)
(define (ref-set! o i v) (hash-set! (get-field kv o) i v)) (get-field kv d)) k v))
(define (ref-keys o) (hash-keys (get-field kv o))))] (define (dict-ref d k [thunk #f]) (d:dict-ref (if (memq k private-keys)
[(generic-property gen:custom-write) (get-field pvt d)
(generic-method-table gen:custom-write (get-field kv d)) k thunk))
(define (write-proc o port mode) ;; public keys only
(define proc (case mode (define (dict-keys d) (d:dict-keys (get-field kv d))))])))
[(#t) write]
[(#f) display] (define StructDictRes (class* RestructureBase (dictable<%>)
[else (λ (p port) (print p port mode))])) (super-make-object)
(proc (get-field kv o) port)))]))) (field [kv (mhasheq)]
[pvt (mhasheq)])
(define StructRes (class* RestructureBase (hashable<%>) (public [_kv kv])
(super-make-object) (define (_kv) kv)))
(field [kv (mhasheq)])
(define/public (ht) kv)))
(define-subclass Streamcoder (Struct [fields (dictify)]) (define-subclass Streamcoder (Struct [fields (dictify)])
(field [[_process process] void] (field [[_process process] void]
@ -45,8 +48,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
res) res)
(define/public-final (_setup stream parent length) (define/public-final (_setup stream parent length)
(define res (make-object StructRes)) ; not mere hash (define res (make-object StructDictRes)) ; not mere hash
(hash-set*! (· res _hash) 'parent parent (dict-set*! res 'parent parent
'_startOffset (· stream pos) '_startOffset (· stream pos)
'_currentOffset 0 '_currentOffset 0
'_length length) '_length length)
@ -71,7 +74,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
'pointerSize 0)) 'pointerSize 0))
(define size 0) (define size 0)
(for ([(key type) (in-dict fields)]) (for ([(key type) (in-dict fields)])
(increment! size (send type size (ref val key) ctx))) (increment! size (send type size (ref val key) ctx)))
(when includePointers (when includePointers
(increment! size (ref ctx 'pointerSize))) (increment! size (ref ctx 'pointerSize)))
@ -97,10 +100,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(raise-argument-error 'Struct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val))) (raise-argument-error 'Struct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val)))
(for ([(key type) (in-dict fields)]) (for ([(key type) (in-dict fields)])
(send type encode stream (ref val key) ctx)) (send type encode stream (ref val key) ctx))
(for ([ptr (in-list (ref ctx 'pointers))]) (for ([ptr (in-list (ref ctx 'pointers))])
(send (· ptr type) encode stream (· ptr val) (· ptr parent))))) (send (· ptr type) encode stream (· ptr val) (· ptr parent)))))
(test-module (test-module

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

@ -40,12 +40,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))]) 'gender uint8)))])
(let ([stream (+DecodeStream (+Buffer "\x00\x05devon\x15"))]) (let ([stream (+DecodeStream (+Buffer "\x00\x05devon\x15"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon" (check-equal? (send (send struct decode stream) kv) (mhasheq 'name "devon"
'age 21 'age 21
'version 0))) 'version 0)))
(let ([stream (+DecodeStream (+Buffer "\x01\x0adevon 👍\x15\x00"))]) (let ([stream (+DecodeStream (+Buffer "\x01\x0adevon 👍\x15\x00"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍" (check-equal? (send (send struct decode stream) kv) (mhasheq 'name "devon 👍"
'age 21 'age 21
'version 1 'version 1
'gender 0)))) 'gender 0))))
@ -116,13 +116,13 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))]) 'gender uint8)))])
(let ([stream (+DecodeStream (+Buffer "\x00\x15\x01\x05devon"))]) (let ([stream (+DecodeStream (+Buffer "\x00\x15\x01\x05devon"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon" (check-equal? (send (send struct decode stream) kv) (mhasheq 'name "devon"
'age 21 'age 21
'alive 1 'alive 1
'version 0))) 'version 0)))
(let ([stream (+DecodeStream (+Buffer "\x01\x15\x01\x0adevon 👍\x00"))]) (let ([stream (+DecodeStream (+Buffer "\x01\x15\x01\x0adevon 👍\x00"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍" (check-equal? (send (send struct decode stream) kv) (mhasheq 'name "devon 👍"
'age 21 'age 21
'version 1 'version 1
'alive 1 'alive 1
@ -161,12 +161,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))]) 'gender uint8)))])
(let ([stream (+DecodeStream (+Buffer "\x05devon\x15"))]) (let ([stream (+DecodeStream (+Buffer "\x05devon\x15"))])
(check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "devon" (check-equal? (send (send struct decode stream (mhash 'version 0)) kv) (mhasheq 'name "devon"
'age 21 'age 21
'version 0))) 'version 0)))
(let ([stream (+DecodeStream (+Buffer "\x0adevon 👍\x15\x00" 'utf8))]) (let ([stream (+DecodeStream (+Buffer "\x0adevon 👍\x15\x00" 'utf8))])
(check-equal? (send (send struct decode stream (mhash 'version 1)) ht) (mhasheq 'name "devon 👍" (check-equal? (send (send struct decode stream (mhash 'version 1)) kv) (mhasheq 'name "devon 👍"
'age 21 'age 21
'version 1 'version 1
'gender 0)))) 'gender 0))))
@ -213,16 +213,16 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'isDessert uint8)))))]) 'isDessert uint8)))))])
(let ([stream (+DecodeStream (+Buffer "\x00\x05devon\x15"))]) (let ([stream (+DecodeStream (+Buffer "\x00\x05devon\x15"))])
(check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "devon" (check-equal? (send (send struct decode stream (mhash 'version 0)) kv) (mhasheq 'name "devon"
'age 21 'age 21
'version 0))) 'version 0)))
(let ([stream (+DecodeStream (+Buffer "\x01\x00\x05pasta"))]) (let ([stream (+DecodeStream (+Buffer "\x01\x00\x05pasta"))])
(check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "pasta" (check-equal? (send (send struct decode stream (mhash 'version 0)) kv) (mhasheq 'name "pasta"
'version 0))) 'version 0)))
(let ([stream (+DecodeStream (+Buffer "\x01\x01\x09ice cream\x01"))]) (let ([stream (+DecodeStream (+Buffer "\x01\x01\x09ice cream\x01"))])
(check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "ice cream" (check-equal? (send (send struct decode stream (mhash 'version 0)) kv) (mhasheq 'name "ice cream"
'isDessert 1 'isDessert 1
'version 1)))) 'version 1))))
@ -258,7 +258,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))]) 'gender uint8)))])
(set-field! process struct (λ (o stream) (ref-set! o 'processed "true"))) (set-field! process struct (λ (o stream) (ref-set! o 'processed "true")))
(let ([stream (+DecodeStream (+Buffer "\x00\x05devon\x15"))]) (let ([stream (+DecodeStream (+Buffer "\x00\x05devon\x15"))])
(check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon" (check-equal? (send (send struct decode stream) kv) (mhasheq 'name "devon"
'processed "true" 'processed "true"
'age 21 'age 21
'version 0)))) 'version 0))))

Write Preview
Loading…
Cancel
Save