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 8 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"))]
[struct (+Struct (dictify 'name (+StringT uint8)
'age uint8))])
(check-equal? (send (send struct decode stream) ht)
(check-equal? (send (send struct decode stream) kv)
(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)
'age uint8))])
(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)))
@ -66,7 +66,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
[struct (+Struct (dictify 'name (+StringT uint8)
'age uint8
'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)))
@ -152,7 +152,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(let ([stream (+DecodeStream (+Buffer "\x05devon\x15"))]
[struct (+Struct (dictify 'name (+StringT uint8)
'age uint8))])
(check-equal? (send (send struct decode stream) ht)
(check-equal? (send (send struct decode stream) kv)
(mhasheq 'name "devon" 'age 21)))
;

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

@ -1,33 +1,36 @@
#lang restructure/racket
(require racket/dict "stream.rkt" racket/private/generic-methods racket/struct)
(provide (all-defined-out))
(require (prefix-in d: racket/dict))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
|#
(define hashable<%>
(define private-keys '(parent _startOffset _currentOffset _length))
(define dictable<%>
(interface* ()
([(generic-property gen:indexable)
(generic-method-table gen:indexable
(define (ref o i) (or (hash-ref (get-field kv o) i #f)
(hash-ref (get-field _hash o) i #f)))
(define (ref-set! o i v) (hash-set! (get-field kv o) i v))
(define (ref-keys o) (hash-keys (get-field kv o))))]
[(generic-property gen:custom-write)
(generic-method-table gen:custom-write
(define (write-proc o port mode)
(define proc (case mode
[(#t) write]
[(#f) display]
[else (λ (p port) (print p port mode))]))
(proc (get-field kv o) port)))])))
(define StructRes (class* RestructureBase (hashable<%>)
(super-make-object)
(field [kv (mhasheq)])
(define/public (ht) kv)))
([(generic-property gen:dict)
(generic-method-table gen:dict
(define (dict-set! d k v) (d:dict-set! (if (memq k private-keys)
(get-field pvt d)
(get-field kv d)) k v))
(define (dict-ref d k [thunk #f]) (d:dict-ref (if (memq k private-keys)
(get-field pvt d)
(get-field kv d)) k thunk))
;; public keys only
(define (dict-keys d) (d:dict-keys (get-field kv d))))])))
(define StructDictRes (class* RestructureBase (dictable<%>)
(super-make-object)
(field [kv (mhasheq)]
[pvt (mhasheq)])
(public [_kv kv])
(define (_kv) kv)))
(define-subclass Streamcoder (Struct [fields (dictify)])
(field [[_process process] void]
@ -45,8 +48,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
res)
(define/public-final (_setup stream parent length)
(define res (make-object StructRes)) ; not mere hash
(hash-set*! (· res _hash) 'parent parent
(define res (make-object StructDictRes)) ; not mere hash
(dict-set*! res 'parent parent
'_startOffset (· stream pos)
'_currentOffset 0
'_length length)
@ -71,7 +74,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
'pointerSize 0))
(define size 0)
(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
(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)))
(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))])
(send (· ptr type) encode stream (· ptr val) (· ptr parent)))))
(send (· ptr type) encode stream (· ptr val) (· ptr parent)))))
(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)))])
(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
'version 0)))
(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
'version 1
'gender 0))))
@ -116,13 +116,13 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))])
(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
'alive 1
'version 0)))
(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
'version 1
'alive 1
@ -161,12 +161,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))])
(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
'version 0)))
(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
'version 1
'gender 0))))
@ -213,16 +213,16 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'isDessert uint8)))))])
(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
'version 0)))
(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)))
(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
'version 1))))
@ -258,7 +258,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))])
(set-field! process struct (λ (o stream) (ref-set! o 'processed "true")))
(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"
'age 21
'version 0))))

Write Preview
Loading…
Cancel
Save