next: back to tables

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)

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

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)) ...)))
                                                             

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))))

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)))

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))])