cleaning up restructure
parent
0c1ddcbdf8
commit
665ce5d36f
@ -1,47 +0,0 @@
|
||||
#lang restructure/racket
|
||||
(require "number.rkt" "utils.rkt" "streamcoder.rkt")
|
||||
(provide RArray)
|
||||
|
||||
#|
|
||||
approximates
|
||||
https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
|
||||
|#
|
||||
|
||||
(define-subclass RStreamcoder (RArray type [length #f] [lengthType 'count])
|
||||
|
||||
(define/augment (decode stream [parent #f])
|
||||
(let ([length (cond
|
||||
[length
|
||||
(resolveLength length stream parent)]
|
||||
[else
|
||||
(define num (send stream length))
|
||||
(define denom (send type size))
|
||||
(unless (andmap (λ (x) (and x (number? x))) (list num denom))
|
||||
(raise-argument-error 'RArray:decode "valid length and size" (list num denom)))
|
||||
;; implied length: length of stream divided by size of item
|
||||
(floor (/ (send stream length) (send type size)))])])
|
||||
|
||||
(caseq lengthType
|
||||
[(count) (for/list ([i (in-range length)])
|
||||
(send type decode stream this))])))
|
||||
|
||||
(define/override (size array)
|
||||
(report array)
|
||||
(for/sum ([item (in-list array)])
|
||||
(report item)
|
||||
(send item size)))
|
||||
|
||||
(define/augment (encode stream array [parent #f])
|
||||
(for ([item (in-list array)])
|
||||
(send type encode stream item))))
|
||||
|
||||
|
||||
(test-module
|
||||
(require "decodestream.rkt" "encodestream.rkt")
|
||||
(define stream (make-object RDecodeStream #"ABCDEFG"))
|
||||
|
||||
(define A (make-object RArray uint16be 3))
|
||||
(check-equal? (send A decode stream) '(16706 17220 17734))
|
||||
(define os (make-object REncodeStream))
|
||||
(send A encode os '(16706 17220 17734))
|
||||
(check-equal? (send os dump) #"ABCDEF"))
|
||||
@ -1,39 +0,0 @@
|
||||
#lang restructure/racket
|
||||
(provide (all-defined-out))
|
||||
|
||||
#| approximates
|
||||
https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
|
||||
|#
|
||||
|
||||
(define (read-bytes-exact count p)
|
||||
(define bs (read-bytes count p))
|
||||
(unless (and (bytes? bs) (= (bytes-length bs) count))
|
||||
(raise-argument-error 'read-bytes-exact (format "byte string length ~a" count) bs))
|
||||
bs)
|
||||
|
||||
(provide (rename-out [type-sizes TYPES]))
|
||||
|
||||
(define type-sizes (let-values ([(intkeys intvalues)
|
||||
(for*/lists (intkeys intvalues)
|
||||
([signed (in-list '(U ""))]
|
||||
[size (in-list '(8 16 24 32))])
|
||||
(values
|
||||
(format "~aInt~a" signed size)
|
||||
(/ size 8)))])
|
||||
(for/hash ([key (in-list (append '(Float Double) intkeys))]
|
||||
[value (in-list (append '(4 8) intvalues))]
|
||||
#:when key
|
||||
[endian '("" BE LE)])
|
||||
(values (string->symbol (format "~a~a" key endian)) value))))
|
||||
|
||||
;; basically just a wrapper for a Racket port
|
||||
;; but needs to start with a buffer so length can be found
|
||||
(define-subclass object% (RDecodeStream [buffer #""])
|
||||
(field [_port (if (bytes? buffer)
|
||||
(open-input-bytes buffer)
|
||||
(raise-argument-error 'RDecodeStream "bytes" buffer))])
|
||||
(getter-field [pos (port-position _port)])
|
||||
(getter-field [length (bytes-length buffer)])
|
||||
|
||||
(define/public (read count)
|
||||
(read-bytes-exact count _port)))
|
||||
@ -1,19 +0,0 @@
|
||||
#lang restructure/racket
|
||||
(provide (all-defined-out))
|
||||
|
||||
#| approximates
|
||||
https://github.com/mbutterick/restructure/blob/master/src/EncodeStream.coffee
|
||||
|#
|
||||
|
||||
;; basically just a wrapper for a Racket outputport
|
||||
(define-subclass object% (REncodeStream [bufferSize 65536])
|
||||
(field [_port (open-output-bytes)])
|
||||
(getter-field [pos (port-position _port)])
|
||||
|
||||
(define/public (dump)
|
||||
(get-output-bytes _port))
|
||||
|
||||
(define/public (write val)
|
||||
(cond
|
||||
[(bytes? val) (write-bytes val _port) (void)]
|
||||
[else (error 'REncodeStream:write:unknown-type)])))
|
||||
@ -0,0 +1,35 @@
|
||||
#lang restructure/racket
|
||||
(provide type-sizes get-type-size)
|
||||
|
||||
(define-values (int-keys byte-values) (for*/lists (int-keys byte-values)
|
||||
([signed (in-list '("U" ""))]
|
||||
[bit-size (in-list '(8 16 24 32))])
|
||||
(values (format "~aInt~a" signed bit-size) (/ bit-size 8))))
|
||||
|
||||
(define type-sizes (for/hash ([type-key (in-list (append '("Float" "Double") int-keys))]
|
||||
[byte-value (in-list (append '(4 8) byte-values))]
|
||||
#:when #t
|
||||
[endian (in-list '("" "BE" "LE"))])
|
||||
(values (string->symbol (string-append type-key endian)) byte-value)))
|
||||
|
||||
(define (get-type-size key)
|
||||
(hash-ref type-sizes key (λ () (raise-argument-error 'DecodeStream:get-type-size "valid type" key))))
|
||||
|
||||
(test-module
|
||||
(check-equal? (get-type-size 'Int8) 1)
|
||||
(check-equal? (get-type-size 'UInt8) 1)
|
||||
(check-equal? (get-type-size 'UInt8BE) 1)
|
||||
(check-equal? (get-type-size 'Int16) 2)
|
||||
(check-equal? (get-type-size 'UInt16) 2)
|
||||
(check-equal? (get-type-size 'UInt16BE) 2)
|
||||
(check-equal? (get-type-size 'UInt16LE) 2)
|
||||
(check-equal? (get-type-size 'UInt32) 4)
|
||||
(check-equal? (get-type-size 'UInt32LE) 4)
|
||||
(check-equal? (get-type-size 'Int32BE) 4)
|
||||
(check-equal? (get-type-size 'Float) 4)
|
||||
(check-equal? (get-type-size 'FloatLE) 4)
|
||||
(check-equal? (get-type-size 'FloatBE) 4)
|
||||
(check-equal? (get-type-size 'Double) 8)
|
||||
(check-equal? (get-type-size 'DoubleLE) 8)
|
||||
(check-equal? (get-type-size 'DoubleBE) 8)
|
||||
(check-exn exn:fail:contract? (λ () (get-type-size 'not-a-type))))
|
||||
@ -0,0 +1,128 @@
|
||||
#lang restructure/racket
|
||||
(provide (all-defined-out))
|
||||
|
||||
;; helper class
|
||||
(define-subclass object% (PortWrapper _port)
|
||||
(unless (port? _port)
|
||||
(raise-argument-error 'PortWrapper:constructor "port" _port))
|
||||
(define/public-final (pos) (port-position _port))
|
||||
(define/public (dump) (void)))
|
||||
|
||||
(test-module
|
||||
(check-not-exn (λ () (make-object PortWrapper (open-input-bytes #"Foo"))))
|
||||
(check-not-exn (λ () (make-object PortWrapper (open-output-bytes))))
|
||||
(check-exn exn:fail? (λ () (make-object PortWrapper -42))))
|
||||
|
||||
#| approximates
|
||||
https://github.com/mbutterick/restructure/blob/master/src/EncodeStream.coffee
|
||||
|#
|
||||
|
||||
;; basically just a wrapper for a Racket output port
|
||||
(define-subclass* PortWrapper (EncodeStream [maybe-output-port (open-output-bytes)])
|
||||
|
||||
(unless (output-port? maybe-output-port)
|
||||
(raise-argument-error 'EncodeStream:constructor "output port" maybe-output-port))
|
||||
|
||||
(super-make-object maybe-output-port)
|
||||
(inherit-field _port)
|
||||
|
||||
(define/override-final (dump) (get-output-bytes _port))
|
||||
|
||||
(define/public-final (write val)
|
||||
(unless (bytes? val)
|
||||
(raise-argument-error 'EncodeStream:write "bytes" val))
|
||||
(void (write-bytes val (· this _port)))))
|
||||
|
||||
(test-module
|
||||
(define es (+EncodeStream))
|
||||
(check-true (EncodeStream? es))
|
||||
(send es write #"AB")
|
||||
(check-equal? (· es pos) 2)
|
||||
(send es write #"C")
|
||||
(check-equal? (· es pos) 3)
|
||||
(send es write #"D")
|
||||
(check-equal? (· es pos) 4)
|
||||
(check-exn exn:fail? (λ () (send es write -42)))
|
||||
(check-exn exn:fail? (λ () (send es write 1)))
|
||||
(define op (open-output-bytes))
|
||||
(define es2 (+EncodeStream op))
|
||||
(send es2 write #"FOOBAR")
|
||||
(check-equal? (send es2 dump) #"FOOBAR")
|
||||
(check-equal? (send es2 dump) #"FOOBAR") ; dump can repeat
|
||||
(check-equal? (get-output-bytes op) #"FOOBAR"))
|
||||
|
||||
|
||||
#| approximates
|
||||
https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
|
||||
|#
|
||||
|
||||
;; basically just a wrapper for a Racket port
|
||||
;; but needs to start with a buffer so length can be found
|
||||
(define-subclass* PortWrapper (DecodeStream [buffer #""])
|
||||
(unless (bytes? buffer)
|
||||
(raise-argument-error 'DecodeStream:constructor "bytes" buffer))
|
||||
|
||||
(super-make-object (open-input-bytes buffer))
|
||||
(inherit-field _port)
|
||||
|
||||
(getter-field [length (bytes-length buffer)])
|
||||
|
||||
(define/override-final (dump)
|
||||
(define current-position (port-position _port))
|
||||
(set-port-position! _port 0)
|
||||
(define bs (port->bytes _port))
|
||||
(set-port-position! _port current-position)
|
||||
bs)
|
||||
|
||||
(define/public-final (read count)
|
||||
(unless (index? count)
|
||||
(raise-argument-error 'DecodeStream:read "positive integer" count))
|
||||
(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))
|
||||
(read-bytes count _port)))
|
||||
|
||||
(test-module
|
||||
(define ds (+DecodeStream #"ABCD"))
|
||||
(check-true (DecodeStream? ds))
|
||||
(check-equal? (send ds dump) #"ABCD")
|
||||
(check-equal? (send ds dump) #"ABCD") ; dump can repeat
|
||||
(check-equal? (send ds read 2) #"AB")
|
||||
(check-equal? (send ds dump) #"ABCD")
|
||||
(check-equal? (· ds pos) 2)
|
||||
(check-equal? (send ds read 1) #"C")
|
||||
(check-equal? (· ds pos) 3)
|
||||
(check-equal? (send ds read 1) #"D")
|
||||
(check-equal? (· ds pos) 4)
|
||||
(check-exn exn:fail? (λ () (send ds read -42)))
|
||||
(check-exn exn:fail? (λ () (send ds read 1))))
|
||||
|
||||
|
||||
;; 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 stream (if (bytes? x) (+DecodeStream x) x))
|
||||
(unless (DecodeStream? stream)
|
||||
(raise-argument-error 'Streamcoder:decode "bytes or DecodeStream" x))
|
||||
(inner (void) decode stream . args))
|
||||
|
||||
(define/overment (encode x . args)
|
||||
(define stream (if (output-port? x) (+EncodeStream x) x))
|
||||
(unless (EncodeStream? stream)
|
||||
(raise-argument-error 'Streamcoder:encode "output port or EncodeStream" x))
|
||||
(inner (void) encode stream . args)))
|
||||
|
||||
(test-module
|
||||
(define-subclass Streamcoder (Dummy)
|
||||
(define/augment (decode stream) "foo")
|
||||
(define/augment (encode stream val) "bar")
|
||||
(define/override (size) 42))
|
||||
|
||||
(define d (+Dummy))
|
||||
(check-true (Dummy? d))
|
||||
(check-exn exn:fail:contract? (λ () (send d decode 42)))
|
||||
(check-not-exn (λ () (send d decode #"foo")))
|
||||
(check-exn exn:fail:contract? (λ () (send d encode 42 21)))
|
||||
(check-not-exn (λ () (send d encode (open-output-bytes) 42))))
|
||||
@ -1,18 +0,0 @@
|
||||
#lang restructure/racket
|
||||
(require "decodestream.rkt" "encodestream.rkt")
|
||||
(provide RStreamcoder)
|
||||
|
||||
(define-subclass RBase (RStreamcoder)
|
||||
(define/overment (decode x . args)
|
||||
(let loop ([x x])
|
||||
(cond
|
||||
[(bytes? x) (loop (open-input-bytes x))]
|
||||
[(or (is-a? x RDecodeStream) (not x)) (inner (void) decode x . args)]
|
||||
[else (raise-argument-error 'decode "item that can become RDecodeStream" x)])))
|
||||
|
||||
(define/overment (encode x . args)
|
||||
(let loop ([x x])
|
||||
(cond
|
||||
[(output-port? x) (loop (make-object REncodeStream x))]
|
||||
[(or (is-a? x REncodeStream) (not x)) (inner (void) encode x . args)]
|
||||
[else (raise-argument-error 'encode "item that can become REncodeStream" x)]))))
|
||||
Loading…
Reference in New Issue