From 9222ec6b0c979e1e344dedbd0ef3b58fe4c9778e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 30 Jun 2017 11:23:01 -0700 Subject: [PATCH] reimplement struct with gen:dict --- pitfall/restructure/struct-test.rkt | 8 +-- pitfall/restructure/struct.rkt | 53 ++++++++++--------- pitfall/restructure/versioned-struct-test.rkt | 20 +++---- 3 files changed, 42 insertions(+), 39 deletions(-) diff --git a/pitfall/restructure/struct-test.rkt b/pitfall/restructure/struct-test.rkt index 791cfc63..a1b3052a 100644 --- a/pitfall/restructure/struct-test.rkt +++ b/pitfall/restructure/struct-test.rkt @@ -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))) ; diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 4e8e8a4b..73e97d65 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -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 diff --git a/pitfall/restructure/versioned-struct-test.rkt b/pitfall/restructure/versioned-struct-test.rkt index 2b080ce5..9644768c 100644 --- a/pitfall/restructure/versioned-struct-test.rkt +++ b/pitfall/restructure/versioned-struct-test.rkt @@ -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))))