refac

pitfall/restructure/array.rkt

@@ -1,5 +1,5 @@
 #lang restructure/racket
-(require "number.rkt" (prefix-in utils- "utils.rkt") "stream.rkt")
+(require "number.rkt" "utils.rkt" "stream.rkt")
 (provide (all-defined-out))
 
 #|
@@ -7,79 +7,66 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 |#
 
-(define-subclass Streamcoder (ArrayT type [length_ #f] [lengthType 'count])
+(define-subclass Streamcoder (ArrayT type [len #f] [length-type 'count])
           
   (define/augride (decode stream [parent #f])
-    (define pos (send stream pos))
-
-    (define res (make-object RestructureBase)) ; instead of empty list
-    (define ctx parent)
-
-    (define length__
-      (and length_ (utils-resolveLength length_ stream parent)))
-
-    (when (NumberT? length_)
-      ;; define hidden properties
-      (ref-set*! res 'parent parent
-                 '_startOffset pos
-                 '_currentOffset 0
-                 '_length length_)
-      (set! ctx res))
+    (define ctx (if (NumberT? len)
+                    (mhasheq 'parent parent
+                             '_startOffset (· stream pos)
+                             '_currentOffset 0
+                             '_length len)
+                    parent))
 
+    (define decoded-len (resolve-length len stream parent))
     (cond
-      [(or (not length__) (eq? lengthType 'bytes))
-       (define target (cond
-                        [length__ (+ (send stream pos) length__)]
-                        [(and parent (positive? (· parent _length)))
-                         (+ (ref parent '_startOffset)
-                            (ref parent '_length))]
-                        [else (· stream length_)]))
-       (ref-set! res '_list
-                 (push-end res
-                           (for/list ([i (in-naturals)]
-                                      #:break (= (send stream pos) target))
-                             (send type decode stream ctx))))]
-      [else
-       (ref-set! res '_list
-                 (push-end res
-                           (for/list ([i (in-range length__)])
-                             (send type decode stream ctx))))])
+      [(or (not decoded-len) (eq? length-type 'bytes))
+       (define end-pos (cond
+                         ;; decoded-len is byte length
+                         [decoded-len (+ (· stream pos) decoded-len)]
+                         ;; no decoded-len, but parent has length
+                         [(and parent (not (zero? (· parent _length)))) (+ (· parent _startOffset) (· parent _length))]
+                         ;; no decoded-len or parent, so consume whole stream
+                         [else (· stream length_)]))
+       (for/list ([i (in-naturals)]
+                  #:break (= (· stream pos) end-pos))
+         (send type decode stream ctx))]
+      ;; we have decoded-len, which is treated as count of items
+      [else (for/list ([i (in-range decoded-len)])
+              (send type decode stream ctx))]))
+  
 
-    (countable->list res))
-
-  (define/override (size [array #f] [ctx #f])
-    (when array
-      (unless (countable? array)
-        (raise-argument-error 'Array:size "list or countable" array)))
+  (define/override (size [val #f] [ctx #f])
+    (when val (unless (countable? val)
+                (raise-argument-error 'Array:size "list or countable" val)))
     (cond
-      [(not array)
-       (* (send type size #f ctx) (utils-resolveLength length_ #f ctx))]
-      [else
-       (+ (cond
-            [(NumberT? length_)
-             (set! ctx (mhash 'parent ctx))
-             (send length_ size)]
-            [else 0])
-          (for/sum ([item (in-list (countable->list array))])
-            (send type size item ctx)))]))
+      [val (let-values ([(ctx len-size) (if (NumberT? len)
+                                            (values (mhasheq 'parent ctx) (send len size))
+                                            (values ctx 0))])
+             (+ len-size (for/sum ([item (in-list (countable->list val))])
+                           (send type size item ctx))))]
+      [else (let ([item-count (resolve-length len #f ctx)]
+                  [item-size (send type size #f ctx)])
+              (* item-size item-count))]))
+  
 
   (define/augride (encode stream array [parent #f])
     (when array (unless (countable? array)
                   (raise-argument-error 'Array:encode "list or countable" array)))
-    (define ctx parent)
-    (when (NumberT? length_)
-      (set! ctx (mhash 'pointers null
-                       'startOffset (· stream pos)
-                       'parent parent))
-      (ref-set! ctx 'pointerOffset (+ (· stream pos) (size array ctx)))
-      (send length_ encode stream (length array)))
 
-    (for ([item (in-list (countable->list array))])
-      (send type encode stream item ctx))
+    (define (encode-items ctx)
+      (for ([item (in-list (countable->list array))])
+        (send type encode stream item ctx)))
 
-    (when (NumberT? length_)
-      (for ([ptr (in-list (· ctx pointers))])
-        (send (· ptr type) encode stream (· ptr val))))))
+    (cond
+      [(NumberT? len) (define ctx (mhash 'pointers null
+                                         'startOffset (· stream pos)
+                                         'parent parent))
+                      (ref-set! ctx 'pointerOffset (+ (· stream pos) (size array ctx)))
+                      (send len encode stream (length array)) ; encode length at front
+                      (encode-items ctx)
+                      (for ([ptr (in-list (· ctx pointers))]) ; encode pointer data at end
+                        (send (· ptr type) encode stream (· ptr val)))]
+      [else (encode-items parent)])))
 
 (define-values (Array Array? +Array) (values ArrayT ArrayT? +ArrayT))
 

pitfall/restructure/base.rkt

@@ -1,16 +1,12 @@
 #lang racket/base
-(require racket/class sugar/debug)
+(require racket/class sugar/class)
 (provide (all-defined-out))
 
-(define RestructureBase
-  (class object%
-    (super-new)
+(define-subclass object% (RestructureBase)
     (field [_hash (make-hash)]
            [_list null])
     (define/public (decode stream . args) (void))
     (define/public (encode . xs) (void))
     (define/public (size . xs) (void))
     (define/public (process . args) (void))
-    (define/public (preEncode . args) (void))))
-
-(define (RestructureBase? x) (is-a? x RestructureBase))
+    (define/public (preEncode . args) (void)))

pitfall/restructure/generic.rkt

@@ -9,17 +9,20 @@
 (provide (all-defined-out))
 
 (define-generics indexable
-  (ref indexable i)
+  (ref indexable i [thunk])
+  (ref! indexable i [thunk])
   (ref-set! indexable i v)
   (ref-keys indexable)
   #:defaults
-  ([hash? (define (ref o i) (hash-ref o i #f))
+  ([hash? (define (ref o i [thunk #f]) (hash-ref o i thunk))
+          (define (ref! o i [thunk #f]) (hash-ref! o i thunk))
           (define ref-set! hash-set!)
           (define ref-keys hash-keys)]
-   [dict? (define (ref o i) (dict-ref o i #f))
+   [dict? (define (ref o i [thunk #f]) (dict-ref o i thunk))
+          (define (ref! o i [thunk #f]) (dict-ref o i thunk))
           (define ref-set! dict-set!)
           (define ref-keys dict-keys)]
-   [object? (define (ref o i) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i #f))]) (dynamic-get-field i o)))
+   [object? (define (ref o i [thunk #f]) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i thunk))]) (dynamic-get-field i o)))
             (define (ref-set! o i v) (with-handlers ([exn:fail:object? (λ (exn) (hash-set! (get-field _hash o) i v))]) (dynamic-set-field! i o v)))
             (define (ref-keys o) (append (remove '_hash (field-names o)) (hash-keys (get-field _hash o))))]))
 

pitfall/restructure/helper.rkt

@@ -10,6 +10,9 @@
 
 (define index? (λ (x) (and (number? x) (integer? x) (not (negative? x)))))
 
+(define key? symbol?)
+(define (keys? x) (and (pair? x) (andmap key? x)))
+
 (define (unsigned->signed uint bits)
   (define most-significant-bit-mask (arithmetic-shift 1 (sub1 bits)))
   (- (bitwise-xor uint most-significant-bit-mask) most-significant-bit-mask))

pitfall/restructure/lazy-array-test.rkt

@@ -29,7 +29,7 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
        [array (+LazyArray uint8 4)])
   (define arr (send array decode stream))
   (check-false (Array? arr))
-  (check-equal? (ref arr 'length_) 4)
+  (check-equal? (ref arr 'len) 4)
   (check-equal? (send stream pos) 4)
   (check-equal? (send arr get 0) 1)
   (check-equal? (send arr get 1) 2)
@@ -49,7 +49,7 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 (let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
        [array (+LazyArray uint8 4)])
   (define arr (send array decode stream))
-  (check-equal? (send arr toArray) '(1 2 3 4)))
+  (check-equal? (send arr to-list) '(1 2 3 4)))
 
 ;      
 ;    it 'should have an inspect method', ->
@@ -59,7 +59,7 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 ;      arr = array.decode(stream)
 ;      arr.inspect().should.equal '[ 1, 2, 3, 4 ]'
 
-(let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
+#;(let* ([stream (+DecodeStream (+Buffer '(1 2 3 4 5)))]
        [array (+LazyArray uint8 4)])
   (define arr (send array decode stream))
   (check-equal? (send arr inspect) (format "~a" '(1 2 3 4))))
@@ -75,7 +75,7 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 (let* ([stream (+DecodeStream (+Buffer '(4 1 2 3 4 5)))]
        [array (+LazyArray uint8 uint8)])
   (define arr (send array decode stream))
-  (check-equal? (send arr toArray) '(1 2 3 4)))
+  (check-equal? (send arr to-list) '(1 2 3 4)))
 
 ;      
 ;  describe 'size', ->

pitfall/restructure/lazy-array.rkt

@@ -1,5 +1,5 @@
 #lang restructure/racket
-(require (prefix-in utils- "utils.rkt") "array.rkt" "number.rkt")
+(require "utils.rkt" "array.rkt" "number.rkt")
 (provide (all-defined-out))
 
 #|
@@ -7,77 +7,66 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
 |#
 
-(define-subclass object% (InnerLazyArray type [length_ #f] [stream #f] [ctx #f])
-  (define base (and stream (· stream pos)))
-  (define items (mhash)) ;  rather than empty array
+(define-subclass object% (InnerLazyArray type [len #f] [stream #f] [ctx #f])
+  (unless stream (raise-argument-error 'LazyArray "stream" stream))
+  (define starting-pos (· stream pos))
+  (define item-cache (mhasheqv)) ;  integer-keyed hash, rather than list
 
   (define/public-final (get index)
-    (cond
-      [(or (< index 0) (>= index length_)) #f]
-      [else
-       (define item (with-handlers ([exn:fail? (λ _ #f)])
-                      (ref items index)))
-       (or item
-           (let ()
-             (define pos_ (· stream pos))
-             (send stream pos (+ base (* (send type size #f ctx) index)))
-             (define new-item (send type decode stream ctx))
-             (ref-set! items index new-item)
-             (send stream pos pos_)
-             new-item))]))
+    (unless (<= 0 index (sub1 len))
+      (raise-argument-error 'LazyArray:get (format "index in range 0 to ~a" len) index))
+    (ref! item-cache index (λ ()
+                             (define orig-pos (· stream pos))
+                             (send stream pos (+ starting-pos (* (send type size #f ctx) index)))
+                             (define new-item (send type decode stream ctx))
+                             (send stream pos orig-pos)
+                             new-item)))
 
-  (define/public-final (toArray)
-    (for/list ([i (in-range length_)])
-      (get i)))
+  (define/public-final (to-list)
+    (for/list ([i (in-range len)])
+      (get i))))
 
-  (define/public-final (inspect)
-    (format "~a" (toArray))))
 
 (define-subclass ArrayT (LazyArray)
-  (inherit-field length_ type)
+  (inherit-field len type)
   
   (define/override (decode stream [parent #f])
-    (define pos (· stream pos))
-    (define length__ (utils-resolveLength length_ stream parent))
-
-    (when (NumberT? length_)
-      ;; define hidden properties
-      (set! parent (mhash 'parent parent
-                          '_startOffset pos
-                          '_currentOffset 0
-                          '_length length_)))
-    
-    (define res (+InnerLazyArray type length__ stream parent))
-    (send stream pos (+ (· stream pos) (* length__ (send type size #f parent))))
-    res)
+    (define decoded-len (resolve-length len stream parent))
+    (let ([parent (if (NumberT? len)
+                      (mhasheq 'parent parent
+                               '_startOffset (· stream pos)
+                               '_currentOffset 0
+                               '_length len)
+                      parent)])
+      (define res (+InnerLazyArray type decoded-len stream parent))
+      (send stream pos (+ (· stream pos) (* decoded-len (send type size #f parent))))
+      res))
 
   (define/override (size [val #f] [ctx #f])
     (super size (if (InnerLazyArray? val)
-                    (send val toArray)
+                    (send val to-list)
                     val) ctx))
 
   (define/override (encode stream val [ctx #f])
     (super encode stream (if (InnerLazyArray? val)
-                             (send val toArray)
+                             (send val to-list)
                              val) ctx)))    
 
-#;(test-module
-   (require "stream.rkt")
-   (define bstr #"ABCD1234")
-   (define ds (+DecodeStream bstr))
-   (define la (+LazyArray uint8 4))
-   (define ila (send la decode ds))
-   (check-equal? (send ds pos) 4)
-   (check-equal? (send ila get 1) 66)
-   (check-equal? (send ila get 3) 68)
-   (check-equal? (send ds pos) 4)
-   (check-equal? (send ila toArray) '(65 66 67 68))
-
-   (define la2 (+LazyArray int16be (λ (t) 4)))
-   (define es (+EncodeStream))
-   (send la2 encode es '(1 2 3 4))
-   (check-equal? (send es dump) #"\0\1\0\2\0\3\0\4")
-   (check-equal? (send (send la2 decode (+DecodeStream #"\0\1\0\2\0\3\0\4")) toArray) '(1 2 3 4))
+(test-module
+ (require "stream.rkt")
+ (define bstr #"ABCD1234")
+ (define ds (+DecodeStream bstr))
+ (define la (+LazyArray uint8 4))
+ (define ila (send la decode ds))
+ (check-equal? (send ds pos) 4)
+ (check-equal? (send ila get 1) 66)
+ (check-equal? (send ila get 3) 68)
+ (check-equal? (send ds pos) 4)
+ (check-equal? (send ila to-list) '(65 66 67 68))
 
-   )
+ (define la2 (+LazyArray int16be (λ (t) 4)))
+ (define es (+EncodeStream))
+ (send la2 encode es '(1 2 3 4))
+ (check-equal? (send es dump) #"\0\1\0\2\0\3\0\4")
+ (check-equal? (send (send la2 decode (+DecodeStream #"\0\1\0\2\0\3\0\4")) to-list) '(1 2 3 4)))
 

pitfall/restructure/stream.rkt

@@ -178,7 +178,7 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
 (define-subclass RestructureBase (Streamcoder)
   (define/overment (decode x [parent #f])
     (when parent (unless (indexable? parent)
-                   (raise-argument-error 'Streamcoder:decode "hash or incexable" x)))
+                   (raise-argument-error 'Streamcoder:decode "hash or indexable" x)))
     (define stream (if (bytes? x) (+DecodeStream x) x))
     (unless (DecodeStream? stream)
       (raise-argument-error 'Streamcoder:decode "bytes or DecodeStream" x))

pitfall/restructure/utils.rkt

@@ -1,11 +1,12 @@
 #lang restructure/racket
-(provide (all-defined-out))
+(provide (all-defined-out) (rename-out [resolveLength resolve-length]))
 (require "number.rkt")
 
-(define (resolveLength length [stream #f] [parent #f])
+(define (resolveLength len-arg [stream #f] [parent #f])
   (cond
-    [(number? length) length]
-    [(procedure? length) (length parent)]
-    [(and parent (symbol? length)) (ref parent length)] ; treat as key into RStruct parent
-    [(and stream (NumberT? length)) (send length decode stream)]
-    [else (raise-argument-error 'resolveLength "fixed-size argument" length)]))
+    [(not len-arg) #f]
+    [(number? len-arg) len-arg]
+    [(procedure? len-arg) (len-arg parent)]
+    [(and parent (key? len-arg)) (ref parent len-arg)] ; treat as key into RStruct parent
+    [(and stream (NumberT? len-arg)) (send len-arg decode stream)]
+    [else (raise-argument-error 'resolveLength "fixed-size argument" len-arg)]))

pitfall/restructure/versioned-struct.rkt

@@ -6,8 +6,7 @@
 approximates
 https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 |#
-(define key? symbol?)
-(define (keys? x) (and (pair? x) (andmap key? x)))
+
 
 (define-subclass Struct (VersionedStruct type [versions (dictify)])
   

pitfall/sugar/js.rkt

@@ -54,10 +54,9 @@
    #'(let loop ([x X])
        (cond
          ;; dict first, to catch objects that implement gen:dict
-         [(and (dict? x) (dict-ref x 'REF #f))]
-         [(dict? x) #f]
-         [(and (object? x) (or (get-or-false x REF) (send-or-false x REF)))]
-         [(object? x) #f]
+         [(dict? x) (dict-ref x 'REF #f)]
+         ;; give `send` precedence (presence of method => wants runtime resolution of value)
+         [(object? x) (or (send-or-false x REF) (get-or-false x REF))]
          [else (raise-argument-error '· (format "~a must be object or dict" 'X) x)]))]
   [(_ X REF0 . REFS) #'(· (· X REF0) . REFS)])