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

tidy some issues with list length

Browse Source
main
Matthew Butterick 5 years ago
parent 201d4e7471
commit eee9a00f97
5 changed files with 84 additions and 36 deletions
Show Stats Download Patch File Download Diff File

75
xenomorph/xenomorph/list.rkt
Unescape Escape View File

@ -1,5 +1,7 @@
#lang debug racket/base
(require racket/class
racket/sequence
racket/contract
"base.rkt"
"int.rkt"
"util.rkt"
@ -17,11 +19,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
(init-field [(@type type)] [(@len len)] [(@count-bytes? count-bytes?)])
(unless (xenomorphic-type? @type)
(raise-argument-error 'x:array "xenomorphic type" @type))
(raise-argument-error 'x:list "xenomorphic type" @type))
(unless (length-resolvable? @len)
(raise-argument-error 'x:array "length-resolvable?" @len))
(raise-argument-error 'x:list "length-resolvable?" @len))
(unless (boolean? @count-bytes?)
(raise-argument-error 'x:array "boolean" @count-bytes?))
(raise-argument-error 'x:list "boolean" @count-bytes?))
(define/augride (x:decode port parent)
(define new-parent (if (x:int? @len)
@ -48,24 +50,26 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
[else (for/list ([i (in-range len)])
(send @type x:decode port new-parent))]))
(define/augride (x:encode array port [parent #f])
(unless (sequence? array)
(raise-argument-error 'xarray-encode "sequence" array))
(define/augride (x:encode val-arg port [parent #f])
(unless (sequence? val-arg)
(raise-argument-error 'x:list-encode "sequence" val-arg))
(define vals (if (list? val-arg) val-arg (sequence->list val-arg)))
;; if @len is not an integer, we have variable length
(define maybe-fixed-len (and (integer? @len) @len))
(when maybe-fixed-len
(unless (= (length vals) maybe-fixed-len)
(raise-argument-error 'x:list-encode "vals equal to length" maybe-fixed-len)))
(define (encode-items parent)
;; todo: should array with fixed length stop encoding after it reaches max?
;; cf. xstring, which rejects input that is too big for fixed length.
(let* (#;[items (sequence->list array)]
#;[item-count (length items)]
#;[max-items (if (number? (xarray-len xa)) (xarray-len xa) item-count)])
(for ([item (in-list array)])
(send @type x:encode item port parent))))
(for ([item (in-list vals)]
[idx (in-range (or maybe-fixed-len +inf.0))])
(send @type x:encode item port parent)))
(cond
[(x:int? @len)
(define new-parent (mhasheq x:pointers-key null
x:start-offset-key (pos port)
x:parent-key parent))
(hash-set! new-parent x:pointer-offset-key (+ (pos port) (x:size array new-parent)))
(send @len x:encode (length array) port) ; encode length at front
(hash-set! new-parent x:pointer-offset-key (+ (pos port) (x:size vals new-parent)))
(send @len x:encode (length vals) port) ; encode length at front
(encode-items new-parent)
(for ([ptr (in-list (hash-ref new-parent x:pointers-key))]) ; encode pointer data at end
(send (x:ptr-type ptr) x:encode (x:ptr-val ptr) port))]
@ -86,18 +90,39 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
(define size (send @type x:size #f parent))
(* size count)]))))
(define (x:list [type-arg #f] [len-arg #f] [length-type-arg 'count]
#:type [type-kwarg #f]
#:length [len-kwarg #f]
#:count-bytes [count-bytes? #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:list%])
(new (generate-subclass base-class pre-proc post-proc) [type (or type-arg type-kwarg)]
[len (or len-arg len-kwarg)]
(define (x:list? x) (is-a? x x:list%))
(define/contract (x:list
[type-arg #f]
[len-arg #f]
#:type [type-kwarg uint8]
#:length [len-kwarg #f]
#:count-bytes [count-bytes? #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:list%])
(()
((or/c xenomorphic? #false)
(or/c length-resolvable? #false)
#:type (or/c xenomorphic? #false)
#:length (or/c length-resolvable? #false)
#:count-bytes boolean?
#:pre-encode (or/c (any/c . -> . any/c) #false)
#:post-decode (or/c (any/c . -> . any/c) #false)
#:base-class (λ (c) (subclass? c x:list%)))
. ->* .
x:list?)
(define type (or type-arg type-kwarg))
(unless (xenomorphic? type)
(raise-argument-error x:list "xenomorphic type" type))
(define len (or len-arg len-kwarg))
(unless (length-resolvable? len)
(raise-argument-error x:list "resolvable length" len))
(new (generate-subclass base-class pre-proc post-proc)
[type type]
[len len]
[count-bytes? count-bytes?]))
(define (x:list? x) (is-a? x x:list%))
(define x:array% x:list%)
(define x:array x:list)

31
xenomorph/xenomorph/stream.rkt
Unescape Escape View File

@ -1,5 +1,6 @@
#lang racket/base
(require racket/class
racket/contract
"base.rkt" "util.rkt" "number.rkt" "list.rkt" racket/stream sugar/unstable/dict)
(provide (all-defined-out))
@ -38,14 +39,32 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
(define/override (x:size [val #f] [parent #f])
(super x:size (if (stream? val) (stream->list val) val) parent))))
(define (x:stream [type-arg #f] [len-arg #f]
#:type [type-kwarg #f]
#:length [len-kwarg #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:stream%])
(define (x:stream? x) (is-a? x x:stream%))
(define/contract (x:stream
[type-arg #f]
[len-arg #f]
#:type [type-kwarg #f]
#:length [len-kwarg #f]
#:pre-encode [pre-proc #f]
#:post-decode [post-proc #f]
#:base-class [base-class x:stream%])
(()
((or/c xenomorphic? #false)
(or/c length-resolvable? #false)
#:type (or/c xenomorphic? #false)
#:length (or/c length-resolvable? #false)
#:pre-encode (or/c (any/c . -> . any/c) #false)
#:post-decode (or/c (any/c . -> . any/c) #false)
#:base-class (λ (c) (subclass? c x:stream%)))
. ->* .
x:stream?)
(define type (or type-arg type-kwarg))
(unless (xenomorphic? type)
(raise-argument-error x:stream "xenomorphic type" type))
(define len (or len-arg len-kwarg))
(unless (length-resolvable? len)
(raise-argument-error x:stream "resolvable length" len))
(new (generate-subclass base-class pre-proc post-proc) [type type]
[len len]
[count-bytes? #false]))

2
xenomorph/xenomorph/test/list-test.rkt
Unescape Escape View File

@ -97,7 +97,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(test-case
"list: encode using array length"
(check-equal? (encode (x:list #:type uint8 #:length 10) '(1 2 3 4) #f) (bytes 1 2 3 4)))
(check-equal? (encode (x:list #:type uint8 #:length 4) '(1 2 3 4) #f) (bytes 1 2 3 4)))
(test-case
"list: encode with pre-encode"

2
xenomorph/xenomorph/test/vector-test.rkt
Unescape Escape View File

@ -98,7 +98,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(test-case
"vector: encode using array length"
(check-equal? (encode (x:vector #:type uint8 #:length 10) '#(1 2 3 4) #f) (bytes 1 2 3 4)))
(check-equal? (encode (x:vector #:type uint8 #:length 4) '#(1 2 3 4) #f) (bytes 1 2 3 4)))
(test-case
"vector: encode with pre-encode"

10
xenomorph/xenomorph/util.rkt
Unescape Escape View File

@ -3,15 +3,19 @@
(provide (all-defined-out))
(define (length-resolvable? x)
(or (not x) (symbol? x) (xenomorphic? x) (procedure? x) (exact-nonnegative-integer? x)))
(or (not x)
(exact-nonnegative-integer? x)
(procedure? x)
(symbol? x)
(x:int? x)))
(define (resolve-length x port [parent #f])
(define (resolve-length x input-port [parent #f])
(match x
[#false #false]
[(? exact-nonnegative-integer?) x]
[(? procedure? proc) (proc parent)]
[(? symbol? key) #:when parent (dict-ref parent key)]
[(? x:int?) #:when port (decode x port)]
[(? x:int?) #:when input-port (decode x input-port)]
[_ (raise-argument-error 'resolve-length "fixed-size argument" x)]))
(define (pretty-print-bytes bstr

Write Preview
Loading…
Cancel
Save