From 1b5f1d998624d5513b1dfd3c39c46eafbd566c31 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 12 Jun 2017 12:27:06 -0700 Subject: [PATCH] next: back to tables --- pitfall/fontkit/directory.rkt | 4 +-- pitfall/fontkit/loca.rkt | 3 +- pitfall/restructure/number.rkt | 26 ++++++++--------- pitfall/restructure/sizes.rkt | 40 ++++++++++++------------- pitfall/restructure/struct.rkt | 53 +++++++++++++++++++--------------- pitfall/sugar/dict.rkt | 2 ++ 6 files changed, 67 insertions(+), 61 deletions(-) diff --git a/pitfall/fontkit/directory.rkt b/pitfall/fontkit/directory.rkt index dba5f1f2..0c0de86c 100644 --- a/pitfall/fontkit/directory.rkt +++ b/pitfall/fontkit/directory.rkt @@ -53,12 +53,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js 'tables (+Array TableEntry 'numTables)))) (define (directory-decode ip [options (mhash)]) - (define is (+DecodeStream (port->bytes ip))) - (send Directory decode is)) + (send Directory decode (+DecodeStream (port->bytes ip)))) (test-module - (require racket/serialize) (define ip (open-input-file charter-path)) (check-equal? (directory-decode ip) diff --git a/pitfall/fontkit/loca.rkt b/pitfall/fontkit/loca.rkt index 1e920da9..d6734f78 100644 --- a/pitfall/fontkit/loca.rkt +++ b/pitfall/fontkit/loca.rkt @@ -38,8 +38,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js (λ (parent) (hash-ref (send parent _getTable 'head) 'indexToLocFormat)) (dictify 0 (dictify 'offsets (+Array uint16be)) - 1 (dictify 'offsets (+Array uint32be)) - ))) + 1 (dictify 'offsets (+Array uint32be))))) (test-module diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index fff4b0ed..828eda36 100644 --- a/pitfall/restructure/number.rkt +++ b/pitfall/restructure/number.rkt @@ -12,13 +12,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (equal? (substring str (sub1 (string-length str))) "8")) (define (signed-type? type) - (not (equal? "U" (substring (symbol->string type) 0 1)))) + (not (equal? "u" (substring (symbol->string type) 0 1)))) (test-module - (check-false (signed-type? 'UInt16)) - (check-true (signed-type? 'Int16))) + (check-false (signed-type? 'uint16)) + (check-true (signed-type? 'int16))) -(define-subclass Streamcoder (Number [type 'UInt16] [endian (if (system-big-endian?) 'BE 'LE)]) +(define-subclass Streamcoder (Number [type 'uint16] [endian (if (system-big-endian?) 'be 'le)]) (getter-field [number-type (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))]) @@ -35,7 +35,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define bstr (send stream read _size)) (if (= 1 _size) (bytes-ref bstr 0) - (integer-bytes->integer bstr (signed-type? type) (eq? endian 'BE)))) + (integer-bytes->integer bstr (signed-type? type) (eq? endian 'be)))) (define/augment (encode stream val-in) (define val (if (integer? val-in) (inexact->exact val-in) val-in)) @@ -44,7 +44,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (raise-argument-error 'Number:encode (format "integer that fits in ~a byte(s)" _size) val)) (define bstr (if (= 1 _size) (bytes val) - (integer->integer-bytes val _size (signed-type? type) (eq? endian 'BE)))) + (integer->integer-bytes val _size (signed-type? type) (eq? endian 'be)))) (send stream write bstr))) @@ -55,7 +55,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (check-exn exn:fail:contract? (λ () (send uint16 encode (+EncodeStream) (add1 #xffff)))) (check-not-exn (λ () (send uint16 encode (+EncodeStream) #xffff))) - (let ([o (+Number 'UInt16 'LE)] + (let ([o (+Number 'uint16 'le)] [ip (+DecodeStream (bytes 1 2 3 4))] [op (open-output-bytes)]) (check-equal? (send o decode ip) 513) ;; 1000 0000 0100 0000 @@ -65,7 +65,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (send o encode op 1027) (check-equal? (get-output-bytes op) (bytes 1 2 3 4))) - (let ([o (+Number 'UInt16 'BE)] + (let ([o (+Number 'uint16 'be)] [ip (+DecodeStream (bytes 1 2 3 4))] [op (open-output-bytes)]) (check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000 @@ -77,10 +77,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (test-module - (check-equal? (send (+Number 'UInt8) size) 1) + (check-equal? (send (+Number 'uint8) size) 1) (check-equal? (send (+Number) size) 2) - (check-equal? (send (+Number 'UInt32) size) 4) - (check-equal? (send (+Number 'Double) size) 8)) + (check-equal? (send (+Number 'uint32) size) 4) + (check-equal? (send (+Number 'double) size) 8)) ;; use keys of type-sizes hash to generate corresponding number definitions @@ -88,13 +88,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (with-pattern ([((ID BASE ENDIAN) ...) (for/list ([k (in-hash-keys type-sizes)]) (define kstr (format "~a" k)) (match-define (list* prefix suffix _) - (regexp-split #rx"(?=[BL]E|$)" kstr)) + (regexp-split #rx"(?=[bl]e|$)" kstr)) (map string->symbol (list (string-downcase kstr) prefix (if (positive? (string-length suffix)) suffix - (if (system-big-endian?) "BE" "LE")))))] + (if (system-big-endian?) "be" "le")))))] [(ID ...) (suffix-id #'(ID ...) #:context caller-stx)]) #'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...))) diff --git a/pitfall/restructure/sizes.rkt b/pitfall/restructure/sizes.rkt index ab2a5a31..01963bda 100644 --- a/pitfall/restructure/sizes.rkt +++ b/pitfall/restructure/sizes.rkt @@ -2,34 +2,34 @@ (provide type-sizes get-type-size) (define-values (int-keys byte-values) (for*/lists (int-keys byte-values) - ([signed (in-list '("U" ""))] + ([signed (in-list '("u" ""))] [bit-size (in-list '(8 16 24 32))]) - (values (format "~aInt~a" signed bit-size) (/ bit-size 8)))) + (values (format "~aint~a" signed bit-size) (/ bit-size 8)))) -(define type-sizes (for/hash ([type-key (in-list (append '("Float" "Double") int-keys))] +(define type-sizes (for/hash ([type-key (in-list (append '("float" "double") int-keys))] [byte-value (in-list (append '(4 8) byte-values))] #:when #t - [endian (in-list '("" "BE" "LE"))]) + [endian (in-list '("" "be" "le"))]) (values (string->symbol (string-append type-key endian)) byte-value))) (define (get-type-size key) (hash-ref type-sizes key (λ () (raise-argument-error 'DecodeStream:get-type-size "valid type" key)))) (test-module - (check-equal? (get-type-size 'Int8) 1) - (check-equal? (get-type-size 'UInt8) 1) - (check-equal? (get-type-size 'UInt8BE) 1) - (check-equal? (get-type-size 'Int16) 2) - (check-equal? (get-type-size 'UInt16) 2) - (check-equal? (get-type-size 'UInt16BE) 2) - (check-equal? (get-type-size 'UInt16LE) 2) - (check-equal? (get-type-size 'UInt32) 4) - (check-equal? (get-type-size 'UInt32LE) 4) - (check-equal? (get-type-size 'Int32BE) 4) - (check-equal? (get-type-size 'Float) 4) - (check-equal? (get-type-size 'FloatLE) 4) - (check-equal? (get-type-size 'FloatBE) 4) - (check-equal? (get-type-size 'Double) 8) - (check-equal? (get-type-size 'DoubleLE) 8) - (check-equal? (get-type-size 'DoubleBE) 8) + (check-equal? (get-type-size 'int8) 1) + (check-equal? (get-type-size 'uint8) 1) + (check-equal? (get-type-size 'uint8be) 1) + (check-equal? (get-type-size 'int16) 2) + (check-equal? (get-type-size 'uint16) 2) + (check-equal? (get-type-size 'uint16be) 2) + (check-equal? (get-type-size 'uint16le) 2) + (check-equal? (get-type-size 'uint32) 4) + (check-equal? (get-type-size 'uint32le) 4) + (check-equal? (get-type-size 'int32be) 4) + (check-equal? (get-type-size 'float) 4) + (check-equal? (get-type-size 'floatle) 4) + (check-equal? (get-type-size 'floatbe) 4) + (check-equal? (get-type-size 'double) 8) + (check-equal? (get-type-size 'doublele) 8) + (check-equal? (get-type-size 'doublebe) 8) (check-exn exn:fail:contract? (λ () (get-type-size 'not-a-type)))) \ No newline at end of file diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 16cf06db..5c96e32b 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -8,12 +8,26 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee |# (define-subclass Streamcoder (Struct [assocs (dictify)]) - (unless (dict? assocs) - (raise-argument-error 'Struct "dictionary" assocs)) - (field [key-index (map car assocs)] ; store the original key order + (unless (assocs? assocs) + (raise-argument-error 'Struct "assocs" assocs)) + (field [key-index #f] ; store the original key order [fields (mhash)]) - (for ([(k v) (in-dict assocs)]) - (hash-set! fields k v)) + + (define/private (update-key-index! assocs) + (unless (assocs? assocs) + (raise-argument-error 'Struct "assocs" assocs)) + (set! key-index (map car assocs))) + + (update-key-index! assocs) + + (define/public-final (update-fields! assocs) + (unless (assocs? assocs) + (raise-argument-error 'Struct "assocs or hash" assocs)) + (update-key-index! assocs) + (for ([(k v) (in-dict assocs)]) + (hash-set! fields k v))) + + (update-fields! assocs) (define/augride (decode stream [parent #f] [length 0]) (define res (_setup stream parent length)) @@ -109,8 +123,8 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [(RestructureBase? version-resolver) (send version-resolver decode stream)] [else (raise-argument-error 'VersionedStruct:decode "way of finding version" version-resolver)])) (hash-set! res 'version version) - (set! fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" version)))) - (set! key-index (map car fields)) + (define assocs (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" version)))) + (send this update-fields! assocs) (cond [(VersionedStruct? fields) (send fields decode stream parent)] [else @@ -123,26 +137,19 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42))) ;; make random versioned structs and make sure we can round trip - (for ([i (in-range 1)]) - (define field-types (for/list ([i (in-range 2)]) + (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 2) - (define selector (random num-versions)) - (define versions (for/list ([v (in-range num-versions)]) + (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 selector versions)) - (define size-num-types (for/sum ([num-type (in-list (map cdr (dict-ref versions selector)))]) + (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 size-num-types)]) + (define bs (apply bytes (for/list ([i (in-range struct-size)]) (random 256)))) (define es (+EncodeStream)) - - (send vs encode es (send vs decode bs)) - #| -(check-equal? (send es dump) bs) - - |# - 42 - )) + (check-equal? (send es dump) bs))) diff --git a/pitfall/sugar/dict.rkt b/pitfall/sugar/dict.rkt index c95bbd18..c447bad0 100644 --- a/pitfall/sugar/dict.rkt +++ b/pitfall/sugar/dict.rkt @@ -2,6 +2,8 @@ (require sugar/list) (provide (all-defined-out)) +(define (assoc? x) (and (pair? x) (not (list? x)))) +(define (assocs? xs) (and (list? xs) (andmap assoc? xs))) (define (listify kvs) (for/list ([slice (in-list (slice-at kvs 2))])