diff --git a/pitfall/restructure/array.rkt b/pitfall/restructure/array.rkt index aa20001e..c78808ba 100644 --- a/pitfall/restructure/array.rkt +++ b/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 - '_startOffset pos - '_currentOffset 0 - '_length length_)) + (ref-set*! res 'parent parent + '_startOffset pos + '_currentOffset 0 + '_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 - ;; 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)))])) + #;(define length__ (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)))])) - #;(define res (caseq lengthType - [(bytes) (error 'array-decode-bytes-no!)] - [(count) (for/list ([i (in-range length__)]) - (send type decode stream ctx))])) - res) + #;(define res (caseq lengthType + [(bytes) (error 'array-decode-bytes-no!)] + [(count) (for/list ([i (in-range length__)]) + (send type decode stream ctx))])) + 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 - (define stream (+DecodeStream #"ABCDEFG")) +#;(test-module + (define stream (+DecodeStream #"ABCDEFG")) - (define A (+Array uint16be 3)) - (check-equal? (send A decode stream) '(16706 17220 17734)) - (define os (+EncodeStream)) - (send A encode os '(16706 17220 17734)) - (check-equal? (send os dump) #"ABCDEF") - - (check-equal? (send (+Array uint16be) size '(1 2 3)) 6) - (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40)) + (define A (+Array uint16be 3)) + (check-equal? (send A decode stream) '(16706 17220 17734)) + (define os (+EncodeStream)) + (send A encode os '(16706 17220 17734)) + (check-equal? (send os dump) #"ABCDEF") + + (check-equal? (send (+Array uint16be) size '(1 2 3)) 6) + (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40)) #| approximates diff --git a/pitfall/restructure/base.rkt b/pitfall/restructure/base.rkt index abb5572d..0583fd2b 100644 --- a/pitfall/restructure/base.rkt +++ b/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)) diff --git a/pitfall/restructure/buffer.rkt b/pitfall/restructure/buffer.rkt index 0ac86508..08fea45b 100644 --- a/pitfall/restructure/buffer.rkt +++ b/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)) diff --git a/pitfall/restructure/generic.rkt b/pitfall/restructure/generic.rkt new file mode 100644 index 00000000..3dd71f16 --- /dev/null +++ b/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)) diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index 95b957c3..b79cf48f 100644 --- a/pitfall/restructure/number.rkt +++ b/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)) diff --git a/pitfall/restructure/racket.rkt b/pitfall/restructure/racket.rkt index c938f1d4..2afb8c7a 100644 --- a/pitfall/restructure/racket.rkt +++ b/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 diff --git a/pitfall/restructure/stream-test.rkt b/pitfall/restructure/stream-test.rkt index 31e473d2..f0e0f707 100644 --- a/pitfall/restructure/stream-test.rkt +++ b/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 diff --git a/pitfall/restructure/stream.rkt b/pitfall/restructure/stream.rkt index c5b4a250..3b82df25 100644 --- a/pitfall/restructure/stream.rkt +++ b/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)) diff --git a/pitfall/restructure/utils.rkt b/pitfall/restructure/utils.rkt index eed52d49..55f63bdb 100644 --- a/pitfall/restructure/utils.rkt +++ b/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) \ No newline at end of file