mess with generics

pitfall/restructure/array.rkt

@@ -8,45 +8,58 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 |#
 
 (define-subclass Streamcoder (Array type [length_ #f] [lengthType 'count])
-  (inherit-field res)
           
   (define/augride (decode stream [parent #f])
-    (when parent
-      (unless (hash? parent)
-                 (raise-argument-error 'Array:decode "hash" parent)))
     
     (define pos (send stream pos))
 
-    (define res empty)
+    (define res (make-object RestructureBase))
     (define ctx parent)
 
     (define length__
-      (or length_ (resolveLength length_ stream parent)))
+      (and length_ (resolveLength length_ stream parent)))
 
     (when (NumberT? length_)
       ;; define hidden properties
-      (hash-set*! (hash-ref ctx 'res) 'parent parent
+      (ref-set*! res 'parent parent
-                  '_startOffset pos
+                 '_startOffset pos
-                  '_currentOffset 0
+                 '_currentOffset 0
-                  '_length length_))
+                 '_length length_)
+      (set! ctx res))
+
+
+    )
+  #|
+    (cond
+      [(or (not length__) (eq? lengthType 'bytes))
+       (define target (cond
+                        [length__ (+ (send stream pos) length__)]
+                        [(and parent (· parent _length))
+                         (+ (· parent _startOffset)
+                            (· parent _length))]
+                        [else
+                         (*length stream)]))
+       (while (< (send stream pos) target)
+              (
           
-    #;(define length__ (cond
+               #;(define length__ (cond
-                         ;; explicit length
+                                    ;; explicit length
-                         [length_ (resolveLength length_ stream parent)]
+                                    [length_ (resolveLength length_ stream parent)]
-                         [else  ;; implicit length: length of stream divided by size of item
+                                    [else  ;; implicit length: length of stream divided by size of item
-                          (define num (send stream length))
+                                     (define num (send stream length))
-                          (define denom (send type size))
+                                     (define denom (send type size))
-                          (unless (andmap (λ (x) (and x (number? x))) (list num denom))
+                                     (unless (andmap (λ (x) (and x (number? x))) (list num denom))
-                            (raise-argument-error 'Array:decode "valid length and size" (list num denom)))
+                                       (raise-argument-error 'Array:decode "valid length and size" (list num denom)))
-                          (floor (/ (send stream length) (send type size)))]))
+                                     (floor (/ (send stream length) (send type size)))]))
     
     
     
-    #;(define res (caseq lengthType
+               #;(define res (caseq lengthType
-                         [(bytes) (error 'array-decode-bytes-no!)]
+                                    [(bytes) (error 'array-decode-bytes-no!)]
-                         [(count) (for/list ([i (in-range length__)])
+                                    [(count) (for/list ([i (in-range length__)])
-                                    (send type decode stream ctx))]))
+                                               (send type decode stream ctx))]))
-    res)
+               res)
+|#
 
   (define/override (size [array #f])
     (when (and array (not (list? array)))
@@ -61,18 +74,22 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
     (for ([item (in-list array)])
       (send type encode stream item))))
 
+(define a (+Array uint8))
+(define stream (+DecodeStream #"ABCDEFG"))
+(send a decode stream)
+
 
-(test-module
+#;(test-module
- (define stream (+DecodeStream #"ABCDEFG"))
+   (define stream (+DecodeStream #"ABCDEFG"))
    
- (define A (+Array uint16be 3))
+   (define A (+Array uint16be 3))
- (check-equal? (send A decode stream) '(16706 17220 17734))
+   (check-equal? (send A decode stream) '(16706 17220 17734))
- (define os (+EncodeStream))
+   (define os (+EncodeStream))
- (send A encode os '(16706 17220 17734))
+   (send A encode os '(16706 17220 17734))
- (check-equal? (send os dump) #"ABCDEF")
+   (check-equal? (send os dump) #"ABCDEF")
-
+
- (check-equal? (send (+Array uint16be) size '(1 2 3)) 6)
+   (check-equal? (send (+Array uint16be) size '(1 2 3)) 6)
- (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))
+   (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))
 
 #|
 approximates

pitfall/restructure/base.rkt

@@ -5,7 +5,8 @@
 (define RestructureBase
   (class object%
     (super-new)
-    (field [res (make-hash)])
+    (field [_hash (make-hash)]
+           [_list null])
     (define/public (decode stream . args) (void))
     (define/public (encode . xs) (void))
     (define/public (size . xs) (void))

pitfall/restructure/buffer.rkt

@@ -37,7 +37,7 @@ A Restructure RBuffer object is separate.
     (unless (bytes? buf)
       (raise-argument-error 'Buffer:encode "bytes" buf))
     (when (NumberT? length_)
-      (send length_ encode stream (*length buf)))
+      (send length_ encode stream (length buf)))
     (send stream writeBuffer buf)))
 
 (define-subclass RBuffer (BufferT))

pitfall/restructure/generic.rkt

@@ -0,0 +1,79 @@
+#lang racket/base
+
+(require racket/generic
+         (prefix-in b: racket/base)
+         racket/dict
+         racket/class
+         racket/match)
+
+(provide (all-defined-out))
+
+(define-generics indexable
+  (ref indexable i)
+  (ref-set! indexable i v)
+  #:defaults
+  ([hash? (define ref hash-ref)
+          (define ref-set! hash-set!)]
+   [object? (define (ref o i) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i))]) (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)))]))
+
+(module+ test
+  (require rackunit)
+  (define h (make-hash '((foo . 42))))
+  (check-equal? (ref h 'foo) 42)
+  (ref-set! h 'foo 85)
+  (check-equal? (ref h 'foo) 85)
+  (ref-set! h 'bar 121)
+  (check-equal? (ref h 'bar) 121)
+  (define o (make-object (class object% (super-new) (field [_hash (make-hash)][foo 42]))))
+  (check-equal? (ref o 'foo) 42)
+  (ref-set! o 'foo 100)
+  (check-equal? (ref o 'foo) 100)
+  (ref-set! o 'bar 121)
+  (check-equal? (ref o 'bar) 121))
+
+(define (ref* c . is)
+  (for/fold ([c c])
+            ([i (in-list is)])
+    (ref c i)))
+
+(define (ref*-set! c . is+val)
+  (match-define (list is ... i val) is+val)
+  (ref-set! (apply ref* c is) i val))
+
+(require sugar/debug)
+(define (ref-set*! c . kvs)
+  (for ([k (in-list kvs)]
+        [v (in-list (cdr kvs))]
+        [i (in-naturals)]
+        #:when (even? i))
+    (ref-set! c k v)))
+
+(module+ test
+  (define h2 (make-hash (list (cons 'foo (make-hash (list (cons 'bar (make-hash '((zam . 42))))))))))
+  (check-equal? (ref* h2 'foo 'bar 'zam) 42)
+  (ref*-set! h2 'foo 'bar 'zam 89)
+  (check-equal? (ref* h2 'foo 'bar 'zam) 89)
+  (ref-set*! h2 'hi 1 'there 2)
+  (check-equal? (ref h2 'hi) 1)
+  (check-equal? (ref h2 'there) 2))
+
+(define-generics countable
+  (length countable)
+  #:defaults
+  ([list? (define length b:length)]
+   [vector? (define length vector-length)]
+   [string? (define length string-length)]
+   [bytes? (define length bytes-length)]
+   [dict? (define length dict-count)]
+   [object? (define (length o) (with-handlers ([exn:fail:object? (λ (exn) 0)]) (b:length (get-field _list o))))]))
+
+(module+ test
+  (require racket/list)
+  (check-equal? (length (make-list 42 #f)) 42)
+  (check-equal? (length (make-vector 42 #f)) 42)
+  (check-equal? (length (make-string 42 #\x)) 42)
+  (check-equal? (length (make-bytes 42 0)) 42)
+  (check-equal? (length (map cons (range 42) (range 42))) 42)
+  (check-equal? (length (make-object (class object% (super-new) (field [_list (make-list 42 #f)])))) 42)
+  (check-equal? (length (make-object (class object% (super-new)))) 0))

pitfall/restructure/number.rkt

@@ -56,7 +56,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
   (define/public (pre-encode val-in)
     (exact-if-possible val-in))
 
-  (define/augment (encode stream val-in)
+  (define/augment (encode stream val-in [parent #f])
     (define val (pre-encode val-in))
     (unless (<= bound-min val bound-max)
       (raise-argument-error 'Integer:encode (format "value within range of ~a ~a-byte int (~a to ~a)" (if _signed? "signed" "unsigned") _size bound-min bound-max) val))
@@ -76,7 +76,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
     (define bs (send stream readBuffer byte-size))
     (floating-point-bytes->real bs (eq? endian 'be)))
 
-  (define/augment (encode stream val-in) ; convert float to int
+  (define/augment (encode stream val-in [parent #f]) ; convert float to int
     (define bs (real->floating-point-bytes val-in byte-size (eq? endian 'be)))
     (send stream write bs))
 

pitfall/restructure/racket.rkt

@@ -7,6 +7,7 @@
   #'(begin (require ID ...) (provide (all-from-out ID ...))))
 
 (r+p "helper.rkt"
+     "generic.rkt"
      sugar/debug
      racket/class
      racket/list
@@ -21,8 +22,6 @@
      sugar/port
      sugar/case)
 
-(require (prefix-in * data/collection))
-(provide (all-from-out data/collection))
 
 (module reader syntax/module-reader
   #:language 'restructure/racket

pitfall/restructure/stream-test.rkt

@@ -15,7 +15,7 @@ https://github.com/mbutterick/restructure/blob/master/test/DecodeStream.coffee
 (let ()
   (define buf (+Buffer '(1 2 3)))
   (define stream (+DecodeStream buf))
-  (check-equal? (send stream readBuffer (*length buf)) (+Buffer '(1 2 3))))
+  (check-equal? (send stream readBuffer (length buf)) (+Buffer '(1 2 3))))
 
 ;
 ;  it 'should readUInt16BE', ->
@@ -93,7 +93,7 @@ https://github.com/mbutterick/restructure/blob/master/test/DecodeStream.coffee
 (let ()
   (define buf (+Buffer "some text" 'ascii))
   (define stream (+DecodeStream buf))
-  (check-equal? (send stream readString (*length buf)) "some text"))
+  (check-equal? (send stream readString (length buf)) "some text"))
 
 ;
 ;    it 'should decode ascii', ->
@@ -104,7 +104,7 @@ https://github.com/mbutterick/restructure/blob/master/test/DecodeStream.coffee
 (let ()
   (define buf (+Buffer "some text" 'ascii))
   (define stream (+DecodeStream buf))
-  (check-equal? (send stream readString (*length buf) 'ascii) "some text"))
+  (check-equal? (send stream readString (length buf) 'ascii) "some text"))
 
 ;
 ;    it 'should decode utf8', ->
@@ -115,7 +115,7 @@ https://github.com/mbutterick/restructure/blob/master/test/DecodeStream.coffee
 (let ()
   (define buf (+Buffer "unicode! 👍" 'utf8))
   (define stream (+DecodeStream buf))
-  (check-equal? (send stream readString (*length buf) 'utf8) "unicode! 👍"))
+  (check-equal? (send stream readString (length buf) 'utf8) "unicode! 👍"))
 
 #|
 ; todo: support freaky string encodings

pitfall/restructure/stream.rkt

@@ -78,7 +78,7 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
   (inherit-field _port)
 
   (field [pos 0]
-         [length (*length buffer)])
+         [length_ (length buffer)])
 
   (define/public (readString length [encoding 'ascii])
     (define proc (caseq encoding
@@ -92,7 +92,7 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
   (define/public-final (readBuffer count)
     (unless (index? count)
       (raise-argument-error 'DecodeStream:read "positive integer" count))
-    (define bytes-remaining (- length (port-position _port)))
+    (define bytes-remaining (- length_ (port-position _port)))
     (when (> count bytes-remaining)
       (raise-argument-error 'DecodeStream:read (format "byte count not more than bytes remaining = ~a" bytes-remaining) count))
     (increment-field! pos this count)
@@ -137,26 +137,28 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
 ;; Streamcoder is a helper class that checks / converts stream arguments before decode / encode
 ;; not a subclass of DecodeStream or EncodeStream, however.
 (define-subclass RestructureBase (Streamcoder)
-  (define/overment (decode x . args)
+  (define/overment (decode x [parent #f])
+    (when parent (unless (hash? parent)
+                   (raise-argument-error 'Streamcoder:decode "hash" parent)))
     (define stream (if (bytes? x) (+DecodeStream x) x))
     (unless (DecodeStream? stream)
       (raise-argument-error 'Streamcoder:decode "bytes or DecodeStream" x))
-    (inner (void) decode stream . args))
+    (inner (void) decode stream parent))
 
-  (define/overment (encode x . args)
+  (define/overment (encode x [val #f] [parent #f])
     (define stream (cond
                      [(output-port? x) (+EncodeStream x)]
                      [(not x) (+EncodeStream)]
                      [else x]))
     (unless (EncodeStream? stream)
       (raise-argument-error 'Streamcoder:encode "output port or EncodeStream" x))
-    (inner (void) encode stream . args)
+    (inner (void) encode stream val parent)
     (when (not x) (send stream dump))))
 
 (test-module
  (define-subclass Streamcoder (Dummy)
    (define/augment (decode stream . args) "foo")
-   (define/augment (encode stream val) "bar")
+   (define/augment (encode stream val parent) "bar")
    (define/override (size) 42))
 
  (define d (+Dummy))

pitfall/restructure/utils.rkt

@@ -7,7 +7,7 @@
     (cond
     [(number? length) length]
     [(procedure? length) (length parent)]
-    [(and parent (symbol? length)) (*ref parent length)] ; treat as key into RStruct parent
+    [(and parent (symbol? length)) (ref parent length)] ; treat as key into RStruct parent
     [(and stream (Number? length)) (send length decode stream)]
     [else (raise-argument-error 'resolveLength "fixed-size argument" length)]))
   res)