From da0615684dc275150131bacde2239b8dd20ba2d2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 16 Dec 2018 04:56:36 -0800 Subject: [PATCH] xla --- xenomorph/xenomorph/array.rkt | 22 ++++------ xenomorph/xenomorph/lazy-array.rkt | 43 +++++--------------- xenomorph/xenomorph/test/lazy-array-test.rkt | 18 ++++---- 3 files changed, 30 insertions(+), 53 deletions(-) diff --git a/xenomorph/xenomorph/array.rkt b/xenomorph/xenomorph/array.rkt index a6ad6d6b..41c50561 100644 --- a/xenomorph/xenomorph/array.rkt +++ b/xenomorph/xenomorph/array.rkt @@ -13,25 +13,19 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Array.coffee |# -(define xarray-base% +(define xarray% (class xenobase% (super-new) - (init-field type len) + (init-field type len length-type) + (unless (xenomorphic-type? type) (raise-argument-error '+xarray "xenomorphic type" type)) (unless (length-resolvable? len) - (raise-argument-error '+xarray "length-resolvable?" len)))) - -(define xarray% - (class xarray-base% - (super-new) - (init-field length-type) + (raise-argument-error '+xarray "length-resolvable?" len)) (unless (memq length-type '(bytes count)) (raise-argument-error '+xarray "'bytes or 'count" length-type)) - (inherit-field type len) - - (define/augment (xxdecode port parent) + (define/augride (xxdecode port parent) (define new-parent (if (xint? len) (mhasheq 'parent parent '_startOffset (pos port) @@ -56,7 +50,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee [else (for/list ([i (in-range resolved-len)]) (send type xxdecode port new-parent))])) - (define/augment (xxencode array port [parent #f]) + (define/augride (xxencode array port [parent #f]) (unless (sequence? array) (raise-argument-error 'xarray-encode "sequence" array)) (define (encode-items parent) @@ -79,7 +73,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port)))] [else (encode-items parent)])) - (define/augment (xxsize [val #f] [parent #f]) + (define/augride (xxsize [val #f] [parent #f]) (when val (unless (sequence? val) (raise-argument-error 'xarray-size "sequence" val))) (cond @@ -102,6 +96,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (new class [type (or type-arg type-kwarg)] [len (or len-arg len-kwarg)] [length-type (if count-bytes? 'bytes length-type-arg)])) + +(define (xarray? x) (is-a? x xarray%)) (module+ test (require rackunit "generic.rkt") diff --git a/xenomorph/xenomorph/lazy-array.rkt b/xenomorph/xenomorph/lazy-array.rkt index 23ea9ec0..984d574a 100644 --- a/xenomorph/xenomorph/lazy-array.rkt +++ b/xenomorph/xenomorph/lazy-array.rkt @@ -1,36 +1,17 @@ -#lang racket/base +#lang debug racket/base (require racket/class - "helper.rkt" "util.rkt" "number.rkt" "array.rkt" racket/stream racket/dict sugar/unstable/dict) + "helper.rkt" "util.rkt" "number.rkt" "array.rkt" racket/stream sugar/unstable/dict) (provide (all-defined-out)) #| approximates https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee |# - -#;(define (xlazy-array-decode xla [port-arg (current-input-port)] #:parent [parent #f]) - (define port (->input-port port-arg)) - (parameterize ([current-input-port port]) - )) - -#;(define (xlazy-array-encode xla val [port-arg (current-output-port)] #:parent [parent #f]) - ) - -#;(define (xlazy-array-size xla [val #f] #:parent [parent #f])) - -;; xarray-base holds type and len fields -#;(struct xlazy-array xarray-base () #:transparent - #:methods gen:xenomorphic - [(define decode xlazy-array-decode) - (define xdecode xlazy-array-decode) - (define encode xlazy-array-encode) - (define size xlazy-array-size)]) - + (define xlazy-array% - (class xarray-base% + (class xarray% (super-new) - (init-field lazy-type values) - (inherit-field len) + (inherit-field type len) (define/override (xxdecode port parent) (define starting-pos (pos port)) ; ! placement matters. `resolve-length` will change `pos` @@ -42,14 +23,12 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee '_length len) parent)]) (define starting-pos (pos port)) - (define type type) (begin0 (for/stream ([index (in-range decoded-len)]) (define orig-pos (pos port)) (pos port (+ starting-pos (* (send type xxsize #f parent) index))) - ;; use explicit `port` arg below because this evaluation is delayed (begin0 - (send this post-decode (send type xxdecode port parent)) + (send type xxdecode port parent) (pos port orig-pos))) (pos port (+ (pos port) (* decoded-len (send type xxsize #f parent))))))) @@ -57,7 +36,7 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee (super xxencode (if (stream? val) (stream->list val) val) port parent)) (define/override (xxsize [val #f] [parent #f]) - (super xxsize (if (stream? val) (stream->list val) val) parent)))) + (super xxsize (if (stream? val) (stream->list val) val) parent)))) (define (+xlazy-array [type-arg #f] [len-arg #f] #:type [type-kwarg #f] @@ -65,11 +44,9 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee #:subclass [class xlazy-array%]) (define type (or type-arg type-kwarg)) (define len (or len-arg len-kwarg)) - (unless (xenomorphic-type? type) - (raise-argument-error '+xarray "xenomorphic type" type)) - (unless (length-resolvable? len) - (raise-argument-error '+xarray "length-resolvable?" len)) - (new class [type type] [len len])) + (new class [type type] + [len len] + [length-type 'count])) (module+ test (require rackunit "number.rkt" "generic.rkt") diff --git a/xenomorph/xenomorph/test/lazy-array-test.rkt b/xenomorph/xenomorph/test/lazy-array-test.rkt index e1d76c0d..b7db4755 100644 --- a/xenomorph/xenomorph/test/lazy-array-test.rkt +++ b/xenomorph/xenomorph/test/lazy-array-test.rkt @@ -1,11 +1,12 @@ #lang racket/base (require rackunit - racket/dict + racket/class racket/stream "../array.rkt" "../helper.rkt" "../number.rkt" - "../lazy-array.rkt") + "../lazy-array.rkt" + "../generic.rkt") #| approximates @@ -17,7 +18,6 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) (define xla (+xlazy-array uint8 4)) (define arr (decode xla)) - (check-false (xarray? arr)) (check-equal? (stream-length arr) 4) (check-equal? (pos (current-input-port)) 4) (check-equal? (stream-ref arr 0) 1) @@ -28,8 +28,10 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee (test-case "decode should decode items lazily with post-decode" (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) - (define xla (+xlazy-array uint8 4)) - (set-post-decode! xla (λ (val) (* 2 val))) + (define myxla% (class xlazy-array% + (super-new) + (define/override (post-decode str) (stream-map (λ (i) (* 2 i)) str)))) + (define xla (+xlazy-array uint8 4 #:subclass myxla%)) (define arr (decode xla)) (check-false (xarray? arr)) (check-equal? (stream-length arr) 4) @@ -70,7 +72,9 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee (test-case "encode should work with xlazy-arrays with pre-encode" (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) - (define xla (+xlazy-array uint8 4)) - (set-pre-encode! xla (λ (vals) (map (λ (val) (* 2 val)) vals))) + (define myxla% (class xlazy-array% + (super-new) + (define/override (pre-encode str) (stream-map (λ (val) (* 2 val)) str)))) + (define xla (+xlazy-array uint8 4 #:subclass myxla%)) (define arr (decode xla)) (check-equal? (encode xla arr #f) (bytes 2 4 6 8))))