continue cleanup

pitfall/fontkit/directory.rkt

@@ -7,13 +7,13 @@
 https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
 |#
 
-(define TableEntry (make-object RStruct
-                     (dictify 'tag (make-object RString 4)
+(define TableEntry (make-object Struct
+                     (dictify 'tag (+String 4)
                               'checkSum uint32be
                               'offset uint32be
                               'length uint32be)))
 
-(define-subclass RStruct (RDirectory)
+(define-subclass Struct (RDirectory)
   (define/override (process this-res stream)
     ;; in `restructure` `process` method, `res` is aliased as `this`
     (define new-tables-val (mhash))
@@ -45,15 +45,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
       
 
 (define Directory (make-object RDirectory
-                    (dictify 'tag (make-object RString 4)
+                    (dictify 'tag (+String 4)
                              'numTables uint16be
                              'searchRange uint16be
                              'entrySelector uint16be
                              'rangeShift uint16be
-                             'tables (make-object RArray TableEntry 'numTables))))
+                             'tables (+Array TableEntry 'numTables))))
 
 (define (directory-decode ip [options (mhash)])
-  (define is (make-object RDecodeStream (port->bytes ip)))
+  (define is (+DecodeStream (port->bytes ip)))
   (send Directory decode is))
 
 

pitfall/fontkit/fpgm.rkt

@@ -11,11 +11,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/fpgm.js
 ;; is for the definition of functions that are used in many different glyph programs.
 
 
-(define-subclass RStruct (Rfpgm))
+(define-subclass Struct (fpgm%))
 
-(define fpgm (make-object Rfpgm
+(define fpgm (make-object fpgm%
                (dictify
-                'instructions (make-object RArray uint8))))
+                'instructions (make-object Array uint8))))
 
 
 

pitfall/fontkit/head.rkt

@@ -7,7 +7,7 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js
 |#
 
-(define-subclass RStruct (Rhead))
+(define-subclass Struct (Rhead))
 
 (define head (make-object Rhead
                (dictify
@@ -17,13 +17,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js
                 'magicNumber        uint32be                  ;; set to 0x5F0F3CF5
                 'flags              uint16be
                 'unitsPerEm         uint16be                  ;; range from 64 to 16384
-                'created            (make-object RArray int32be 2)
-                'modified           (make-object RArray int32be 2)
+                'created            (+Array int32be 2)
+                'modified           (+Array int32be 2)
                 'xMin               int16be                   ;; for all glyph bounding boxes
                 'yMin               int16be                   ;; for all glyph bounding boxes
                 'xMax               int16be                   ;; for all glyph bounding boxes
                 'yMax               int16be                   ;; for all glyph bounding boxes
-                'macStyle           (make-object RBitfield uint16be '(bold italic underline outline shadow condensed extended))
+                'macStyle           (+Bitfield uint16be '(bold italic underline outline shadow condensed extended))
                 'lowestRecPPEM      uint16be                  ;; smallest readable size in pixels
                 'fontDirectionHint  int16be
                 'indexToLocFormat   int16be                   ;; 0 for short offsets 1 for long

pitfall/fontkit/hhea.rkt

@@ -2,7 +2,7 @@
 (require restructure)
 (provide (all-defined-out))
 
-(define-subclass RStruct (Rhhea))
+(define-subclass Struct (Rhhea))
 
 (define hhea (make-object Rhhea
                (dictify
@@ -17,7 +17,7 @@
                 'caretSlopeRise       int16be   ;; Used to calculate the slope of the cursor (rise/run); 1 for vertical
                 'caretSlopeRun        int16be   ;; 0 for vertical
                 'caretOffset          int16be   ;; Set to 0 for non-slanted fonts
-                'reserved             (make-object RArray int16be 4)
+                'reserved             (+Array int16be 4)
                 'metricDataFormat     int16be   ;; 0 for current format
                 'numberOfMetrics      uint16be   ;; Number of advance widths in 'hmtx' table
                 )))

pitfall/fontkit/hmtx.rkt

@@ -6,9 +6,9 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js
 |#
 
-(define-subclass RStruct (Rhmtx))
+(define-subclass Struct (Rhmtx))
 
-(define HmtxEntry (make-object RStruct
+(define HmtxEntry (make-object Struct
                (dictify
                 'advance uint16be
                 'bearing uint16be)))

pitfall/fontkit/loca.rkt

@@ -11,7 +11,7 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
 |#
 
-(define-subclass RVersionedStruct (Rloca)
+(define-subclass VersionedStruct (Rloca)
   (define/override (process res stream)
     ;; in `restructure` `process` method, `res` is aliased as `this`
     ;; 
@@ -37,8 +37,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
 (define loca (make-object Rloca
                (λ (parent) (hash-ref (send parent _getTable 'head) 'indexToLocFormat)) 
                (dictify
-                0 (dictify 'offsets (make-object RArray uint16be))
-                1 (dictify 'offsets (make-object RArray uint32be))
+                0 (dictify 'offsets (+Array uint16be))
+                1 (dictify 'offsets (+Array uint32be))
                 )))
 
 

pitfall/fontkit/maxp.rkt

@@ -2,7 +2,7 @@
 (require restructure)
 (provide (all-defined-out))
 
-(define-subclass RStruct (Rmaxp))
+(define-subclass Struct (Rmaxp))
 
 (define maxp (make-object Rmaxp
                (dictify 'version                int32be

pitfall/fontkit/prep.rkt

@@ -6,11 +6,11 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/tables/prep.js
 |#
 
-(define-subclass RStruct (Rprep))
+(define-subclass Struct (Rprep))
 
 (define prep (make-object Rprep
                (dictify
-                'controlValueProgram (make-object RArray uint8))))
+                'controlValueProgram (+Array uint8))))
 
 
 

pitfall/fontkit/tabletest.rkt

@@ -16,7 +16,7 @@
   (define maxp-bytes #"\0\1\0\0\0\345\0f\0\a\0O\0\4\0\1\0\0\0\0\0\n\0\0\2\0\1s\0\2\0\1")
   (set-port-position! ip 0)
   (check-equal? (peek-bytes maxp-length maxp-offset ip) maxp-bytes)
-  (define maxp-data (send maxp decode (make-object RDecodeStream maxp-bytes)))
+  (define maxp-data (send maxp decode (+DecodeStream maxp-bytes)))
   (check-equal? (· maxp-data numGlyphs) 229)
   (check-equal? (· maxp-data version) 65536))
 
@@ -30,7 +30,7 @@
   (define table-bytes #"\0\1\0\0\3\324\377\22\0\0\4\311\377_\377`\4\251\0\1\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\345")
   (set-port-position! ip 0)
   (check-equal? (peek-bytes length offset ip) table-bytes)
-  (define table-data (send hhea decode (make-object RDecodeStream table-bytes)))
+  (define table-data (send hhea decode (+DecodeStream table-bytes)))
   (check-equal? (· table-data ascent) 980)
   (check-equal? (· table-data descent) -238))
 
@@ -46,7 +46,7 @@
   (define table-bytes #"\0\1\0\0\0\2\0\0.\252t<_\17<\365\0\t\3\350\0\0\0\0\316\3\301\261\0\0\0\0\316\3\304\364\377\36\377\24\4\226\3\324\0\2\0\t\0\2\0\0\0\0")
   (set-port-position! ip 0)
   (check-equal? (peek-bytes length offset ip) table-bytes)
-  (define table-data (send head decode (make-object RDecodeStream table-bytes)))
+  (define table-data (send head decode (+DecodeStream table-bytes)))
   (check-equal? (· table-data unitsPerEm) 1000)
   (check-equal? (· table-data yMin) -236)
   (check-equal? (· table-data yMax) 980)
@@ -73,7 +73,7 @@
   (set-port-position! ip 0)
   (define table-bytes #"\270\0\0+\0\272\0\1\0\1\0\2+\1\272\0\2\0\1\0\2+\1\277\0\2\0C\0007\0+\0\37\0\23\0\0\0\b+\0\277\0\1\0\200\0i\0R\0;\0#\0\0\0\b+\0\272\0\3\0\5\0\a+\270\0\0 E}i\30D")
   (check-equal? table-bytes (peek-bytes len offset ip))
-  (define ds (make-object RDecodeStream (peek-bytes len offset ip)))
+  (define ds (+DecodeStream (peek-bytes len offset ip)))
   (check-equal? (hash-ref (send prep decode ds) 'controlValueProgram) '(184
                                                                         0
                                                                         0
@@ -160,7 +160,7 @@
   (check-equal? offset 4140)
   (check-equal? len 371)
   (set-port-position! ip 0)
-  (define ds (make-object RDecodeStream (peek-bytes len offset ip)))
+  (define ds (+DecodeStream (peek-bytes len offset ip)))
   (check-equal? (hash-ref (send fpgm decode ds) 'instructions) '(184
                                                                  0
                                                                  0
@@ -540,7 +540,7 @@
   (check-equal? offset 38692)
   (check-equal? len 460)
   (set-port-position! ip 0)
-  (define ds (make-object RDecodeStream (peek-bytes len offset ip)))
+  (define ds (+DecodeStream (peek-bytes len offset ip)))
   (define table-data (send loca decode ds #:version 0))
   (check-equal? (length (· table-data offsets)) 230)
   (check-equal? (· table-data offsets) '(0

pitfall/restructure/array.rkt

@@ -1,48 +1,47 @@
 #lang restructure/racket
-(require "number.rkt" "utils.rkt" "streamcoder.rkt")
-(provide RArray)
+(require "number.rkt" "utils.rkt" "stream.rkt")
+(provide (all-defined-out))
 
 #|
 approximates
 https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 |#
 
-(define-subclass RStreamcoder (RArray type [length #f] [lengthType 'count])
+(define-subclass Streamcoder (Array type [_length #f] [lengthType 'count])
           
   (define/augment (decode stream [parent #f])
-    (let ([length (cond
-                    [length
-                      (resolveLength length stream parent)]
-                    [else
-                     (define num (send stream length))
-                     (define denom (send type size))
-                     (unless (andmap (λ (x) (and x (number? x))) (list num denom))
-                       (raise-argument-error 'RArray:decode "valid length and size" (list num denom)))
-                      ;; implied length: length of stream divided by size of item
-                      (floor (/ (send stream length) (send type size)))])])
+    (let ([len (cond
+                 ;; explicit length
+                 [_length (resolveLength _length stream parent)]
+                 [else  ;; implicit length: length of stream divided by size of item
+                  (define num (send stream length))
+                  (define denom (send type size))
+                  (unless (andmap (λ (x) (and x (number? x))) (list num denom))
+                    (raise-argument-error 'Array:decode "valid length and size" (list num denom)))
+                  (floor (/ (send stream length) (send type size)))])])
     
       (caseq lengthType
-             [(count) (for/list ([i (in-range length)])
-                                (send type decode stream this))])))
+             [(count) (for/list ([i (in-range len)])
+                        (send type decode stream this))])))
 
   (define/override (size array)
-    (for/sum ([item (in-list array)])
-      (send type size)))
+    (unless (list? array) (raise-argument-error 'Array:size "list" array))
+    (* (send type size) (length array)))
 
   (define/augment (encode stream array [parent #f])
+    (unless (list? array) (raise-argument-error 'Array:encode "list" array))
     (for ([item (in-list array)])
-         (send type encode stream item))))
+      (send type encode stream item))))
 
 
 (test-module
- (require "decodestream.rkt" "encodestream.rkt")
- (define stream (make-object RDecodeStream #"ABCDEFG"))
+ (define stream (+DecodeStream #"ABCDEFG"))
    
- (define A (make-object RArray uint16be 3))
+ (define A (+Array uint16be 3))
  (check-equal? (send A decode stream) '(16706 17220 17734))
- (define os (make-object REncodeStream))
+ (define os (+EncodeStream))
  (send A encode os '(16706 17220 17734))
  (check-equal? (send os dump) #"ABCDEF")
 
- (check-equal? (send (make-object RArray uint16be) size '(1 2 3)) 6)
- (check-equal? (send (make-object RArray doublebe) size '(1 2 3 4 5)) 40))
+ (check-equal? (send (+Array uint16be) size '(1 2 3)) 6)
+ (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))

pitfall/restructure/bitfield.rkt

@@ -1,33 +1,34 @@
 #lang restructure/racket
-(require "streamcoder.rkt")
-(provide RBitfield)
+(require "stream.rkt")
+(provide (all-defined-out))
 
 #|
 approximates
 https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
 |#
 
-(define-subclass RStreamcoder (RBitfield type [flags empty])
+(define-subclass Streamcoder (Bitfield type [flags empty])
           
-  (define/augment (decode stream [parent #f])
-    (for*/fold ([res (mhash)])
+  (define/augment (decode stream . args)
+    (for*/fold ([flag-hash (mhash)])
                ([val (in-value (send type decode stream))]
                 [(flag i) (in-indexed flags)])
-      (hash-set! res flag (bitwise-bit-set? val i))
-      res))
+      (hash-set! flag-hash flag (bitwise-bit-set? val i))
+      flag-hash))
 
   (define/override (size . args) (send type size))
 
   (define/augment (encode stream flag-hash)
-    (send type encode stream (for/sum ([(flag i) (in-indexed flags)]
-                                       #:when (hash-ref flag-hash flag))
-                               (expt 2 i)))))
+    (define bitfield-int (for/sum ([(flag i) (in-indexed flags)]
+                                   #:when (hash-ref flag-hash flag))
+                           (expt 2 i)))
+    (send type encode stream bitfield-int)))
 
 
 (test-module
- (require "number.rkt" "decodestream.rkt" "encodestream.rkt")
- (define bfer (make-object RBitfield uint16be '(bold italic underline outline shadow condensed extended)))
- (define bf (send bfer decode (make-object RDecodeStream #"\0\25")))
+ (require "number.rkt" "stream.rkt")
+ (define bfer (+Bitfield uint16be '(bold italic underline outline shadow condensed extended)))
+ (define bf (send bfer decode (+DecodeStream #"\0\25")))
  (check-true (hash-ref bf 'bold))
  (check-true (hash-ref bf 'underline))
  (check-true (hash-ref bf 'shadow))
@@ -36,6 +37,6 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
  (check-false (hash-ref bf 'condensed))
  (check-false (hash-ref bf 'extended))
 
- (define os (make-object REncodeStream))
+ (define os (+EncodeStream))
  (send bfer encode os bf)
  (check-equal? (send os dump) #"\0\25"))

pitfall/restructure/helper.rkt

@@ -11,6 +11,8 @@
     (define/public (process . args) (void))
     (define/public (preEncode . args) (void))))
 
+(define (RestructureBase? x) (is-a? x RestructureBase))
+
 
 (define-macro (test-module . EXPRS)
   #`(module+ test

pitfall/restructure/main.rkt

@@ -2,9 +2,7 @@
 
 (r+p "number.rkt"
      "struct.rkt"
-     "versioned-struct.rkt"
      "string.rkt"
      "array.rkt"
      "bitfield.rkt"
-     "decodestream.rkt"
-     "encodestream.rkt")
+     "stream.rkt")

pitfall/restructure/string.rkt

@@ -1,40 +1,46 @@
 #lang restructure/racket
-(require "number.rkt" "utils.rkt" "streamcoder.rkt")
-(provide RString)
+(require "number.rkt" "utils.rkt" "stream.rkt")
+(provide (all-defined-out))
 
 #|
 approximates
 https://github.com/mbutterick/restructure/blob/master/src/String.coffee
 |#
 
-(define-subclass RStreamcoder (RString [length #f] [encoding 'ascii])
-  (field [_codec (caseq encoding
-                        [(latin-1 ascii) (cons string->bytes/latin-1 bytes->string/latin-1)]
-                        [(utf-8 utf8)(cons string->bytes/utf-8 bytes->string/utf-8)])])
+(struct $codec (encoder decoder) #:transparent)
+
+(define-subclass Streamcoder (String [strlen #f] [encoding 'ascii])
+  (field [codec (caseq encoding
+                       [(latin-1 ascii) ($codec string->bytes/latin-1 bytes->string/latin-1)]
+                       [(utf-8 utf8) ($codec string->bytes/utf-8 bytes->string/utf-8)])])
          
   (define/augment (decode stream [parent #f])
-    (define count (if length
-                      (resolveLength length stream parent)
+    (define count (if strlen
+                      (resolveLength strlen stream parent)
                       (send stream length)))
     (define bytes (send stream read count))
-    ((cdr _codec) bytes))
+    (($codec-decoder codec) bytes))
 
   (define/augment (encode stream val [parent #f])
-    (define bytes ((car _codec) (format "~a" val)))
+    (define bytes (($codec-encoder codec) (format "~a" val)))
     
-    (when (is-a? length Number) ;; length-prefixed string
-      (send length encode stream (bytes-length bytes)))
+    (when (Number? strlen) ;; length-prefixed string
+      (send strlen encode stream (bytes-length bytes)))
     
     (send stream write bytes))
 
-  (define/override (size) (unfinished)))
+  (define/override (size str)
+    (define es (+EncodeStream))
+    (encode es str)
+    (bytes-length (send es dump))))
 
 
 (test-module
- (require "decodestream.rkt" "encodestream.rkt")
- (define stream (make-object RDecodeStream #"\2BCDEF"))
- (define S (make-object RString uint8 'utf8))
+ (require "stream.rkt")
+ (define stream (+DecodeStream #"\2BCDEF"))
+ (define S (+String uint8 'utf8))
  (check-equal? (send S decode stream) "BC")
- (define os (make-object REncodeStream))
+ (define os (+EncodeStream))
  (send S encode os "Mike")
- (check-equal? (send os dump) #"\4Mike"))
+ (check-equal? (send os dump) #"\4Mike")
+ (check-equal? (send (+String) size "foobar") 6))

pitfall/restructure/struct.rkt

@@ -1,5 +1,5 @@
 #lang restructure/racket
-(require racket/dict)
+(require racket/dict "stream.rkt")
 (provide (all-defined-out))
 
 #|
@@ -7,27 +7,32 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
 |#
 
-(define-subclass RBase (RStruct [assocs (dictify)])
-  (field [key-index #f]
-         [fields (mhash)])
+(define-subclass RestructureBase (Struct [assocs (dictify)])
+  (field [key-index (map car assocs)] ; store the original key order
+         [struct-types (mhash)])
   (for ([(k v) (in-dict assocs)])
-    (hash-set! fields k v))
-
-  (define/public-final (make-key-index! [fields assocs])
-    (set! key-index (map car fields)))
-  (make-key-index!)
+    (hash-set! struct-types k v))
   
   (define/override (decode stream [parent #f] [length 0])
     (define res (_setup stream parent length))
-    (_parseFields stream res fields)
+    (_parseFields stream res struct-types)
     #;(hash-set! (hash-ref res '_props) '_currentOffset (· stream pos))
     (send this process res stream)
     res)
 
-  (define/override (encode stream val [parent #f])
-    (send this preEncode val stream)
-    (for ([key (in-list key-index)])
-      (send (hash-ref fields key) encode stream (hash-ref val key))))
+  (define/override (encode stream input-hash [parent #f])
+    (unless (hash? input-hash)
+      (raise-argument-error 'Struct:encode "hash" input-hash))
+    (define sorted-input-keys (sort (hash-keys input-hash) #:key symbol->string string<?))
+    (define sorted-struct-keys (sort key-index #:key symbol->string string<?))
+    (unless (equal? sorted-input-keys sorted-struct-keys)
+      (raise-argument-error 'Struct:encode (format "hash with same keys as Struct: ~a" sorted-struct-keys) sorted-input-keys))
+    
+    (send this preEncode input-hash stream)
+    (for* ([key (in-list key-index)] ; iterate over original keys in order
+           [struct-type (in-value (hash-ref struct-types key))]
+           [value-to-encode (in-value (hash-ref input-hash key))])
+      (send struct-type encode stream value-to-encode)))
 
   (define/public-final (_setup stream parent length)
     (define res (mhasheq))
@@ -50,6 +55,32 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
       (hash-set! res key val)))
 
   (define/override (size [val (mhash)] [parent #f] [includePointers #t])
-    (for/sum ([(key type) (in-hash fields)]
+    (for/sum ([(key type) (in-hash struct-types)]
               #:when (hash-has-key? val key))
       (send type size (hash-ref val key)))))
+
+
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
+|#
+
+(define-subclass Struct (VersionedStruct type [versions (dictify)])
+  (define/override (decode stream [parent #f] [length 0] #:version [maybe-version #f])
+    (define res (send this _setup stream parent length))
+    (define version (cond
+                      [maybe-version] ; for testing purposes: pass an explicit version
+                      [(procedure? type) (type parent)]
+                      [(RestructureBase? type) (send type decode stream)]
+                      [else (raise-argument-error 'decode "way of finding version" type)]))
+    (hash-set! res 'version version)
+    (set-field! fields this (dict-ref versions version (λ () (raise-argument-error 'RVersionedStruct:decode "valid version key" version))))
+    (send this make-key-index! (· this fields))
+    (cond
+      [(VersionedStruct? (· this fields)) (send (· this fields) decode stream parent)]
+      [else
+       (send this _parseFields stream res (· this fields))
+       (send this process res stream)
+       res]))
+  )

pitfall/restructure/versioned-struct.rkt

@@ -1,27 +1,3 @@
 #lang restructure/racket
 (require racket/dict "struct.rkt")
 (provide (all-defined-out))
-
-#|
-approximates
-https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
-|#
-
-(define-subclass RStruct (RVersionedStruct type [versions (dictify)])
-  (define/override (decode stream [parent #f] [length 0] #:version [maybe-version #f])
-    (define res (send this _setup stream parent length))
-    (define version (cond
-                      [maybe-version] ; for testing purposes: pass an explicit version
-                      [(procedure? type) (type parent)]
-                      [(is-a? type RBase) (send type decode stream)]
-                      [else (raise-argument-error 'decode "way of finding version" type)]))
-    (hash-set! res 'version version)
-    (set-field! fields this (dict-ref versions version (λ () (raise-argument-error 'RVersionedStruct:decode "valid version key" version))))
-    (send this make-key-index! (· this fields))
-    (cond
-      [(is-a? (· this fields) RVersionedStruct) (send (· this fields) decode stream parent)]
-      [else
-       (send this _parseFields stream res (· this fields))
-       (send this process res stream)
-       res]))
-  )