diff --git a/pitfall/restructure/helper.rkt b/pitfall/restructure/helper.rkt index 97186ed1..a2e84375 100644 --- a/pitfall/restructure/helper.rkt +++ b/pitfall/restructure/helper.rkt @@ -18,4 +18,6 @@ (- (bitwise-xor uint most-significant-bit-mask) most-significant-bit-mask)) (define (signed->unsigned sint bits) - (bitwise-and sint (arithmetic-shift 1 bits))) \ No newline at end of file + (bitwise-and sint (arithmetic-shift 1 bits))) + +(struct LazyThunk (proc) #:transparent) \ No newline at end of file diff --git a/pitfall/restructure/pointer-test.rkt b/pitfall/restructure/pointer-test.rkt index c7c50c5e..271db3a0 100644 --- a/pitfall/restructure/pointer-test.rkt +++ b/pitfall/restructure/pointer-test.rkt @@ -1,5 +1,5 @@ #lang restructure/racket -(require "pointer.rkt" "stream.rkt" "buffer.rkt" "base.rkt" "number.rkt" rackunit) +(require "pointer.rkt" "stream.rkt" "buffer.rkt" "base.rkt" "number.rkt" "struct.rkt" rackunit) #| approximates @@ -91,7 +91,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee (check-equal? (send pointer decode stream (mhash '_startOffset 0)) 4)) -; todo: skipped lazy pointers for now + ; it 'should support decoding pointers lazily', -> ; stream = new DecodeStream new Buffer [1, 53] ; struct = new Struct @@ -101,7 +101,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee ; Object.getOwnPropertyDescriptor(res, 'ptr').get.should.be.a('function') ; Object.getOwnPropertyDescriptor(res, 'ptr').enumerable.should.equal(true) ; res.ptr.should.equal 53 -; + +(let ([stream (+DecodeStream (+Buffer '(1 53)))] + [struct (+Struct (dictify 'ptr (+Pointer uint8 uint8 (mhasheq 'lazy #t))))]) + (define res (send struct decode stream)) + (check-true (LazyThunk? (hash-ref (get-field kv res) 'ptr))) + (check-equal? (· res ptr) 53)) diff --git a/pitfall/restructure/pointer.rkt b/pitfall/restructure/pointer.rkt index 2e080b21..5d068a13 100644 --- a/pitfall/restructure/pointer.rkt +++ b/pitfall/restructure/pointer.rkt @@ -1,4 +1,5 @@ #lang restructure/racket +(require racket/undefined) (provide (all-defined-out)) #| @@ -38,12 +39,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [else (error 'unknown-pointer-style)]) (relative-getter-or-0 ctx))) (define ptr (+ offset relative)) - (cond ; omitted: lazy pointer implementation - [type (define orig-pos (· stream pos)) - (send stream pos ptr) - (define val (send type decode stream ctx)) - (send stream pos orig-pos) - val] + (cond + [type (define val undefined) + (define (decode-value) + (cond + [(not (eq? val undefined)) val] + [else + (define orig-pos (· stream pos)) + (send stream pos ptr) + (set! val (send type decode stream ctx)) + (send stream pos orig-pos) + val])) + (if lazy + (LazyThunk decode-value) + (decode-value))] [else ptr])])) diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 20a2fa31..44003700 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -11,19 +11,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (define private-keys '(parent _startOffset _currentOffset _length)) +(define (choose-dict d k) + (if (memq k private-keys) + (get-field pvt d) + (get-field kv d))) + (define dictable<%> (interface* () ([(generic-property gen:dict) (generic-method-table gen:dict - (define (dict-set! d k v) (d:dict-set! (if (memq k private-keys) - (get-field pvt d) - (get-field kv d)) k v)) - (define (dict-ref d k [thunk #f]) (d:dict-ref (if (memq k private-keys) - (get-field pvt d) - (get-field kv d)) k thunk)) - (define (dict-remove! d k) (d:dict-remove! (if (memq k private-keys) - (get-field pvt d) - (get-field kv d)) k)) + (define (dict-set! d k v) (d:dict-set! (choose-dict d k) k v)) + (define (dict-ref d k [thunk #f]) + (define res (d:dict-ref (choose-dict d k) k thunk)) + (if (LazyThunk? res) ((LazyThunk-proc res)) res)) + (define (dict-remove! d k) (d:dict-remove! (choose-dict d k) k)) ;; public keys only (define (dict-keys d) (d:dict-keys (get-field kv d))))] [(generic-property gen:custom-write) @@ -93,7 +94,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee 'pointerSize 0)) (+ (for/sum ([(key type) (in-dict fields)] #:when val) - (send type size (ref val key) ctx)) + (send type size (ref val key) ctx)) (if include-pointers (· ctx pointerSize) 0))) (define/augride (encode stream val [parent #f]) @@ -112,9 +113,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (raise-argument-error 'Struct:encode (format "dict that contains superset of Struct keys: ~a" (dict-keys fields)) (dict-keys val))) (for ([(key type) (in-dict fields)]) - (send type encode stream (ref val key) ctx)) + (send type encode stream (ref val key) ctx)) (for ([ptr (in-list (· ctx pointers))]) - (send (· ptr type) encode stream (· ptr val) (· ptr parent))))) + (send (· ptr type) encode stream (· ptr val) (· ptr parent))))) (test-module @@ -124,15 +125,15 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee ;; make random structs and make sure we can round trip (for ([i (in-range 20)]) - (define field-types (for/list ([i (in-range 40)]) - (random-pick (list uint8 uint16be uint16le uint32be uint32le double)))) - (define size-num-types (for/sum ([num-type (in-list field-types)]) - (send num-type size))) - (define s (+Struct (for/list ([num-type (in-list field-types)]) - (cons (gensym) num-type)))) - (define bs (apply bytes (for/list ([i (in-range size-num-types)]) - (random 256)))) - (check-equal? (send s encode #f (send s decode bs)) bs))) + (define field-types (for/list ([i (in-range 40)]) + (random-pick (list uint8 uint16be uint16le uint32be uint32le double)))) + (define size-num-types (for/sum ([num-type (in-list field-types)]) + (send num-type size))) + (define s (+Struct (for/list ([num-type (in-list field-types)]) + (cons (gensym) num-type)))) + (define bs (apply bytes (for/list ([i (in-range size-num-types)]) + (random 256)))) + (check-equal? (send s encode #f (send s decode bs)) bs)))