You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/pitfall/restructure/array.rkt

80 lines
3.4 KiB
Racket

7 years ago
#lang restructure/racket
7 years ago
(require "number.rkt" "utils.rkt" "stream.rkt")
7 years ago
(provide (all-defined-out))
7 years ago
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
|#
7 years ago
(define-subclass Streamcoder (ArrayT type [len #f] [length-type 'count])
(define/augride (decode stream [parent #f])
7 years ago
(define ctx (if (NumberT? len)
(mhasheq 'parent parent
'_startOffset (· stream pos)
'_currentOffset 0
'_length len)
parent))
7 years ago
(define decoded-len (resolve-length len stream parent))
(cond
7 years ago
[(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))]))
7 years ago
7 years ago
(define/override (size [val #f] [ctx #f])
(when val (unless (countable? val)
(raise-argument-error 'Array:size "list or countable" val)))
(cond
7 years ago
[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))]))
7 years ago
(define/augride (encode stream array [parent #f])
7 years ago
(when array (unless (countable? array)
(raise-argument-error 'Array:encode "list or countable" array)))
7 years ago
(define (encode-items ctx)
(for ([item (in-list (countable->list array))])
(send type encode stream item ctx)))
7 years ago
7 years ago
(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)])))
7 years ago
(define-values (Array Array? +Array) (values ArrayT ArrayT? +ArrayT))
(test-module
(define stream (+DecodeStream #"ABCDEFG"))
(define A (+Array uint16be 3))
(check-equal? (send A decode stream) '(16706 17220 17734))
(check-equal? (send A encode #f '(16706 17220 17734)) #"ABCDEF")
(check-equal? (send (+Array uint16be) size '(1 2 3)) 6)
(check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))