mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

move xenomorphs to separate package

Browse Source
main
Matthew Butterick 6 years ago
parent 3f0a33c61b
commit f4627a1a71
50 changed files with 0 additions and 3530 deletions
Show Stats Download Patch File Download Diff File

5
pitfall/xenomorph/array.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/array.rkt")

5
pitfall/xenomorph/base.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/base.rkt")

5
pitfall/xenomorph/bitfield.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/bitfield.rkt")

5
pitfall/xenomorph/buffer.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/buffer.rkt")

5
pitfall/xenomorph/enum.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/enum.rkt")

3
pitfall/xenomorph/info.rkt
Unescape Escape View File

@ -1,3 +0,0 @@
#lang info
(define compile-omit-paths '("test/test.rkt" "test/~stream.test.rkt" "private/~stream.rkt"))

5
pitfall/xenomorph/lazy-array.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/lazy-array.rkt")

17
pitfall/xenomorph/main.rkt
Unescape Escape View File

@ -1,17 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "array.rkt"
"base.rkt"
"bitfield.rkt"
"buffer.rkt"
"enum.rkt"
"lazy-array.rkt"
"number.rkt"
"optional.rkt"
"pointer.rkt"
"reserved.rkt"
"string.rkt"
"struct.rkt"
"versioned-struct.rkt")

5
pitfall/xenomorph/number.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/number.rkt")

5
pitfall/xenomorph/optional.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/optional.rkt")

5
pitfall/xenomorph/pointer.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/pointer.rkt")

84
pitfall/xenomorph/private/array.rkt
Unescape Escape View File

@ -1,84 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require "number.rkt" "utils.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
|#
(define-subclass xenomorph-base% (ArrayT type [len #f] [length-type 'count])
(define/augride (decode port [parent #f])
(define ctx (if (NumberT? len)
(mhasheq 'parent parent
'_startOffset (pos port)
'_currentOffset 0
'_length len)
parent))
(define decoded-len (resolve-length len port parent))
(cond
[(or (not decoded-len) (eq? length-type 'bytes))
(define end-pos (cond
;; decoded-len is byte length
[decoded-len (+ (pos port) 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 +inf.0]))
(for/list ([i (in-naturals)]
#:break (or (eof-object? (peek-byte port)) (= (pos port) end-pos)))
(send type decode port ctx))]
;; we have decoded-len, which is treated as count of items
[else (for/list ([i (in-range decoded-len)])
(send type decode port ctx))]))
(define/augride (size [val #f] [ctx #f])
(when val (unless (countable? val)
(raise-argument-error 'Array:size "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)
(let* ([items (countable->list array)]
[item-count (length items)]
[max-items (if (number? len) len item-count)])
(unless (= item-count max-items)
(raise-argument-error 'Array:encode (format "list or countable with ~a items" max-items) items))
(for ([item (in-list items)])
(send type encode port item ctx))))
(cond
[(NumberT? len) (define ctx (mhash 'pointers null
'startOffset (pos port)
'parent parent))
(ref-set! ctx 'pointerOffset (+ (pos port) (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-procedures (Array Array? +Array) (ArrayT ArrayT? +ArrayT))
(define-procedures (array% array? array) (ArrayT ArrayT? +ArrayT))
(test-module
(check-equal? (decode (+Array uint16be 3) #"ABCDEF") '(16706 17220 17734))
(check-equal? (encode (+Array uint16be 3) '(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))

116
pitfall/xenomorph/private/base.rkt
Unescape Escape View File

@ -1,116 +0,0 @@
#lang racket/base
(require racket/class sugar/class racket/generic racket/private/generic-methods "generic.rkt" racket/port racket/dict racket/function)
(require sugar/debug)
(provide (all-defined-out))
(define-generics posable
(pos posable [new-pos])
#:defaults
([port? (define (pos p [new-pos #f]) (when new-pos
(file-position p new-pos))
(file-position p))]))
(define posable<%>
(interface* ()
([(generic-property gen:posable)
(generic-method-table gen:posable
(define (pos o [new-pos #f]) (send o pos new-pos)))])))
(define-generics codable
(decode codable #:parent [parent] [stream])
(encode codable [val] [stream] #:parent [parent]))
(define codable<%>
(interface* ()
([(generic-property gen:codable)
(generic-method-table gen:codable
(define (decode o [port (current-input-port)] #:parent [parent #f])
(send o decode port parent))
(define (encode o [val #f] [port (current-output-port)] #:parent [parent #f])
(when (port? val)
(raise-argument-error 'encode "encodable value" val))
(send o encode port val parent)))])))
(define-generics sizable
(size sizable [val] [parent]))
(define sizable<%>
(interface* ()
([(generic-property gen:sizable)
(generic-method-table gen:sizable
(define (size o [val #f] [parent #f]) (send o size val parent)))])))
(define (dump x)
(define (dump-dict x)
(for/list ([(k v) (in-dict x)])
(cons (dump k) (dump v))))
(let loop ([x x])
(cond
[(input-port? x) (port->bytes x)]
[(output-port? x) (get-output-bytes x)]
[(and (object? x)
(memq 'dump (interface->method-names (object-interface x)))) (send x dump)]
[(dict? x) (dump-dict x)]
[(list? x) (map loop x)]
[else x])))
#;(define dumpable<%>
(interface* ()
([(generic-property gen:dumpable)
(generic-method-table gen:dumpable
(define (dump o) (send o dump)))])))
(define (symbol-append . syms)
(string->symbol (apply string-append (map symbol->string syms))))
(define xenomorph-base%
(class* object% (codable<%> sizable<%>)
(super-new)
(field [_hash (make-hash)]
[_list null])
(define/pubment (decode port [parent #f] . args)
(when parent (unless (indexable? parent)
(raise-argument-error (symbol-append (get-class-name) ':decode) "indexable" parent)))
(define ip (cond
[(bytes? port) (open-input-bytes port)]
[(input-port? port) port]
[else (raise-argument-error (symbol-append (get-class-name) ':decode) "bytes or input port" port)]))
(post-decode (inner (void) decode ip parent) port parent . args))
(define/pubment (encode port val-in [parent #f] . args)
#;(report* port val-in parent)
(define val (pre-encode val-in port))
(when parent (unless (indexable? parent)
(raise-argument-error (symbol-append (get-class-name) ':encode) "indexable" parent)))
(define op (cond
[(output-port? port) port]
[(not port) (open-output-bytes)]
[else (raise-argument-error 'Xenomorph "output port or #f" port)]))
(define encode-result (inner (void) encode op val parent . args))
(when (bytes? encode-result)
(write-bytes encode-result op))
(when (not port) (get-output-bytes op)))
(define/pubment (size [val #f] [parent #f] . args)
(when parent (unless (indexable? parent)
(raise-argument-error (symbol-append (get-class-name) ':size) "indexable" parent)))
(define result (inner (void) size val parent . args))
(cond
[(void? result) 0]
[(and (integer? result) (not (negative? result))) result]
[else (raise-argument-error (symbol-append (get-class-name) ':size) "nonnegative integer" result)]))
(define/public (get-class-name) (define-values (name _) (object-info this))
(or name 'Xenomorph))
(define/public (post-decode val . _) val)
(define/public (pre-encode val . _) val)
(define/public (dump) (void))))
(define-class-predicates xenomorph-base%)
(define-subclass xenomorph-base% (RestructureBase))
(define-subclass RestructureBase (Streamcoder))

44
pitfall/xenomorph/private/bitfield.rkt
Unescape Escape View File

@ -1,44 +0,0 @@
#lang racket/base
(require "racket.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
|#
(define-subclass Streamcoder (Bitfield type [flags empty])
(unless (andmap (λ (f) (or (key? f) (not f))) flags)
(raise-argument-error 'Bitfield "list of keys" flags))
(define/augment (decode stream . _)
(define flag-hash (mhasheq))
(for* ([val (in-value (send type decode stream))]
[(flag i) (in-indexed flags)]
#:when flag)
(hash-set! flag-hash flag (bitwise-bit-set? val i)))
flag-hash)
(define/augment (size . _) (send type size))
(define/augment (encode port flag-hash [ctx #f])
(define bit-int (for/sum ([(flag i) (in-indexed flags)]
#:when (and flag (ref flag-hash flag)))
(arithmetic-shift 1 i)))
(send type encode port bit-int))
(define/override (get-class-name) 'Bitfield))
(test-module
(require "number.rkt")
(define bfer (+Bitfield uint16be '(bold italic underline #f shadow condensed extended)))
(define bf (send bfer decode #"\0\25"))
(check-equal? (length (ref-keys bf)) 6) ; omits #f flag
(check-true (ref bf 'bold))
(check-true (ref bf 'underline))
(check-true (ref bf 'shadow))
(check-false (ref bf 'italic))
(check-false (ref bf 'condensed))
(check-false (ref bf 'extended))
(check-equal? (encode bfer bf #f) #"\0\25"))

56
pitfall/xenomorph/private/buffer.rkt
Unescape Escape View File

@ -1,56 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require "number.rkt" "utils.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
|#
#|
A Buffer is a container object for any data object that supports random access
A Node Buffer object is basically a byte string.
First argument must be a string, Buffer, ArrayBuffer, Array, or array-like object.
A Restructure RBuffer object is separate.
|#
(define (+Buffer xs [type #f])
((if (string? xs)
string->bytes/utf-8
list->bytes) xs))
(define-subclass xenomorph-base% (RBuffer [len #xffff])
(define/augment (decode port [parent #f])
(define decoded-len (resolve-length len port parent))
(read-bytes decoded-len port))
(define/augment (size [val #f] [parent #f])
(when val (unless (bytes? val)
(raise-argument-error 'Buffer:size "bytes" val)))
(if val
(bytes-length val)
(resolve-length len val parent)))
(define/augment (encode port buf [parent #f])
(unless (bytes? buf)
(raise-argument-error 'Buffer:encode "bytes" buf))
(define op (or port (open-output-bytes)))
(when (NumberT? len)
(send len encode op (length buf)))
(write-bytes buf op)
(unless port (get-output-bytes op))))
(define-subclass RBuffer (BufferT))
#;(test-module
(require "stream.rkt")
(define stream (+DecodeStream #"\2BCDEF"))
(define S (+String uint8 'utf8))
(check-equal? (send S decode stream) "BC")
(define os (+EncodeStream))
(send S encode os "Mike")
(check-equal? (send os dump) #"\4Mike")
(check-equal? (send (+String) size "foobar") 6))

23
pitfall/xenomorph/private/enum.rkt
Unescape Escape View File

@ -1,23 +0,0 @@
#lang racket/base
(require "racket.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
|#
(define-subclass xenomorph-base% (Enum type [options empty])
(define/augment (decode stream . _)
(define index (send type decode stream))
(or (list-ref options index) index))
(define/augment (size . _) (send type size))
(define/augment (encode stream val [ctx #f])
(define index (index-of options val))
(unless index
(raise-argument-error 'Enum:encode "valid option" val))
(send type encode stream index)))

110
pitfall/xenomorph/private/generic.rkt
Unescape Escape View File

@ -1,110 +0,0 @@
#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 [thunk])
(ref! indexable i [thunk])
(ref-set! indexable i v)
(ref-keys indexable)
#:defaults
([hash? (define (ref o i [thunk #f]) (hash-ref o i thunk))
(define (ref! o i [thunk #f]) (hash-ref! o i thunk))
(define ref-set! hash-set!)
(define ref-keys hash-keys)]
[dict? (define (ref o i [thunk #f]) (dict-ref o i thunk))
(define (ref! o i [thunk #f]) (dict-ref o i thunk))
(define ref-set! dict-set!)
(define ref-keys dict-keys)]
[object? (define (ref o i [thunk #f]) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i thunk))]) (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)))
(define (ref-keys o) (append (remove '_hash (field-names o)) (hash-keys (get-field _hash o))))]))
(module+ test
(require rackunit racket/set)
(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)
(check-equal? (apply set (ref-keys h)) (apply set '(foo bar)))
(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)
(check-equal? (apply set (ref-keys o)) (apply set '(foo bar))))
(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)
(countable->list countable)
#:defaults
([list? (define length b:length)
(define countable->list (λ (x) x))]
[vector? (define length vector-length)
(define countable->list vector->list)]
[string? (define length string-length)
(define countable->list string->list)]
[bytes? (define length bytes-length)
(define countable->list bytes->list)]
[dict? (define length dict-count)
(define countable->list (λ (x) x))]
[object? (define (length o) (b:length (get-field _list o)))
(define (countable->list o) (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))
(define-generics pushable
(push-end pushable xs)
#:defaults
([list? (define push-end b:append)]
[object? (define (push-end o xs)
(append (get-field _list o) xs))]))
(module+ test
(check-equal? (push-end (range 3) '(3 4 5)) (range 6))
(define o2 (make-object (class object% (super-new) (field [_list (range 3)]))))
(ref-set! o2 '_list (push-end o2 '(3 4 5)))
(check-equal? (ref o2 '_list) (range 6)))

23
pitfall/xenomorph/private/helper.rkt
Unescape Escape View File

@ -1,23 +0,0 @@
#lang racket/base
(require (for-syntax racket/base br/syntax) racket/class br/define "base.rkt")
(provide (all-defined-out) (all-from-out "base.rkt"))
(define-macro (test-module . EXPRS)
#`(module+ test
(require #,(datum->syntax caller-stx 'rackunit) #,(datum->syntax caller-stx 'racket/serialize))
. EXPRS))
(define index? (λ (x) (and (number? x) (integer? x) (not (negative? x)))))
(define key? symbol?)
(define (keys? x) (and (pair? x) (andmap key? x)))
(define (unsigned->signed uint bits)
(define most-significant-bit-mask (arithmetic-shift 1 (sub1 bits)))
(- (bitwise-xor uint most-significant-bit-mask) most-significant-bit-mask))
(define (signed->unsigned sint bits)
(bitwise-and sint (arithmetic-shift 1 bits)))
(struct LazyThunk (proc) #:transparent)

77
pitfall/xenomorph/private/lazy-array.rkt
Unescape Escape View File

@ -1,77 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require "utils.rkt" "array.rkt" "number.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
|#
(define (get o i) (send o get i))
(define (LazyArray->list o) (send o to-list))
(define-subclass object% (InnerLazyArray type [len #f] [port-in #f] [ctx #f])
(field ([port port] (cond
[(bytes? port-in) (open-input-bytes port-in)]
[(port? port-in) port-in]
[else (raise-argument-error 'LazyArray "port" port)])))
(define starting-pos (pos port))
(define item-cache (mhasheqv)) ; integer-keyed hash, rather than list
(define/public-final (get index)
(unless (<= 0 index (sub1 len))
(raise-argument-error 'LazyArray:get (format "index in range 0 to ~a" (sub1 len)) index))
(ref! item-cache index (λ ()
(define orig-pos (pos port))
(pos port (+ starting-pos (* (send type size #f ctx) index)))
(define new-item (send type decode port ctx))
(pos port orig-pos)
new-item)))
(define/public-final (to-list)
(for/list ([i (in-range len)])
(get i))))
(define-subclass ArrayT (LazyArray)
(inherit-field len type)
(define/override (decode port [parent #f])
(define starting-pos (pos port)) ; ! placement matters. `resolve-length` will change `pos`
(define decoded-len (resolve-length len port parent))
(let ([parent (if (NumberT? len)
(mhasheq 'parent parent
'_startOffset starting-pos
'_currentOffset 0
'_length len)
parent)])
(define res (+InnerLazyArray type decoded-len port parent))
(pos port (+ (pos port) (* decoded-len (send type size #f parent))))
res))
(define/override (size [val #f] [ctx #f])
(super size (if (InnerLazyArray? val)
(send val to-list)
val) ctx))
(define/override (encode port val [ctx #f])
(super encode port (if (InnerLazyArray? val)
(send val to-list)
val) ctx)))
(test-module
(define bstr #"ABCD1234")
(define ds (open-input-bytes bstr))
(define la (+LazyArray uint8 4))
(define ila (decode la ds))
(check-equal? (pos ds) 4)
(check-equal? (get ila 1) 66)
(check-equal? (get ila 3) 68)
(check-equal? (pos ds) 4)
(check-equal? (LazyArray->list ila) '(65 66 67 68))
(define la2 (+LazyArray int16be (λ (t) 4)))
(check-equal? (encode la2 '(1 2 3 4) #f) #"\0\1\0\2\0\3\0\4")
(check-equal? (send (decode la2 (open-input-bytes #"\0\1\0\2\0\3\0\4")) to-list) '(1 2 3 4)))

189
pitfall/xenomorph/private/number.rkt
Unescape Escape View File

@ -1,189 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require "sizes.rkt" (for-syntax "sizes.rkt" racket/match))
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
|#
(define (ends-with-8? type)
(define str (symbol->string type))
(equal? (substring str (sub1 (string-length str))) "8"))
(define (signed-type? type)
(not (equal? "u" (substring (symbol->string type) 0 1))))
(test-module
(check-false (signed-type? 'uint16))
(check-true (signed-type? 'int16)))
(define (exact-if-possible x) (if (integer? x) (inexact->exact x) x))
(define system-endian (if (system-big-endian?) 'be 'le))
(define-subclass xenomorph-base% (Integer [type 'uint16] [endian system-endian])
(getter-field [number-type (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))])
(define _signed? (signed-type? type))
;; `get-type-size` will raise error if number-type is invalid: use this as check of input
;; size of a number doesn't change, so we can stash it as `_size`
(define _size (with-handlers ([exn:fail:contract?
(λ (exn)
(raise-argument-error 'Integer "valid type and endian" (format "~v ~v" type endian)))])
(get-type-size number-type)))
(define bits (* _size 8))
(define/augment (size . args) _size)
(define-values (bound-min bound-max)
;; if a signed integer has n bits, it can contain a number between - (expt 2 (sub1 n)) and (sub1 (expt 2 (sub1 n)).
(let* ([signed-max (sub1 (arithmetic-shift 1 (sub1 bits)))]
[signed-min (sub1 (- signed-max))]
[delta (if _signed? 0 signed-min)])
(values (- signed-min delta) (- signed-max delta))))
(define/augment (decode port [parent #f])
(define bstr (read-bytes _size port))
(define bs ((if (eq? endian system-endian) identity reverse) (bytes->list bstr)))
(define unsigned-int (for/sum ([(b i) (in-indexed bs)])
(arithmetic-shift b (* 8 i))))
unsigned-int)
(define/override (post-decode unsigned-val . _)
(if _signed? (unsigned->signed unsigned-val bits) unsigned-val))
(define/override (pre-encode val . _)
(exact-if-possible val))
(define/augment (encode port val [parent #f])
(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))
(define-values (bs _) (for/fold ([bs empty] [n val])
([i (in-range _size)])
(values (cons (bitwise-and n #xff) bs) (arithmetic-shift n -8))))
(apply bytes ((if (eq? endian 'be) identity reverse) bs))))
(define-values (NumberT NumberT? +NumberT) (values Integer Integer? +Integer))
(define-values (Number Number? +Number) (values Integer Integer? +Integer))
(define-subclass xenomorph-base% (Float _size [endian system-endian])
(define byte-size (/ _size 8))
(define/augment (decode port [parent #f]) ; convert int to float
(define bs (read-bytes byte-size port))
(floating-point-bytes->real bs (eq? endian 'be)))
(define/augment (encode port val [parent #f]) ; convert float to int
(define bs (real->floating-point-bytes val byte-size (eq? endian 'be)))
bs)
(define/augment (size . args) byte-size))
(define-instance float (make-object Float 32))
(define-instance floatbe (make-object Float 32 'be))
(define-instance floatle (make-object Float 32 'le))
(define-instance double (make-object Float 64))
(define-instance doublebe (make-object Float 64 'be))
(define-instance doublele (make-object Float 64 'le))
(define-subclass* Integer (Fixed size [fixed-endian system-endian] [fracBits (floor (/ size 2))])
(super-make-object (string->symbol (format "int~a" size)) fixed-endian)
(define _point (arithmetic-shift 1 fracBits))
(define/override (post-decode int . _)
(exact-if-possible (/ int _point 1.0)))
(define/override (pre-encode fixed . _)
(exact-if-possible (floor (* fixed _point)))))
(define-instance fixed16 (make-object Fixed 16))
(define-instance fixed16be (make-object Fixed 16 'be))
(define-instance fixed16le (make-object Fixed 16 'le))
(define-instance fixed32 (make-object Fixed 32))
(define-instance fixed32be (make-object Fixed 32 'be))
(define-instance fixed32le (make-object Fixed 32 'le))
(test-module
(check-exn exn:fail:contract? (λ () (+Integer 'not-a-valid-type)))
(check-exn exn:fail:contract? (λ () (encode uint8 256 #f)))
(check-not-exn (λ () (encode uint8 255 #f)))
(check-exn exn:fail:contract? (λ () (encode int8 256 #f)))
(check-exn exn:fail:contract? (λ () (encode int8 255 #f)))
(check-not-exn (λ () (encode int8 127 #f)))
(check-not-exn (λ () (encode int8 -128 #f )))
(check-exn exn:fail:contract? (λ () (encode int8 -129 #f)))
(check-exn exn:fail:contract? (λ () (encode uint16 (add1 #xffff) #f)))
(check-not-exn (λ () (encode uint16 #xffff #f)))
(let ([o (+Integer 'uint16 'le)]
[ip (open-input-bytes (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (send o decode ip) 513) ;; 1000 0000 0100 0000
(check-equal? (send o decode ip) 1027) ;; 1100 0000 0010 0000
(encode o 513 op)
(check-equal? (get-output-bytes op) (bytes 1 2))
(encode o 1027 op)
(check-equal? (get-output-bytes op) (bytes 1 2 3 4)))
(let ([o (+Integer 'uint16 'be)]
[ip (open-input-bytes (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000
(check-equal? (send o decode ip) 772) ;; 0010 0000 1100 0000
(encode o 258 op)
(check-equal? (get-output-bytes op) (bytes 1 2))
(encode o 772 op)
(check-equal? (get-output-bytes op) (bytes 1 2 3 4))))
(test-module
(check-equal? (send (+Integer 'uint8) size) 1)
(check-equal? (send (+Integer) size) 2)
(check-equal? (send (+Integer 'uint32) size) 4)
(check-equal? (send (+Integer 'double) size) 8)
(check-equal? (send (+Number 'uint8) size) 1)
(check-equal? (send (+Number) size) 2)
(check-equal? (send (+Number 'uint32) size) 4)
(check-equal? (send (+Number 'double) size) 8))
;; use keys of type-sizes hash to generate corresponding number definitions
(define-macro (make-int-types)
(with-pattern ([((ID BASE ENDIAN) ...) (for*/list ([k (in-hash-keys type-sizes)]
[kstr (in-value (format "~a" k))]
#:unless (regexp-match #rx"^(float|double)" kstr))
(match-define (list* prefix suffix _)
(regexp-split #rx"(?=[bl]e|$)" kstr))
(map string->symbol
(list (string-downcase kstr)
prefix
(if (positive? (string-length suffix))
suffix
(if (system-big-endian?) "be" "le")))))]
[(ID ...) (suffix-id #'(ID ...) #:context caller-stx)])
#'(begin (define-instance ID (make-object Integer 'BASE 'ENDIAN)) ...)))
(make-int-types)
(test-module
(check-equal? (size uint8) 1)
(check-equal? (size uint16) 2)
(check-equal? (size uint32) 4)
(check-equal? (size double) 8)
(define bs (encode fixed16be 123.45 #f))
(check-equal? bs #"{s")
(check-equal? (ceiling (* (decode fixed16be bs) 100)) 12345.0)
(check-equal? (decode int8 (bytes 127)) 127)
(check-equal? (decode int8 (bytes 255)) -1)
(check-equal? (encode int8 -1 #f) (bytes 255))
(check-equal? (encode int8 127 #f) (bytes 127)))

28
pitfall/xenomorph/private/optional.rkt
Unescape Escape View File

@ -1,28 +0,0 @@
#lang racket/base
(require "racket.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee
|#
(define-subclass xenomorph-base% (Optional type [condition #t])
(define (resolve-condition parent)
(if (procedure? condition)
(condition parent)
condition))
(define/augment (decode stream parent)
(when (resolve-condition parent)
(send type decode stream parent)))
(define/augment (size val parent)
(when (resolve-condition parent)
(send type size val parent)))
(define/augment (encode stream val parent)
(when (resolve-condition parent)
(send type encode stream val parent))))

102
pitfall/xenomorph/private/pointer.rkt
Unescape Escape View File

@ -1,102 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require racket/undefined)
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
|#
(define (resolve-void-pointer type val)
(cond
[type (values type val)]
[(VoidPointer? val) (values (· val type) (· val value))]
[else (raise-argument-error 'Pointer:size "VoidPointer" val)]))
(define (find-top-ctx ctx)
(cond
[(· ctx parent) => find-top-ctx]
[else ctx]))
(define-subclass xenomorph-base% (Pointer offset-type type-in [options (mhasheq)])
(field [type (and (not (eq? type-in 'void)) type-in)])
(define pointer-style (or (· options type) 'local))
(define allow-null (or (· options allowNull) #t))
(define null-value (or (· options nullValue) 0))
(define lazy (· options lazy))
(define relative-getter-or-0 (or (· options relativeTo) (λ (ctx) 0))) ; changed this to a simple lambda
(define/augment (decode port [ctx #f])
(define offset (send offset-type decode port ctx))
(cond
[(and allow-null (= offset null-value)) #f] ; handle null pointers
[else
(define relative (+ (caseq pointer-style
[(local) (· ctx _startOffset)]
[(immediate) (- (pos port) (send offset-type size))]
[(parent) (· ctx parent _startOffset)]
[(global) (or (· (find-top-ctx ctx) _startOffset) 0)]
[else (error 'unknown-pointer-style)])
(relative-getter-or-0 ctx)))
(define ptr (+ offset relative))
(cond
[type (define val (void))
(define (decode-value)
(cond
[(not (void? val)) val]
[else
(define orig-pos (pos port))
(pos port ptr)
(set! val (send type decode port ctx))
(pos port orig-pos)
val]))
(if lazy
(LazyThunk decode-value)
(decode-value))]
[else ptr])]))
(define/augment (size [val #f] [ctx #f])
(let*-values ([(parent) ctx]
[(ctx) (caseq pointer-style
[(local immediate) ctx]
[(parent) (· ctx parent)]
[(global) (find-top-ctx ctx)]
[else (error 'unknown-pointer-style)])]
[(type val) (resolve-void-pointer type val)])
(when (and val ctx)
(ref-set! ctx 'pointerSize (and (· ctx pointerSize)
(+ (· ctx pointerSize) (send type size val parent)))))
(send offset-type size)))
(define/augment (encode port val [ctx #f])
(unless ctx
;; todo: furnish default pointer context? adapt from Struct?
(raise-argument-error 'Pointer:encode "valid pointer context" ctx))
(if (not val)
(send offset-type encode port null-value)
(let* ([parent ctx]
[ctx (caseq pointer-style
[(local immediate) ctx]
[(parent) (· ctx parent)]
[(global) (find-top-ctx ctx)]
[else (error 'unknown-pointer-style)])]
[relative (+ (caseq pointer-style
[(local parent) (· ctx startOffset)]
[(immediate) (+ (pos port) (send offset-type size val parent))]
[(global) 0])
(relative-getter-or-0 (· parent val)))])
(send offset-type encode port (- (· ctx pointerOffset) relative))
(let-values ([(type val) (resolve-void-pointer type val)])
(ref-set! ctx 'pointers (append (· ctx pointers) (list (mhasheq 'type type
'val val
'parent parent))))
(ref-set! ctx 'pointerOffset (+ (· ctx pointerOffset) (send type size val parent))))))))
;; A pointer whose type is determined at decode time
(define-subclass object% (VoidPointer type value))

33
pitfall/xenomorph/private/racket.rkt
Unescape Escape View File

@ -1,33 +0,0 @@
#lang racket/base
(require (for-syntax racket/base br/syntax) br/define)
(provide (for-syntax (all-from-out racket/base br/syntax)))
(provide (all-from-out racket/base) r+p)
(define-macro (r+p ID ...)
#'(begin (require ID ...) (provide (all-from-out ID ...))))
(r+p "helper.rkt"
"generic.rkt"
sugar/debug
racket/class
racket/list
racket/string
racket/function
br/define
sugar/define
sugar/class
sugar/js
sugar/dict
sugar/stub
sugar/port
sugar/case)
(provide define-procedures)
(define-macro (define-procedures (NEW ...) (OLD ...))
#'(define-values (NEW ...)
(values (if (procedure? OLD)
(procedure-rename OLD 'NEW)
OLD) ...)))
(module reader syntax/module-reader
#:language 'xenomorph/private/racket)

22
pitfall/xenomorph/private/reserved.rkt
Unescape Escape View File

@ -1,22 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require "utils.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
|#
(define-subclass xenomorph-base% (Reserved type [count 1])
(define/augment (decode port parent)
(pos port (+ (pos port) (size #f parent)))
(void))
(define/augment (size [val #f] [parent #f])
(* (send type size) (resolve-length count #f parent)))
(define/augment (encode port val [parent #f])
(make-bytes (size val parent) 0)))

36
pitfall/xenomorph/private/sizes.rkt
Unescape Escape View File

@ -1,36 +0,0 @@
#lang racket/base
(require "racket.rkt")
(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))))

106
pitfall/xenomorph/private/string.rkt
Unescape Escape View File

@ -1,106 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require "number.rkt" "utils.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/String.coffee
|#
(define (read-encoded-string port len [encoding 'ascii])
(define proc (caseq encoding
[(utf16le) (error 'bah)]
[(ucs2) (error 'bleh)]
[(utf8) bytes->string/utf-8]
[(ascii) bytes->string/latin-1]
[else identity]))
(proc (read-bytes len port)))
(define (write-encoded-string port string [encoding 'ascii])
;; todo: handle encodings correctly.
;; right now just utf8 and ascii are correct
(define proc (caseq encoding
[(ucs2 utf8 ascii) string->bytes/utf-8]
[(utf16le) (error 'swap-bytes-unimplemented)]
[else (error 'unsupported-string-encoding)]))
(write-bytes (proc string) port))
(define (count-nonzero-chars port)
;; helper function for String
;; counts nonzero chars from current position
(length (car (regexp-match-peek "[^\u0]*" port))))
(define (byte-length val encoding)
(define encoder
(caseq encoding
[(ascii utf8) string->bytes/utf-8]))
(bytes-length (encoder (format "~a" val))))
(define (bytes-left-in-port? port)
(not (eof-object? (peek-byte port))))
(define-subclass xenomorph-base% (StringT [len #f] [encoding 'ascii])
(define/augment (decode port [parent #f])
(let ([len (or (resolve-length len port parent) (count-nonzero-chars port))]
[encoding (if (procedure? encoding)
(or (encoding parent) 'ascii)
encoding)]
[adjustment (if (and (not len) (bytes-left-in-port? port)) 1 0)])
(define string (read-encoded-string port len encoding))
(pos port (+ (pos port) adjustment))
string))
(define/augment (encode port val [parent #f])
(let* ([val (format "~a" val)]
[encoding (if (procedure? encoding)
(or (encoding (and parent (· parent val)) 'ascii))
encoding)])
(define encoded-length (byte-length val encoding))
(when (and (exact-nonnegative-integer? len) (> encoded-length len))
(raise-argument-error 'String:encode (format "string no longer than ~a" len) val))
(when (NumberT? len)
(send len encode port encoded-length))
(write-encoded-string port val encoding)
(when (not len) (write-byte #x00 port)))) ; null terminated when no len
(define/augment (size [val #f] [parent #f])
(if (not val)
(resolve-length len #f parent)
(let* ([encoding (if (procedure? encoding)
(or (encoding (and parent (· parent val)) 'ascii))
encoding)]
[encoding (if (eq? encoding 'utf16be) 'utf16le encoding)])
(+ (byte-length val encoding) (cond
[(not len) 1]
[(NumberT? len) (send len size)]
[else 0]))))))
(define-values (String? +String) (values StringT? +StringT))
(define-subclass StringT (Symbol)
(define/override (post-decode string-val . _)
(string->symbol string-val))
(define/override (pre-encode sym-val . _)
(unless (or (string? sym-val) (symbol? sym-val))
(raise-argument-error 'Symbol "symbol or string" sym-val))
(if (symbol? sym-val) sym-val (string->symbol sym-val))))
(test-module
(define S-fixed (+String 4 'utf8))
(check-equal? (encode S-fixed "Mike" #f) #"Mike")
(check-exn exn:fail? (λ () (encode S-fixed "Mikes" #f))) ; too long for fixed string
(define S (+String uint8 'utf8))
(check-equal? (decode S #"\2BCDEF") "BC")
(check-equal? (encode S "Mike" #f) #"\4Mike")
(check-equal? (size (+String) "foobar") 7) ; null terminated when no len
(check-equal? (decode (+Symbol 4) #"Mike") 'Mike)
(check-equal? (encode (+Symbol 4) 'Mike #f) #"Mike")
(check-equal? (encode (+Symbol 4) "Mike" #f) #"Mike")
(check-exn exn:fail:contract? (λ () (encode (+Symbol 4) 42 #f))))

154
pitfall/xenomorph/private/struct.rkt
Unescape Escape View File

@ -1,154 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require racket/dict racket/private/generic-methods racket/struct)
(provide (all-defined-out) ref* ref*-set! (all-from-out racket/dict))
(require (prefix-in d: racket/dict))
#|
approximates
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! (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)))
(define (dict-iterate-first d) (and (pair? (dict-keys d)) 0))
(define (dict-iterate-next d i) (and (< (add1 i) (length (dict-keys d))) (add1 i)))
(define (dict-iterate-key d i) (list-ref (dict-keys d) i))
(define (dict-iterate-value d i) (dict-ref d (dict-iterate-key d i))))]
[(generic-property gen:custom-write)
(generic-method-table gen:custom-write
(define (write-proc o port mode)
(define proc (case mode
[(#t) write]
[(#f) display]
[else (λ (p port) (print p port mode))]))
(proc (dump o) port)))])))
(define-subclass*/interfaces xenomorph-base% (dictable<%>)
(StructDictRes)
(super-make-object)
(field [_kv (mhasheq)]
[_pvt (mhasheq)])
(define/override (dump)
;; convert to immutable for display & debug
(for/hasheq ([(k v) (in-hash _kv)])
(values k v)))
(define/public (to-hash) _kv))
(define-subclass xenomorph-base% (Struct [fields (dictify)])
(field [[_post-decode post-decode] (λ (val port ctx) val)]
[[_pre-encode pre-encode] (λ (val port) val)]) ; store as field so it can be mutated from outside
(define/overment (post-decode res . args)
(let* ([res (apply _post-decode res args)]
[res (inner res post-decode res . args)])
(unless (dict? res) (raise-result-error 'Struct:post-decode "dict" res))
res))
(define/overment (pre-encode res . args)
(let* ([res (apply _pre-encode res args)]
[res (inner res pre-encode res . args)])
(unless (dict? res) (raise-result-error 'Struct:pre-encode "dict" res))
res))
(unless ((disjoin assocs? Struct?) fields) ; should be Versioned Struct but whatever
(raise-argument-error 'Struct "assocs or Versioned Struct" fields))
(define/augride (decode stream [parent #f] [len 0])
;; _setup and _parse-fields are separate to cooperate with VersionedStruct
(let* ([sdr (_setup stream parent len)] ; returns StructDictRes
[sdr (_parse-fields stream sdr fields)])
sdr))
(define/public-final (_setup port parent len)
(define sdr (make-object StructDictRes)) ; not mere hash
(dict-set*! sdr 'parent parent
'_startOffset (pos port)
'_currentOffset 0
'_length len)
sdr)
(define/public-final (_parse-fields port sdr fields)
(unless (assocs? fields)
(raise-argument-error '_parse-fields "assocs" fields))
(for/fold ([sdr sdr])
([(key type) (in-dict fields)])
(define val (if (procedure? type)
(type sdr)
(send type decode port sdr)))
(unless (void? val)
(dict-set! sdr key val))
(dict-set! sdr '_currentOffset (- (pos port) (· sdr _startOffset)))
sdr))
(define/augride (size [val #f] [parent #f] [include-pointers #t])
(define ctx (mhasheq 'parent parent
'val val
'pointerSize 0))
(+ (for/sum ([(key type) (in-dict fields)]
#:when (object? type))
(send type size (and val (ref val key)) ctx))
(if include-pointers (· ctx pointerSize) 0)))
(define/augride (encode port val [parent #f])
(unless (dict? val)
(raise-argument-error 'Struct:encode "dict" val))
;; check keys first, since `size` also relies on keys being valid
(unless (andmap (λ (key) (memq key (dict-keys val))) (dict-keys fields))
(raise-argument-error 'Struct:encode
(format "dict that contains superset of Struct keys: ~a" (dict-keys fields)) (dict-keys val)))
(define ctx (mhash 'pointers empty
'startOffset (pos port)
'parent parent
'val val
'pointerSize 0))
(ref-set! ctx 'pointerOffset (+ (pos port) (size val ctx #f)))
(for ([(key type) (in-dict fields)])
(send type encode port (ref val key) ctx))
(for ([ptr (in-list (· ctx pointers))])
(send (· ptr type) encode port (· ptr val) (· ptr parent)))))
(test-module
(require "number.rkt")
(define (random-pick xs) (list-ref xs (random (length xs))))
(check-exn exn:fail:contract? (λ () (+Struct 42)))
;; 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)))

13
pitfall/xenomorph/private/utils.rkt
Unescape Escape View File

@ -1,13 +0,0 @@
#lang racket/base
(require "racket.rkt")
(provide (all-defined-out))
(require "number.rkt")
(define (resolve-length len-arg [stream #f] [parent #f])
(cond
[(not len-arg) #f]
[(number? len-arg) len-arg]
[(procedure? len-arg) (len-arg parent)]
[(and parent (key? len-arg)) (ref parent len-arg)] ; treat as key into RStruct parent
[(and stream (NumberT? len-arg)) (send len-arg decode stream)]
[else (raise-argument-error 'resolveLength "fixed-size argument" len-arg)]))

147
pitfall/xenomorph/private/versioned-struct.rkt
Unescape Escape View File

@ -1,147 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require racket/dict "struct.rkt")
(provide (all-defined-out))
#|
approximates
https://github.com/mbuttrackerick/restructure/blob/master/src/VersionedStruct.coffee
|#
(define-subclass Struct (VersionedStruct type [versions (dictify)])
(unless ((disjoin integer? procedure? xenomorph-base%? symbol?) type)
(raise-argument-error 'VersionedStruct "integer, function, symbol, or Restructure object" type))
(unless (and (dict? versions) (andmap (λ (val) (or (dict? val) (Struct? val))) (map cdr versions)))
(raise-argument-error 'VersionedStruct "dict of dicts or Structs" versions))
(inherit _setup _parse-fields post-decode)
(inherit-field fields)
(field [forced-version #f]
[versionGetter void]
[versionSetter void])
(when (or (key? type) (procedure? type))
(set-field! versionGetter this (if (procedure? type)
type
(λ (parent) (ref parent type))))
(set-field! versionSetter this (if (procedure? type)
type
(λ (parent version) (ref-set! parent type version)))))
(define/override (decode stream [parent #f] [length 0])
(define res (_setup stream parent length))
(ref-set! res 'version
(cond
[forced-version] ; for testing purposes: pass an explicit version
[(or (key? type) (procedure? type))
(unless parent
(raise-argument-error 'VersionedStruct:decode "valid parent" parent))
(versionGetter parent)]
[else (send type decode stream)]))
(when (ref versions 'header)
(_parse-fields stream res (ref versions 'header)))
(define fields (or (ref versions (ref res 'version)) (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions)))))
(cond
[(VersionedStruct? fields) (send fields decode stream parent)]
[else
(_parse-fields stream res fields)
res]))
(define/public-final (force-version! version)
(set! forced-version version))
(define/override (encode stream val [parent #f])
(unless (hash? val)
(raise-argument-error 'VersionedStruct:encode "hash" val))
(define ctx (mhash 'pointers empty
'startOffset (pos stream)
'parent parent
'val val
'pointerSize 0))
(ref-set! ctx 'pointerOffset (+ (pos stream) (size val ctx #f)))
(when (not (or (key? type) (procedure? type)))
(send type encode stream (or forced-version (· val version))))
(when (ref versions 'header)
(for ([(key type) (in-dict (ref versions 'header))])
(send type encode stream (ref val key) ctx)))
(define fields (or (ref versions (or forced-version (· val version))) (raise-argument-error 'VersionedStruct:encode "valid version key" version)))
(unless (andmap (λ (key) (member key (ref-keys val))) (ref-keys fields))
(raise-argument-error 'VersionedStruct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val)))
(for ([(key type) (in-dict fields)])
(send type encode stream (ref val key) ctx))
(for ([ptr (in-list (ref ctx 'pointers))])
(send (ref ptr 'type) encode stream (ref ptr 'val) (ref ptr 'parent))))
(define/override (size [val #f] [parent #f] [includePointers #t])
(unless (or val forced-version)
(raise-argument-error 'VersionedStruct:size "value" val))
(define ctx (mhash 'parent parent
'val val
'pointerSize 0))
(+ (if (not (or (key? type) (procedure? type)))
(send type size (or forced-version (ref val 'version)) ctx)
0)
(for/sum ([(key type) (in-dict (or (ref versions 'header) empty))])
(send type size (and val (ref val key)) ctx))
(let ([fields (or (ref versions (or forced-version (ref val 'version)))
(raise-argument-error 'VersionedStruct:encode "valid version key" version))])
(for/sum ([(key type) (in-dict fields)])
(send type size (and val (ref val key)) ctx)))
(if includePointers (ref ctx 'pointerSize) 0))))
#;(test-module
(require "number.rkt")
(define (random-pick xs) (list-ref xs (random (length xs))))
(check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42)))
;; make random versioned structs and make sure we can round trip
#;(for ([i (in-range 1)])
(define field-types (for/list ([i (in-range 1)])
(random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
(define num-versions 20)
(define which-struct (random num-versions))
(define struct-versions (for/list ([v (in-range num-versions)])
(cons v (for/list ([num-type (in-list field-types)])
(cons (gensym) num-type)))))
(define vs (+VersionedStruct which-struct struct-versions))
(define struct-size (for/sum ([num-type (in-list (map cdr (ref struct-versions which-struct)))])
(send num-type size)))
(define bs (apply bytes (for/list ([i (in-range struct-size)])
(random 256))))
(check-equal? (send vs encode #f (send vs decode bs)) bs))
(define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
(check-equal? (send s size) 3)
(define vs (+VersionedStruct uint8 (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s))))
(send vs force-version! 1)
(check-equal? (send vs size) 6)
#|
(define s2 (+Struct (dictify 'a vs)))
(check-equal? (send s2 size) 6)
(define vs2 (+VersionedStruct (λ (p) 2) (dictify 1 vs 2 vs)))
(check-equal? (send vs2 size) 6)
|#
)

205
pitfall/xenomorph/private/~stream.rkt
Unescape Escape View File

@ -1,205 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require racket/generic racket/private/generic-methods)
(provide (all-defined-out))
;; helper class
(define-subclass object% (PortWrapper _port)
(unless (port? _port)
(raise-argument-error 'PortWrapper:constructor "port" _port))
(define/public (pos [where #f])
(when where (file-position _port where))
(file-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 EncodeStream
(class* PortWrapper (dumpable<%>)
(init-field [[maybe-output-port 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))
(write-bytes val _port)
(void))
(define/public-final (writeBuffer buffer)
(write buffer))
(define/public-final (writeUInt8 int)
(write (bytes int)))
(define/public (writeString string [encoding 'ascii])
;; todo: handle encodings correctly.
;; right now just utf8 and ascii are correct
(caseq encoding
[(utf16le ucs2 utf8 ascii) (writeBuffer (string->bytes/utf-8 string))
(when (eq? encoding 'utf16le)
(error 'swap-bytes-unimplemented))]
[else (error 'unsupported-string-encoding)]))
(define/public (fill val len)
(write (make-bytes len val)))))
(define-class-predicates EncodeStream)
(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? (dump es2) #"FOOBAR")
(check-equal? (dump es2) #"FOOBAR") ; dump can repeat
(check-equal? (get-output-bytes op) #"FOOBAR")
(define es3 (+EncodeStream))
(send es3 fill 0 10)
(check-equal? (dump es3) (make-bytes 10 0)))
#| 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
(require "sizes.rkt")
(define-macro (define-reader ID)
#'(define/public (ID)
(define bs (*ref type-sizes (string->symbol (string-downcase (string-replace (symbol->string 'ID) "read" "")))))
(readBuffer bs)))
(define countable<%>
(interface* ()
([(generic-property gen:countable)
(generic-method-table gen:countable
(define (length o) (get-field length_ o)))])))
(define DecodeStreamT
(class* PortWrapper
(codable<%> dumpable<%> countable<%> posable<%>)
(init-field [buffer #""])
(unless (bytes? buffer) ; corresponds to a Node Buffer, not a restructure BufferT object
(raise-argument-error 'DecodeStream:constructor "bytes" buffer))
(super-make-object (open-input-bytes buffer))
(inherit-field _port)
(field [_pos 0]
[length_ (length buffer)])
(define/override (pos [where #f])
(when where
(set! _pos (super pos where)))
_pos)
(define/public (count-nonzero-chars)
;; helper function for String
;; counts nonzero chars from current position
(length (car (regexp-match-peek "[^\u0]*" _port))))
(public [-length length])
(define (-length) length_)
(define/public (readString length__ [encoding 'ascii])
(define proc (caseq encoding
[(utf16le) (error 'bah)]
[(ucs2) (error 'bleh)]
[(utf8) bytes->string/utf-8]
[(ascii) bytes->string/latin-1]
[else identity]))
(define start (pos))
(define stop (+ start length__))
(proc (subbytes buffer start (pos stop))))
(define/public-final (readBuffer count)
(unless (index? count)
(raise-argument-error 'DecodeStream:read "positive integer" count))
(define bytes-remaining (- length_ (pos)))
(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) ; don't use `pos` method here because `read-bytes` will increment the port position
(define bs (read-bytes count _port))
(unless (= _pos (file-position _port)) (raise-result-error 'DecodeStream "positions askew" (list _pos (file-position _port))))
bs)
(define/public (read count) (readBuffer count))
(define/public (readUInt8) (bytes-ref (readBuffer 1) 0))
(define/public (readUInt16BE) (+ (arithmetic-shift (readUInt8) 8) (readUInt8)))
(define/public (readInt16BE) (unsigned->signed (readUInt16BE) 16))
(define/public (readUInt16LE) (+ (readUInt8) (arithmetic-shift (readUInt8) 8)))
(define/public (readUInt24BE) (+ (arithmetic-shift (readUInt16BE) 8) (readUInt8)))
(define/public (readUInt24LE) (+ (readUInt16LE) (arithmetic-shift (readUInt8) 16)))
(define/public (readInt24BE) (unsigned->signed (readUInt24BE) 24))
(define/public (readInt24LE) (unsigned->signed (readUInt24LE) 24))
(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-subclass DecodeStreamT (DecodeStream))
(test-module
(define ds (+DecodeStream #"ABCD"))
(check-true (DecodeStream? ds))
(check-equal? (length ds) 4)
(check-equal? (dump ds) #"ABCD")
(check-equal? (dump ds) #"ABCD") ; dump can repeat
(check-equal? (send ds readUInt16BE) 16706)
(check-equal? (dump ds) #"ABCD")
(check-equal? (· ds pos) 2)
(check-equal? (send ds readUInt8) 67)
(check-equal? (· ds pos) 3)
(check-equal? (send ds readUInt8) 68)
(check-equal? (· ds pos) 4)
(check-exn exn:fail? (λ () (send ds read -42)))
(check-exn exn:fail? (λ () (send ds read 1))))
(test-module
(define-subclass xenomorph-base% (Dummy)
(define/augment (decode stream parent) "foo")
(define/augment (encode stream val parent) "bar")
(define/augment (size) 42))
(define d (+Dummy))
(check-true (Dummy? d))
(check-exn exn:fail:contract? (λ () (decode d 42)))
(check-not-exn (λ () (decode d #"foo")))
(check-exn exn:fail:contract? (λ () (encode d 42 21)))
(check-not-exn (λ () (encode d 42 (open-output-bytes) ))))

5
pitfall/xenomorph/reserved.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/reserved.rkt")

255
pitfall/xenomorph/scribblings/xenomorph.scrbl
Unescape Escape View File

@ -1,255 +0,0 @@
#lang scribble/manual
@(require scribble/eval (for-label racket xenomorph))
@(define my-eval (make-base-eval))
@(my-eval `(require xenomorph))
@title{Xenomorph: binary encoding & decoding}
@author[(author+email "Matthew Butterick" "mb@mbtype.com") "Devon Govett"]
@defmodule[xenomorph]
Hands up: who likes parsing and writing binary formats?
OK, just a few of you, in the back. You're free to go.
Everyone else: Xenomorph eases the pain of working with binary formats. Instead of fiddling with counting bytes:
@itemlist[#:style 'ordered
@item{You define an @deftech{encoding} describing the binary format using smaller ingredients — e.g., integers, strings, arrays, pointers, and sub-encodings.}
@item{This encoding can then be used as a binary compiler, converting Racket values to binary and writing them out to a file.}
@item{But wait, there's more: this encoding can @emph{also} be used as a binary parser, reading bytes and parsing them into Racket values. So one encoding definition can be used for both input and output.}
]
Derived principally from Devon Govett's @link["https://github.com/devongovett/restructure"]{@tt{restructure}} library for Node. Thanks for doing the heavy lifting, dude.
@section{Installation}
At the command line:
@verbatim{raco pkg install xenomorph}
After that, you can update the package from the command line:
@verbatim{raco pkg update xenomorph}
Invoke the library in a source file by importing it in the usual way:
@verbatim{(require xenomorph)}
@section{Quick tutorial}
@examples[#:eval my-eval
(define four-ints (+ArrayT uint8 4))
(decode four-ints #"\1\2\3\4")
(decode four-ints #"\1\2\3")
(decode four-ints #"\1\2\3\4\5\6")
(define op (open-output-string))
(encode four-ints '(1 2 3 4) op)
(get-output-bytes op)
]
@section{The big picture}
@subsection{Bytes and byte strings}
Suppose we have a file on disk. What's in the file? Without knowing anything else, we can at least say the file contains a sequence of @deftech{bytes}. A @deftech{byte} is the smallest unit of data storage. It's not, however, the smallest unit of information storage — that would be a @deftech{bit}. But when we read (or write) from disk (or other source, like memory), we work with bytes.
A byte holds eight bits, so it can take on values between 0 and 255, inclusive. In Racket, a sequence of bytes is also known as a @deftech{byte string}. It prints as a series of values between quotation marks, prefixed with @litchar{#}:
@racketblock[#"ABC"]
Caution: though this looks similar to the ordinary string @racket["ABC"], we're better off thinking of it as a sequence of integers that are sometimes displayed as characters for convenience. For instance, the byte string above represents three bytes valued 65, 66, and 67. This byte string could also be written in hexadecimal like so:
@(racketvalfont "#\"\\x41\\x42\\x43\"")
Or octal like so:
@(racketvalfont "#\"\\101\\102\\103\"")
Both of these mean the same thing. (If you like, confirm this by trying them on the REPL.)
We can also make an equivalent byte string with @racket[bytes]. As above, Racket doesn't care how we notate the values, as long as they're between 0 and 255:
@bold{TODO}: escape the chars below
@examples[#:eval my-eval
(bytes 65 66 67)
(bytes #x41 #x42 #x43)
(bytes #o101 #o102 #o103)
(apply bytes (map char->integer '(#\A #\B #\C)))
]
Byte values between 32 and 127 are printed as characters. Other values are printed in octal:
@examples[#:eval my-eval
(bytes 65 66 67 154 206 255)
]
If you think this printing convention is a little weird, I agree. But that's how Racket does it. If we prefer to deal with lists of integers, we can always use @racket[bytes->list] and @racket[list->bytes]:
@examples[#:eval my-eval
(bytes->list #"ABC\232\316\377")
(list->bytes '(65 66 67 154 206 255))
]
The important thing is that when we see the @litchar{#"} prefix, we know we're looking at a byte string, not an ordinary string.
@subsection{Encodings}
Back to files. Typically, files on disk are classified as being either @deftech{binary} or @deftech{text}. (A distinction observed by Racket functions such as @racket[write-to-file].) When we speak of binary vs. text, we're saying something about the internal structure of the byte sequence — what values those bytes represent. This internal structure is also called an @deftech{encoding}. An encoding is a way of representing a sequence of arbitrary values as a sequence of bytes.
@subsubsection{Text encodings}
Text files are a just a particular subset of binary files that use a @deftech{text encoding} — that is, a binary encoding that stores human-readable characters.
But since we all have experience with text files, let's use text encoding as a way of starting to understand what's happening under the hood with binary encodings.
For example, ASCII is a familiar encoding that stores each character in seven bits, so it can describe 128 distinct characters. Because every ASCII code is less than 255, we can store ASCII text with one byte per character.
But if we want to use more than 128 distinct characters, we're stuck. That's why Racket instead uses the UTF-8 text encoding by default. UTF-8 uses between one and three bytes to encode each character, and can thus represent up to 1,112,064 distinct characters. We can see how this works by converting a string into an encoded byte sequence using @racket[string->bytes/utf-8]:
@examples[#:eval my-eval
(string->bytes/utf-8 "ABCD")
(bytes->list (string->bytes/utf-8 "ABCD"))
(string->bytes/utf-8 "ABÇ战")
(bytes->list (string->bytes/utf-8 "ABÇ战"))
]
For ASCII-compatible characters, UTF-8 uses one byte for each character. Thus, the string @racket["ABCD"] is four bytes long in UTF-8.
Now consider the string @racket["ABÇ战"], which has four characters, but the second two aren't ASCII-compatible. In UTF-8, it's encoded as seven bytes: the first two characters are one byte each, the @racket["Ç"] takes two bytes, and the @racket["战"] takes three.
Moreover, for further simplicity, text files typically rely on a small set of pre-defined encodings, like ASCII or UTF-8 or Latin-1, so that those who write programs that manipulate text only have to support a smallish set of encodings.
@subsubsection{Binary encodings}
@subsubsection{In sum}
Three corollaries follow:
@itemlist[#:style 'ordered
@item{A given sequence of bytes can mean different things, depending on what encoding we use.}
@item{We can only make sense of a sequence of bytes if we know its encoding.}
@item{A byte sequence does not describe its own encoding.}
]
For those familiar with programming-language lingo, an encoding somewhat resembles a @deftech{grammar}, which is a tool for describing the syntactic structure of a program. A grammar doesn't describe one particular program. Rather, it describes all possible programs that are consistent with the grammar, and therefore can be used to parse any particular one. Likewise for an encoding.
@margin-note{Can a grammar work as a binary encoding? In limited cases, but not enough to be practical. Most grammars have to assume the target program is context free, meaning that the grammar rules apply the same way everywhere. By contrast, binary files are nonrecursive and contextual.}
@section{Core functions}
@defproc[
(decode
[template (is-a?/c xenomorph-base%)]
[byte-source (or/c bytes? input-port?) (current-input-port)])
any/c]{
Hello
}
@defproc[
(encode
[template (is-a?/c xenomorph-base%)]
[v any/c]
[byte-dest (or/c output-port? #f) (current-output-port)])
(or/c void? bytes?)]{
Hello
}
@defproc[
(size
[template (is-a?/c xenomorph-base%)]
[v any/c])
exact-nonnegative-integer?]{
Hello
}
@section{Binary ingredients}
@subsection{Numbers}
@defmodule[xenomorph/number]
@subsection{Strings}
@defmodule[xenomorph/string]
@subsection{Arrays}
@defmodule[xenomorph/array]
@subsection{Lazy arrays}
@defmodule[xenomorph/lazy-array]
@subsection{Structs}
@defmodule[xenomorph/struct]
@subsection{Versioned structs}
@defmodule[xenomorph/versioned-struct]
@subsection{Pointers}
@defmodule[xenomorph/pointer]
@subsection{Bitfields}
@defmodule[xenomorph/bitfield]
@subsection{Enumerations}
@defmodule[xenomorph/enum]
@subsection{Optional}
@defmodule[xenomorph/optional]
@subsection{Reserved}
@defmodule[xenomorph/reserved]
@defproc[
(array?
[type any/c])
void?]{
Hello
}
@section{License & source code}
This module is licensed under the MIT license.
Source repository at @link["http://github.com/mbutterick/xenomorph"]{http://github.com/mbutterick/xenomorph}. Suggestions & corrections welcome.

5
pitfall/xenomorph/string.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/string.rkt")

5
pitfall/xenomorph/struct.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/struct.rkt")

89
pitfall/xenomorph/test/array-test.rkt
Unescape Escape View File

@ -1,89 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
|#
;describe 'Array', ->
; describe 'decode', ->
; it 'should decode fixed length', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint8 4)) '(1 2 3 4)))
; it 'should decode fixed amount of bytes', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint16be 4 'bytes)) '(258 772)))
; it 'should decode length from parent key', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint8 'len) #:parent (mhash 'len 4)) '(1 2 3 4)))
; it 'should decode amount of bytes from parent key', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint16be 'len 'bytes) #:parent (mhash 'len 4)) '(258 772)))
; it 'should decode length as number before array', ->
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint8 uint8)) '(1 2 3 4)))
; it 'should decode amount of bytes as number before array', ->
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint16be uint8 'bytes)) '(258 772)))
; it 'should decode length from function', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint8 (λ _ 4))) '(1 2 3 4)))
; it 'should decode amount of bytes from function', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint16be (λ _ 4) 'bytes)) '(258 772)))
; it 'should decode to the end of the parent if no length is given', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint8) #:parent (mhash '_length 4 '_startOffset 0)) '(1 2 3 4)))
; decode to the end of the stream if parent exists, but its length is 0
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (+ArrayT uint8) #:parent (mhash '_length 0 '_startOffset 0)) '(1 2 3 4 5)))
; it 'should decode to the end of the stream if no parent and length is given', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4))])
(check-equal? (decode (+ArrayT uint8)) '(1 2 3 4 )))
; describe 'size', ->
; it 'should use array length', ->
(check-equal? (size (+ArrayT uint8 10) '(1 2 3 4)) 4)
; it 'should add size of length field before string', ->
(check-equal? (size (+ArrayT uint8 uint8) '(1 2 3 4)) 5)
; it 'should use defined length if no value given', ->
(check-equal? (size (+ArrayT uint8 10)) 10)
; describe 'encode', ->
; it 'should encode using array length', (done) ->
(check-equal? (encode (+ArrayT uint8 10) '(1 2 3 4) #f) (bytes 1 2 3 4))
; it 'should encode length as number before array', (done) ->
(check-equal? (encode (+ArrayT uint8 uint8) '(1 2 3 4) #f) (bytes 4 1 2 3 4))
; it 'should add pointers after array if length is encoded at start', (done) ->
(check-equal? (encode (+ArrayT (+Pointer uint8 uint8) uint8) '(1 2 3 4) #f) (bytes 4 5 6 7 8 1 2 3 4))

48
pitfall/xenomorph/test/bitfield-test.rkt
Unescape Escape View File

@ -1,48 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require racket/match)
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
|#
;describe 'Bitfield', ->
; bitfield = new Bitfield uint8, ['Jack', 'Kack', 'Lack', 'Mack', 'Nack', 'Oack', 'Pack', 'Quack']
; JACK = 1 << 0
; KACK = 1 << 1
; LACK = 1 << 2
; MACK = 1 << 3
; NACK = 1 << 4
; OACK = 1 << 5
; PACK = 1 << 6
; QUACK = 1 << 7
(define bitfield (+Bitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)))
(match-define (list JACK KACK LACK MACK NACK OACK PACK QUACK)
(map (curry arithmetic-shift 1) (range 8)))
; it 'should have the right size', ->
(check-equal? (size bitfield) 1)
; it 'should decode', ->
(parameterize ([current-input-port (open-input-bytes (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))])
(check-equal? (decode bitfield) (mhasheq 'Quack #t
'Nack #t
'Lack #f
'Oack #f
'Pack #t
'Mack #t
'Jack #t
'Kack #f)))
; it 'should encode', (done) ->
(check-equal? (encode bitfield (mhasheq 'Quack #t
'Nack #t
'Lack #f
'Oack #f
'Pack #t
'Mack #t
'Jack #t
'Kack #f) #f)
(bytes (bitwise-ior JACK MACK PACK NACK QUACK)))

44
pitfall/xenomorph/test/buffer-test.rkt
Unescape Escape View File

@ -1,44 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
|#
;describe 'Buffer', ->
; describe 'decode', ->
; it 'should decode', ->
(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
(define buf (+BufferT 2))
(check-equal? (decode buf) (bytes #xab #xff))
(check-equal? (decode buf) (bytes #x1f #xb6)))
; it 'should decode with parent key length', ->
(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
(define buf (+BufferT 'len))
(check-equal? (decode buf #:parent (hash 'len 3)) (bytes #xab #xff #x1f))
(check-equal? (decode buf #:parent (hash 'len 1)) (bytes #xb6)))
; describe 'size', ->
; it 'should return size', ->
(check-equal? (size (+BufferT 2) (bytes #xab #xff)) 2)
; it 'should use defined length if no value given', ->x
(check-equal? (size (+BufferT 10)) 10)
; describe 'encode', ->
; it 'should encode', (done) ->
(let ([buf (+BufferT 2)])
(check-equal? (bytes-append
(encode buf (bytes #xab #xff) #f)
(encode buf (bytes #x1f #xb6) #f)) (bytes #xab #xff #x1f #xb6)))
; it 'should encode length before buffer', (done) ->
(check-equal? (encode (+BufferT uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff))

35
pitfall/xenomorph/test/enum-test.rkt
Unescape Escape View File

@ -1,35 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
|#
;describe 'Enum', ->
; e = new Enum uint8, ['foo', 'bar', 'baz']
; it 'should have the right size', ->
; e.size().should.equal 1
(define e (+Enum uint8 '("foo" "bar" "baz")))
(check-equal? (size e) 1)
; it 'should decode', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 0))])
(check-equal? (decode e) "bar")
(check-equal? (decode e) "baz")
(check-equal? (decode e) "foo"))
; it 'should encode', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(encode e "bar")
(encode e "baz")
(encode e "foo")
(check-equal? (dump (current-output-port)) (bytes 1 2 0)))
; it 'should throw on unknown option', ->
(check-exn exn:fail:contract? (λ () (encode e "unknown" (open-output-bytes))))

59
pitfall/xenomorph/test/lazy-array-test.rkt
Unescape Escape View File

@ -1,59 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
|#
;describe 'LazyArray', ->
; describe 'decode', ->
; it 'should decode items lazily', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define array (+LazyArray uint8 4))
(define arr (decode array))
(check-false (Array? arr))
(check-equal? (ref arr 'len) 4)
(check-equal? (pos (current-input-port)) 4)
(check-equal? (get arr 0) 1)
(check-equal? (get arr 1) 2)
(check-equal? (get arr 2) 3)
(check-equal? (get arr 3) 4))
; it 'should be able to convert to an array', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define array (+LazyArray uint8 4))
(define arr (decode array))
(check-equal? (LazyArray->list arr) '(1 2 3 4)))
; it 'should have an inspect method', ->
; [skipped]
; it 'should decode length as number before array', ->
(parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
(define array (+LazyArray uint8 uint8))
(define arr (decode array))
(check-equal? (LazyArray->list arr) '(1 2 3 4)))
;
; describe 'size', ->
; it 'should work with LazyArrays', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define array (+LazyArray uint8 4))
(define arr (decode array))
(check-equal? (size array arr) 4))
; describe 'encode', ->
; it 'should work with LazyArrays', (done) ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(define array (+LazyArray uint8 4))
(define arr (decode array))
(check-equal? (encode array arr #f) (bytes 1 2 3 4)))

15
pitfall/xenomorph/test/main.rkt
Unescape Escape View File

@ -1,15 +0,0 @@
#lang racket/base
(require "racket.rkt")
(require "array-test.rkt"
"bitfield-test.rkt"
"buffer-test.rkt"
"enum-test.rkt"
"lazy-array-test.rkt"
"number-test.rkt"
"optional-test.rkt"
"pointer-test.rkt"
"reserved-test.rkt"
"string-test.rkt"
"struct-test.rkt"
"versioned-struct-test.rkt")

336
pitfall/xenomorph/test/number-test.rkt
Unescape Escape View File

@ -1,336 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Number.coffee
|#
;describe 'Number', ->
; describe 'uint8', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(parameterize ([current-input-port (open-input-bytes (bytes #xab #xff))])
(check-equal? (decode uint8) #xab)
(check-equal? (decode uint8) #xff))
(check-equal? (size uint8) 1)
(let ([port (open-output-bytes)])
(encode uint8 #xab port)
(encode uint8 #xff port)
(check-equal? (dump port) (bytes #xab #xff)))
; describe 'uint16', ->
; it 'is an alias for uint16be', ->
; modified test: `uint16` is the same endianness as the platform
(check-equal? (decode uint16 (bytes 0 1)) (send (if (system-big-endian?)
uint16be
uint16le) decode (bytes 0 1)))
; describe 'uint16be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode uint16be (open-input-bytes (bytes #xab #xff))) #xabff)
(check-equal? (size uint16be) 2)
(check-equal? (encode uint16be #xabff #f) (bytes #xab #xff))
;
; describe 'uint16le', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode uint16le (open-input-bytes (bytes #xff #xab))) #xabff)
(check-equal? (size uint16le) 2)
(check-equal? (encode uint16le #xabff #f) (bytes #xff #xab))
;
; describe 'uint24', ->
; it 'is an alias for uint24be', ->
;; modified test: `uint24` is the same endianness as the platform
(check-equal? (decode uint24 (bytes 0 1 2)) (send (if (system-big-endian?)
uint24be
uint24le) decode (bytes 0 1 2)))
;
; describe 'uint24be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode uint24be (open-input-bytes (bytes #xff #xab #x24))) #xffab24)
(check-equal? (size uint24be) 3)
(check-equal? (encode uint24be #xffab24 #f) (bytes #xff #xab #x24))
;
; describe 'uint24le', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode uint24le (open-input-bytes (bytes #x24 #xab #xff))) #xffab24)
(check-equal? (size uint24le) 3)
(check-equal? (encode uint24le #xffab24 #f) (bytes #x24 #xab #xff))
;
; describe 'uint32', ->
; it 'is an alias for uint32be', ->
;; modified test: `uint32` is the same endianness as the platform
(check-equal? (decode uint32 (bytes 0 1 2 3)) (send (if (system-big-endian?)
uint32be
uint32le) decode (bytes 0 1 2 3)))
;
; describe 'uint32be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode uint32be (open-input-bytes (bytes #xff #xab #x24 #xbf))) #xffab24bf)
(check-equal? (size uint32be) 4)
(check-equal? (encode uint32be #xffab24bf #f) (bytes #xff #xab #x24 #xbf))
;
; describe 'uint32le', ->
; it 'should decode', ->
; it 'should encode', (done) ->
(check-equal? (decode uint32le (open-input-bytes (bytes #xbf #x24 #xab #xff))) #xffab24bf)
(check-equal? (size uint32le) 4)
(check-equal? (encode uint32le #xffab24bf #f) (bytes #xbf #x24 #xab #xff))
;
; describe 'int8', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(let ([port (open-input-bytes (bytes #x7f #xff))])
(check-equal? (decode int8 port) 127)
(check-equal? (decode int8 port) -1))
(check-equal? (size int8) 1)
(let ([port (open-output-bytes)])
(encode int8 127 port)
(encode int8 -1 port)
(check-equal? (dump port) (bytes #x7f #xff)))
;
; describe 'int16', ->
; it 'is an alias for int16be', ->
; int16.should.equal int16be
;; modified test: `int16` is the same endianness as the platform
(check-equal? (decode int16 (bytes 0 1)) (send (if (system-big-endian?)
int16be
int16le) decode (bytes 0 1)))
;
; describe 'int16be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(let ([port (open-input-bytes (bytes #xff #xab))])
(check-equal? (decode int16be port) -85))
(check-equal? (size int16be) 2)
(let ([port (open-output-bytes)])
(encode int16be -85 port)
(check-equal? (dump port) (bytes #xff #xab)))
; describe 'int16le', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode int16le (open-input-bytes (bytes #xab #xff))) -85)
(check-equal? (size int16le) 2)
(check-equal? (encode int16le -85 #f) (bytes #xab #xff))
;
; describe 'int24', ->
; it 'is an alias for int24be', ->
; int24.should.equal int24be
;; modified test: `int24` is the same endianness as the platform
(check-equal? (decode int24 (bytes 0 1 2)) (send (if (system-big-endian?)
int24be
int24le) decode (bytes 0 1 2)))
;
; describe 'int24be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode int24be (open-input-bytes (bytes #xff #xab #x24))) -21724)
(check-equal? (size int24be) 3)
(check-equal? (encode int24be -21724 #f) (bytes #xff #xab #x24))
;
; describe 'int24le', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode int24le (open-input-bytes (bytes #x24 #xab #xff))) -21724)
(check-equal? (size int24le) 3)
(check-equal? (encode int24le -21724 #f) (bytes #x24 #xab #xff))
; describe 'int32', ->
; it 'is an alias for int32be', ->
; modified test: `int32` is the same endianness as the platform
(check-equal? (decode int32 (bytes 0 1 2 3)) (send (if (system-big-endian?)
int32be
int32le) decode (bytes 0 1 2 3)))
;
; describe 'int32be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode int32be (open-input-bytes (bytes #xff #xab #x24 #xbf))) -5561153)
(check-equal? (size int32be) 4)
(check-equal? (encode int32be -5561153 #f) (bytes #xff #xab #x24 #xbf))
;
; describe 'int32le', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode int32le (open-input-bytes (bytes #xbf #x24 #xab #xff))) -5561153)
(check-equal? (size int32le) 4)
(check-equal? (encode int32le -5561153 #f) (bytes #xbf #x24 #xab #xff))
;
; describe 'float', ->
; it 'is an alias for floatbe', ->
; modified test: `float` is the same endianness as the platform
(check-equal? (decode float (bytes 0 1 2 3)) (send (if (system-big-endian?)
floatbe
floatle) decode (bytes 0 1 2 3)))
;
; describe 'floatbe', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-= (decode floatbe (open-input-bytes (bytes #x43 #x7a #x8c #xcd))) 250.55 0.01)
(check-equal? (size floatbe) 4)
(check-equal? (encode floatbe 250.55 #f) (bytes #x43 #x7a #x8c #xcd))
;
; describe 'floatle', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-= (decode floatle (open-input-bytes (bytes #xcd #x8c #x7a #x43))) 250.55 0.01)
(check-equal? (size floatle) 4)
(check-equal? (encode floatle 250.55 #f) (bytes #xcd #x8c #x7a #x43))
;
; describe 'double', ->
; it 'is an alias for doublebe', ->
; modified test: `double` is the same endianness as the platform
(check-equal? (decode double (bytes 0 1 2 3 4 5 6 7)) (send (if (system-big-endian?)
doublebe
doublele) decode (bytes 0 1 2 3 4 5 6 7)))
;
; describe 'doublebe', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode doublebe (open-input-bytes (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a))) 1234.56)
(check-equal? (size doublebe) 8)
(check-equal? (encode doublebe 1234.56 #f) (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a))
;
; describe 'doublele', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-equal? (decode doublele (open-input-bytes (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40))) 1234.56)
(check-equal? (size doublele) 8)
(check-equal? (encode doublele 1234.56 #f) (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40))
;
; describe 'fixed16', ->
; it 'is an alias for fixed16be', ->
; modified test: `fixed16` is the same endianness as the platform
(check-equal? (decode fixed16 (bytes 0 1)) (send (if (system-big-endian?)
fixed16be
fixed16le) decode (bytes 0 1)))
;
; describe 'fixed16be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-= (decode fixed16be (open-input-bytes (bytes #x19 #x57))) 25.34 0.01)
(check-equal? (size fixed16be) 2)
(check-equal? (encode fixed16be 25.34 #f) (bytes #x19 #x57))
;
; describe 'fixed16le', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-= (decode fixed16le (open-input-bytes (bytes #x57 #x19))) 25.34 0.01)
(check-equal? (size fixed16le) 2)
(check-equal? (encode fixed16le 25.34 #f) (bytes #x57 #x19))
;
; describe 'fixed32', ->
; it 'is an alias for fixed32be', ->
; modified test: `fixed32` is the same endianness as the platform
(check-equal? (decode fixed32 (bytes 0 1 2 3)) (send (if (system-big-endian?)
fixed32be
fixed32le) decode (bytes 0 1 2 3)))
;
; describe 'fixed32be', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-= (decode fixed32be (open-input-bytes (bytes #x00 #xfa #x8c #xcc))) 250.55 0.01)
(check-equal? (size fixed32be) 4)
(check-equal? (encode fixed32be 250.55 #f) (bytes #x00 #xfa #x8c #xcc))
;
; describe 'fixed32le', ->
; it 'should decode', ->
; it 'should have a size', ->
; it 'should encode', (done) ->
(check-= (decode fixed32le (open-input-bytes (bytes #xcc #x8c #xfa #x00))) 250.55 0.01)
(check-equal? (size fixed32le) 4)
(check-equal? (encode fixed32le 250.55 #f) (bytes #xcc #x8c #xfa #x00))

114
pitfall/xenomorph/test/optional-test.rkt
Unescape Escape View File

@ -1,114 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee
|#
;describe 'Optional', ->
; describe 'decode', ->
; it 'should not decode when condition is falsy', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+Optional uint8 #f))
(check-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 0))
; it 'should not decode when condition is a function and falsy', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+Optional uint8 (λ _ #f)))
(check-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 0))
; it 'should decode when condition is omitted', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+Optional uint8))
(check-not-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 1))
;
; it 'should decode when condition is truthy', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+Optional uint8 #t))
(check-not-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 1))
; it 'should decode when condition is a function and truthy', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(define optional (+Optional uint8 (λ _ #t)))
(check-not-equal? (decode optional) (void))
(check-equal? (pos (current-input-port)) 1))
; describe 'size', ->
(check-equal? (size (+Optional uint8 #f)) 0)
;
; it 'should return 0 when condition is a function and falsy', ->
(check-equal? (size (+Optional uint8 (λ _ #f))) 0)
; it 'should return given type size when condition is omitted', ->
(check-equal? (size (+Optional uint8)) 1)
; it 'should return given type size when condition is truthy', ->
(check-equal? (size (+Optional uint8 #t)) 1)
; it 'should return given type size when condition is a function and truthy', ->
(check-equal? (size (+Optional uint8 (λ _ #t))) 1)
; describe 'encode', ->
; it 'should not encode when condition is falsy', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+Optional uint8 #f))
(encode optional 128)
(check-equal? (dump (current-output-port)) (bytes)))
; it 'should not encode when condition is a function and falsy', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+Optional uint8 (λ _ #f)))
(encode optional 128)
(check-equal? (dump (current-output-port)) (bytes)))
;
; it 'should encode when condition is omitted', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+Optional uint8))
(encode optional 128)
(check-equal? (dump (current-output-port)) (bytes 128)))
; it 'should encode when condition is truthy', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+Optional uint8 #t))
(encode optional 128)
(check-equal? (dump (current-output-port)) (bytes 128)))
; it 'should encode when condition is a function and truthy', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define optional (+Optional uint8 (λ _ #t)))
(encode optional 128)
(check-equal? (dump (current-output-port)) (bytes 128)))

234
pitfall/xenomorph/test/pointer-test.rkt
Unescape Escape View File

@ -1,234 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
|#
;describe 'Pointer', ->
; describe 'decode', ->
; it 'should handle null pointers', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0))])
(check-false (decode (+Pointer uint8 uint8) #:parent (mhash '_startOffset 50))))
; it 'should use local offsets from start of parent by default', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(check-equal? (decode (+Pointer uint8 uint8) #:parent (mhash '_startOffset 0)) 53))
; it 'should support immediate offsets', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(check-equal? (decode (+Pointer uint8 uint8 (mhash 'type 'immediate))) 53))
; it 'should support offsets relative to the parent', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0 0 1 53))])
(pos (current-input-port) 2)
(check-equal? (decode (+Pointer uint8 uint8 (mhash 'type 'parent))
#:parent (mhash 'parent (mhash '_startOffset 2))) 53))
; it 'should support global offsets', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 4 0 0 0 53))])
(pos (current-input-port) 2)
(check-equal? (decode (+Pointer uint8 uint8 (mhash 'type 'global))
#:parent (mhash 'parent (mhash 'parent (mhash '_startOffset 2))))
53))
; it 'should support offsets relative to a property on the parent', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 0 0 0 0 53))])
(check-equal? (decode (+Pointer uint8 uint8 (mhash 'relativeTo (λ (ctx) (· ctx parent ptr))))
#:parent (mhash '_startOffset 0 'parent (mhash 'ptr 4)))
53))
; it 'should support returning pointer if there is no decode type', ->
(parameterize ([current-input-port (open-input-bytes (bytes 4))])
(check-equal? (decode (+Pointer uint8 'void)
#:parent (mhash '_startOffset 0)) 4))
; it 'should support decoding pointers lazily', ->
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(define res (decode (+Struct (dictify 'ptr (+Pointer uint8 uint8 (mhasheq 'lazy #t))))))
(check-true (LazyThunk? (hash-ref (get-field _kv res) 'ptr)))
(check-equal? (· res ptr) 53))
; describe 'size', ->
(let ([ctx (mhash 'pointerSize 0)])
(check-equal? (size (+Pointer uint8 uint8) 10 ctx) 1)
(check-equal? (· ctx pointerSize) 1))
; it 'should add to immediate pointerSize', ->
(let ([ctx (mhash 'pointerSize 0)])
(check-equal? (size (+Pointer uint8 uint8 (mhash 'type 'immediate)) 10 ctx) 1)
(check-equal? (· ctx pointerSize) 1))
; it 'should add to parent pointerSize', ->
(let ([ctx (mhash 'parent (mhash 'pointerSize 0))])
(check-equal? (size (+Pointer uint8 uint8 (mhash 'type 'parent)) 10 ctx) 1)
(check-equal? (· ctx parent pointerSize) 1))
; it 'should add to global pointerSize', ->
(let ([ctx (mhash 'parent (mhash 'parent (mhash 'parent (mhash 'pointerSize 0))))])
(check-equal? (size (+Pointer uint8 uint8 (mhash 'type 'global)) 10 ctx) 1)
(check-equal? (· ctx parent parent parent pointerSize) 1))
; it 'should handle void pointers', ->
(let ([ctx (mhash 'pointerSize 0)])
(check-equal? (size (+Pointer uint8 'void) (+VoidPointer uint8 50) ctx) 1)
(check-equal? (· ctx pointerSize) 1))
; it 'should throw if no type and not a void pointer', ->
(let ([ctx (mhash 'pointerSize 0)])
(check-exn exn:fail:contract? (λ () (size (+Pointer uint8 'void) 30 ctx))))
; it 'should return a fixed size without a value', ->
(check-equal? (size (+Pointer uint8 uint8)) 1)
; describe 'encode', ->
; it 'should handle null pointers', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'pointerSize 0
'startOffset 0
'pointerOffset 0
'pointers null))
(encode (+Pointer uint8 uint8) #f #:parent ctx)
(check-equal? (· ctx pointerSize) 0)
(check-equal? (dump (current-output-port)) (bytes 0)))
; it 'should handle local offsets', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'pointerSize 0
'startOffset 0
'pointerOffset 1
'pointers null))
(encode (+Pointer uint8 uint8) 10 #:parent ctx)
(check-equal? (· ctx pointerOffset) 2)
(check-equal? (· ctx pointers) (list (mhasheq 'type uint8
'val 10
'parent ctx)))
(check-equal? (dump (current-output-port)) (bytes 1)))
; it 'should handle immediate offsets', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'pointerSize 0
'startOffset 0
'pointerOffset 1
'pointers null))
(encode (+Pointer uint8 uint8 (mhash 'type 'immediate)) 10 #:parent ctx)
(check-equal? (· ctx pointerOffset) 2)
(check-equal? (· ctx pointers) (list (mhasheq 'type uint8
'val 10
'parent ctx)))
(check-equal? (dump (current-output-port)) (bytes 0)))
; it 'should handle offsets relative to parent', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'parent (mhash 'pointerSize 0
'startOffset 3
'pointerOffset 5
'pointers null)))
(encode (+Pointer uint8 uint8 (mhash 'type 'parent)) 10 #:parent ctx)
(check-equal? (· ctx parent pointerOffset) 6)
(check-equal? (· ctx parent pointers) (list (mhasheq 'type uint8
'val 10
'parent ctx)))
(check-equal? (dump (current-output-port)) (bytes 2)))
; it 'should handle global offsets', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'parent
(mhash 'parent
(mhash 'parent (mhash 'pointerSize 0
'startOffset 3
'pointerOffset 5
'pointers null)))))
(encode (+Pointer uint8 uint8 (mhash 'type 'global)) 10 #:parent ctx)
(check-equal? (· ctx parent parent parent pointerOffset) 6)
(check-equal? (· ctx parent parent parent pointers) (list (mhasheq 'type uint8
'val 10
'parent ctx)))
(check-equal? (dump (current-output-port)) (bytes 5)))
; it 'should support offsets relative to a property on the parent', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'pointerSize 0
'startOffset 0
'pointerOffset 10
'pointers null
'val (mhash 'ptr 4)))
(encode (+Pointer uint8 uint8 (mhash 'relativeTo (λ (ctx) (· ctx ptr)))) 10 #:parent ctx)
(check-equal? (· ctx pointerOffset) 11)
(check-equal? (· ctx pointers) (list (mhasheq 'type uint8
'val 10
'parent ctx)))
(check-equal? (dump (current-output-port)) (bytes 6)))
; it 'should support void pointers', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'pointerSize 0
'startOffset 0
'pointerOffset 1
'pointers null))
(encode (+Pointer uint8 'void) (+VoidPointer uint8 55) #:parent ctx)
(check-equal? (· ctx pointerOffset) 2)
(check-equal? (· ctx pointers) (list (mhasheq 'type uint8
'val 55
'parent ctx)))
(check-equal? (dump (current-output-port)) (bytes 1)))
; it 'should throw if not a void pointer instance', ->
(parameterize ([current-output-port (open-output-bytes)])
(define ctx (mhash 'pointerSize 0
'startOffset 0
'pointerOffset 1
'pointers null))
(check-exn exn:fail:contract? (λ () (encode (+Pointer uint8 'void) 44 #:parent ctx))))

6
pitfall/xenomorph/test/racket.rkt
Unescape Escape View File

@ -1,6 +0,0 @@
#lang racket/base
(require rackunit xenomorph "../private/racket.rkt")
(provide (all-from-out rackunit xenomorph "../private/racket.rkt"))
(module reader syntax/module-reader
#:language 'xenomorph/test/racket)

33
pitfall/xenomorph/test/reserved-test.rkt
Unescape Escape View File

@ -1,33 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Reserved.coffee
|#
;describe 'Reserved', ->
; it 'should have a default count of 1', ->
(check-equal? (size (+Reserved uint8)) 1)
; it 'should allow custom counts and types', ->
(check-equal? (size (+Reserved uint16be 10)) 20)
; it 'should decode', ->
(parameterize ([current-input-port (open-input-bytes (bytes 0 0))])
(define reserved (+Reserved uint16be))
(check-equal? (decode reserved) (void))
(check-equal? (pos (current-input-port)) 2))
; it 'should encode', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define reserved (+Reserved uint16be))
(encode reserved #f)
(check-equal? (dump (current-output-port)) (bytes 0 0)))

129
pitfall/xenomorph/test/string-test.rkt
Unescape Escape View File

@ -1,129 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/String.coffee
|#
;describe 'String', ->
; describe 'decode', ->
; it 'should decode fixed length', ->
(parameterize ([current-input-port (open-input-bytes #"testing")])
(check-equal? (decode (+StringT 7)) "testing"))
; it 'should decode length from parent key', ->
(parameterize ([current-input-port (open-input-bytes #"testing")])
(check-equal? (decode (+StringT 'len) #:parent (mhash 'len 7)) "testing"))
; it 'should decode length as number before string', ->
(parameterize ([current-input-port (open-input-bytes #"\x07testing")])
(check-equal? (decode (+StringT uint8) #:parent (mhash 'len 7)) "testing"))
;; it 'should decode utf8', ->
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻"))])
(check-equal? (decode (+StringT 4 'utf8)) "🍻"))
;; it 'should decode encoding computed from function', ->
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻"))])
(check-equal? (decode (+StringT 4 (λ _ 'utf8))) "🍻"))
; it 'should decode null-terminated string and read past terminator', ->
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻\x00"))])
(check-equal? (decode (+StringT #f 'utf8)) "🍻")
(check-equal? (pos (current-input-port)) 5))
; it 'should decode remainder of buffer when null-byte missing', ->
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "🍻"))])
(check-equal? (decode (+StringT #f 'utf8)) "🍻"))
; describe 'size', ->
; it 'should use string length', ->
(check-equal? (size (+StringT 7) "testing") 7)
; it 'should use correct encoding', ->
(check-equal? (size (+StringT 10 'utf8) "🍻") 4)
; it 'should use encoding from function', ->
(check-equal? (size (+StringT 10 (λ _ 'utf8)) "🍻") 4)
; it 'should add size of length field before string', ->
(check-equal? (size (+StringT uint8 'utf8) "🍻") 5)
; todo
; it 'should work with utf16be encoding', ->
; it 'should take null-byte into account', ->
(check-equal? (size (+StringT #f 'utf8) "🍻") 5)
; it 'should use defined length if no value given', ->
(check-equal? (size (+StringT 10)) 10)
;
; describe 'encode', ->
; it 'should encode using string length', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(encode (+StringT 7) "testing")
(check-equal? (dump (current-output-port)) #"testing"))
; it 'should encode length as number before string', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(encode (+StringT uint8) "testing")
(check-equal? (dump (current-output-port)) #"\x07testing"))
; it 'should encode length as number before string utf8', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(encode (+StringT uint8 'utf8) "testing 😜")
(check-equal? (dump (current-output-port)) (string->bytes/utf-8 "\x0ctesting 😜")))
; it 'should encode utf8', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(encode (+StringT 4 'utf8) "🍻" )
(check-equal? (dump (current-output-port)) (string->bytes/utf-8 "🍻")))
; it 'should encode encoding computed from function', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(encode (+StringT 4 (λ _ 'utf8)) "🍻")
(check-equal? (dump (current-output-port)) (string->bytes/utf-8 "🍻")))
; it 'should encode null-terminated string', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(encode (+StringT #f 'utf8) "🍻" )
(check-equal? (dump (current-output-port)) (string->bytes/utf-8 "🍻\x00")))

121
pitfall/xenomorph/test/struct-test.rkt
Unescape Escape View File

@ -1,121 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
|#
;describe 'Struct', ->
; describe 'decode', ->
; it 'should decode into an object', ->
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal?
(dump (decode (+Struct (dictify 'name (+StringT uint8)
'age uint8))))
(hasheq 'name "roxyb" 'age 21)))
; it 'should support process hook', ->
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (+Struct (dictify 'name (+StringT uint8)
'age uint8)))
(set-field! post-decode struct (λ (o . _) (ref-set! o 'canDrink (>= (· o age) 21)) o))
(check-equal? (dump (decode struct))
(hasheq 'name "roxyb" 'age 32 'canDrink #t)))
; it 'should support function keys', ->
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (+Struct (dictify 'name (+StringT uint8)
'age uint8
'canDrink (λ (o) (>= (ref o 'age) 21)))))
(check-equal? (dump (decode struct))
(hasheq 'name "roxyb" 'age 32 'canDrink #t)))
;
; describe 'size', ->
; it 'should compute the correct size', ->
(check-equal? (size (+Struct (dictify
'name (+StringT uint8)
'age uint8))
(hasheq 'name "roxyb" 'age 32)) 7)
; it 'should compute the correct size with pointers', ->
(check-equal? (size (+Struct (dictify
'name (+StringT uint8)
'age uint8
'ptr (+Pointer uint8 (+StringT uint8))))
(mhash 'name "roxyb" 'age 21 'ptr "hello")) 14)
; it 'should get the correct size when no value is given', ->
(check-equal? (size (+Struct (dictify
'name (+StringT 4)
'age uint8))) 5)
; it 'should throw when getting non-fixed length size and no value is given', ->
(check-exn exn:fail:contract? (λ () (size (+Struct (dictify 'name (+StringT uint8)
'age uint8)))))
;
; describe 'encode', ->
; it 'should encode objects to buffers', (done) ->
; stream = new EncodeStream
; stream.pipe concat (buf) ->
; buf.should.deep.equal new Buffer '\x05roxyb\x15'
; done()
;
; struct = new Struct
; name: new StringT uint8
; age: uint8
;
; struct.encode stream,
; name: 'roxyb'
; age: 21
;
; stream.end()
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (dump (decode (+Struct (dictify 'name (+StringT uint8)
'age uint8))))
(hasheq 'name "roxyb" 'age 21)))
; it 'should support preEncode hook', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define struct (+Struct (dictify 'nameLength uint8
'name (+StringT 'nameLength)
'age uint8)))
(set-field! pre-encode struct (λ (val port) (ref-set! val 'nameLength (length (ref val 'name))) val))
(encode struct (mhasheq 'name "roxyb" 'age 21))
(check-equal? (dump (current-output-port)) #"\x05roxyb\x15"))
; it 'should encode pointer data after structure', (done) ->
(parameterize ([current-output-port (open-output-bytes)])
(define struct (+Struct (dictify 'name (+StringT uint8)
'age uint8
'ptr (+Pointer uint8 (+StringT uint8)))))
(encode struct (hasheq 'name "roxyb" 'age 21 'ptr "hello"))
(check-equal? (dump (current-output-port)) #"\x05roxyb\x15\x08\x05hello"))

19
pitfall/xenomorph/test/test.rkt
Unescape Escape View File

@ -1,19 +0,0 @@
#lang racket/base
(require "racket.rkt")
(define Person
(make-object Struct
(list (cons 'name (make-object StringT uint8 'utf8))
(cons 'age uint8))))
;; decode a person from a buffer
(define stream-in (make-object DecodeStream #"\4MikeA"))
(define x (send Person decode stream-in))
(test-module
(check-equal? (dict-ref x 'name) "Mike")
(check-equal? (dict-ref x 'age) 65))
;; encode a person from a hash
(test-module
(check-equal? (send Person encode #f (hasheq 'name "Mike" 'age 65)) #"\4MikeA"))

340
pitfall/xenomorph/test/versioned-struct-test.rkt
Unescape Escape View File

@ -1,340 +0,0 @@
#lang racket/base
(require "racket.rkt")
#|
approximates
https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffee
|#
;describe 'VersionedStruct', ->
; describe 'decode', ->
; it 'should get version from number type', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb"
'age 21
'version 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 🤘\x15\x00"))])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb 🤘"
'age 21
'version 1
'gender 0))))
; it 'should throw for unknown version', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")])
(check-exn exn:fail:contract? (λ () (decode struct)))))
;
; it 'should support common header block', ->
(let ([struct (+VersionedStruct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+StringT uint8 'ascii))
1 (dictify 'name (+StringT uint8 'utf8)
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb"
'age 21
'alive 1
'version 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 🤘\x00"))])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb 🤘"
'age 21
'version 1
'alive 1
'gender 0))))
; it 'should support parent version key', ->
(let ([struct (+VersionedStruct 'version
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "roxyb"
'age 21
'version 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 🤘\x15\x00"))])
(check-equal? (dump (decode struct #:parent (mhash 'version 1))) (hasheq 'name "roxyb 🤘"
'age 21
'version 1
'gender 0))))
;
; it 'should support sub versioned structs', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8))
1 (dictify 'name (+StringT uint8)
'isDessert uint8)))))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "roxyb"
'age 21
'version 0)))
(parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "pasta"
'version 0)))
(parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")])
(check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "ice cream"
'isDessert 1
'version 1))))
;
; it 'should support process hook', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(set-field! post-decode struct (λ (o stream ctx) (ref-set! o 'processed "true") o))
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (dump (decode struct)) (hasheq 'name "roxyb"
'processed "true"
'age 21
'version 0))))
;
; describe 'size', ->
; it 'should compute the correct size', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(check-equal? (size struct (mhasheq 'name "roxyb"
'age 21
'version 0)) 8)
(check-equal? (size struct (mhasheq 'name "roxyb 🤘"
'gender 0
'age 21
'version 1)) 14))
;
; it 'should throw for unknown version', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size struct (mhasheq 'name "roxyb"
'age 21
'version 5)))))
;
; it 'should support common header block', ->
(let ([struct (+VersionedStruct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+StringT uint8 'ascii))
1 (dictify 'name (+StringT uint8 'utf8)
'gender uint8)))])
(check-equal? (size struct (mhasheq 'name "roxyb"
'age 21
'alive 1
'version 0)) 9)
(check-equal? (size struct (mhasheq 'name "roxyb 🤘"
'gender 0
'age 21
'alive 1
'version 1)) 15))
; it 'should compute the correct size with pointers', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'ptr (+Pointer uint8 (+StringT uint8)))))])
(check-equal? (size struct (mhasheq 'name "roxyb"
'age 21
'version 1
'ptr "hello")) 15))
;
; it 'should throw if no value is given', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size struct))))
; describe 'encode', ->
; it 'should encode objects to buffers', (done) ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))]
[port (open-output-bytes)])
(encode struct (mhasheq 'name "roxyb"
'age 21
'version 0) port)
(encode struct (mhasheq 'name "roxyb 🤘"
'age 21
'gender 0
'version 1) port)
(check-equal? (dump port) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00")))
;
; it 'should throw for unknown version', ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))]
[port (open-output-bytes)])
(check-exn exn:fail:contract? (λ () (encode struct port (mhasheq 'name "roxyb"
'age 21
'version 5)))))
; it 'should support common header block', (done) ->
(let ([struct (+VersionedStruct uint8
(dictify
'header (dictify 'age uint8
'alive uint8)
0 (dictify 'name (+StringT uint8 'ascii))
1 (dictify 'name (+StringT uint8 'utf8)
'gender uint8)))]
[stream (open-output-bytes)])
(encode struct (mhasheq 'name "roxyb"
'age 21
'alive 1
'version 0) stream)
(encode struct (mhasheq 'name "roxyb 🤘"
'gender 0
'age 21
'alive 1
'version 1) stream)
(check-equal? (dump stream) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 🤘\x00")))
; it 'should encode pointer data after structure', (done) ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'ptr (+Pointer uint8 (+StringT uint8)))))]
[stream (open-output-bytes)])
(encode struct (mhasheq 'version 1
'name "roxyb"
'age 21
'ptr "hello") stream)
(check-equal? (dump stream) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello")))
; it 'should support preEncode hook', (done) ->
(let ([struct (+VersionedStruct uint8
(dictify
0 (dictify 'name (+StringT uint8 'ascii)
'age uint8)
1 (dictify 'name (+StringT uint8 'utf8)
'age uint8
'gender uint8)))]
[stream (open-output-bytes)])
(set-field! pre-encode struct (λ (val port) (ref-set! val 'version (if (ref val 'gender) 1 0)) val))
(encode struct (mhasheq 'name "roxyb"
'age 21
'version 0) stream)
(encode struct (mhasheq 'name "roxyb 🤘"
'age 21
'gender 0) stream)
(check-equal? (dump stream) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00")))

5
pitfall/xenomorph/versioned-struct.rkt
Unescape Escape View File

@ -1,5 +0,0 @@
#lang racket/base
(require "private/racket.rkt")
(r+p "private/versioned-struct.rkt")
Write Preview
Loading…
Cancel
Save