|
|
#lang reader (submod "racket.rkt" reader)
|
|
|
(require "number.rkt" "utils.rkt" "stream.rkt")
|
|
|
(provide (all-defined-out))
|
|
|
|
|
|
#|
|
|
|
approximates
|
|
|
https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
|
|
|
|#
|
|
|
|
|
|
(define-subclass Streamcoder (ArrayT type [len #f] [length-type 'count])
|
|
|
|
|
|
(define/augride (decode stream [parent #f])
|
|
|
(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 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))]))
|
|
|
|
|
|
|
|
|
(define/augride (size [val #f] [ctx #f])
|
|
|
(when val (unless (countable? val)
|
|
|
(raise-argument-error 'Array:size "list or countable" val)))
|
|
|
(cond
|
|
|
[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 port array [parent #f])
|
|
|
(when array (unless (countable? array)
|
|
|
(raise-argument-error 'Array:encode "list or countable" array)))
|
|
|
|
|
|
(define (encode-items ctx)
|
|
|
(define results (for/list ([item (in-list (countable->list array))])
|
|
|
(send type encode port item ctx)))
|
|
|
(unless port (apply bytes-append results)))
|
|
|
|
|
|
(cond
|
|
|
[(NumberT? len) (define ctx (mhash 'pointers null
|
|
|
'startOffset (· port pos)
|
|
|
'parent parent))
|
|
|
(ref-set! ctx 'pointerOffset (+ (· port pos) (size array ctx)))
|
|
|
(send len encode port (length array)) ; encode length at front
|
|
|
(encode-items ctx)
|
|
|
(for ([ptr (in-list (· ctx pointers))]) ; encode pointer data at end
|
|
|
(send (· ptr type) encode port (· ptr val)))]
|
|
|
[else (encode-items parent)])))
|
|
|
|
|
|
(define-values (Array Array? +Array) (values ArrayT ArrayT? +ArrayT))
|
|
|
|
|
|
(test-module
|
|
|
(define A (+Array uint16be 3))
|
|
|
(check-equal? (decode A #"ABCDEFG") '(16706 17220 17734))
|
|
|
(check-equal? (encode A '(16706 17220 17734) #f) #"ABCDEF")
|
|
|
(check-equal? (size (+Array uint16be) '(1 2 3)) 6)
|
|
|
(check-equal? (size (+Array doublebe) '(1 2 3 4 5)) 40))
|