From fee9c8fd4df86243d4d879c3d4a3f48e5ad55e2d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 4 Jul 2017 09:16:16 -0700 Subject: [PATCH] portify --- pitfall/xenomorph/private/array.rkt | 32 ++++----- pitfall/xenomorph/private/base.rkt | 50 +++++++++++--- pitfall/xenomorph/private/bitfield.rkt | 15 ++--- pitfall/xenomorph/private/buffer.rkt | 6 +- pitfall/xenomorph/private/enum.rkt | 2 +- pitfall/xenomorph/private/number.rkt | 92 +++++++++++++------------- pitfall/xenomorph/private/reserved.rkt | 2 +- pitfall/xenomorph/private/stream.rkt | 27 +------- pitfall/xenomorph/private/string.rkt | 5 +- 9 files changed, 119 insertions(+), 112 deletions(-) diff --git a/pitfall/xenomorph/private/array.rkt b/pitfall/xenomorph/private/array.rkt index 2c0d4788..3b8d2763 100644 --- a/pitfall/xenomorph/private/array.rkt +++ b/pitfall/xenomorph/private/array.rkt @@ -29,13 +29,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee [else (· stream length_)])) (for/list ([i (in-naturals)] #:break (= (· stream pos) end-pos)) - (send type decode stream ctx))] + (send type decode stream ctx))] ;; we have decoded-len, which is treated as count of items [else (for/list ([i (in-range decoded-len)]) - (send type decode stream ctx))])) + (send type decode stream ctx))])) - (define/override (size [val #f] [ctx #f]) + (define/augride (size [val #f] [ctx #f]) (when val (unless (countable? val) (raise-argument-error 'Array:size "list or countable" val))) (cond @@ -43,37 +43,37 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (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))))] + (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 stream array [parent #f]) + (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) - (for ([item (in-list (countable->list array))]) - (send type encode stream item ctx))) + (define results (for/list ([item (in-list (countable->list array))]) + (send type encode port item ctx))) + (unless port (apply bytes-append results))) (cond [(NumberT? len) (define ctx (mhash 'pointers null - 'startOffset (· stream pos) + 'startOffset (· port pos) 'parent parent)) - (ref-set! ctx 'pointerOffset (+ (· stream pos) (size array ctx))) - (send len encode stream (length array)) ; encode length at front + (ref-set! ctx 'pointerOffset (+ (· port pos) (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 stream (· ptr val)))] + (send (· ptr type) encode port (· ptr val)))] [else (encode-items parent)]))) (define-values (Array Array? +Array) (values ArrayT ArrayT? +ArrayT)) (test-module - (define stream (+DecodeStream #"ABCDEFG")) (define A (+Array uint16be 3)) - (check-equal? (send A decode stream) '(16706 17220 17734)) - (check-equal? (send A encode #f '(16706 17220 17734)) #"ABCDEF") - (check-equal? (send (+Array uint16be) size '(1 2 3)) 6) - (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40)) + (check-equal? (decode A #"ABCDEFG") '(16706 17220 17734)) + (check-equal? (encode A '(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)) diff --git a/pitfall/xenomorph/private/base.rkt b/pitfall/xenomorph/private/base.rkt index 120f92d3..32030dd2 100644 --- a/pitfall/xenomorph/private/base.rkt +++ b/pitfall/xenomorph/private/base.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require racket/class sugar/class racket/generic racket/private/generic-methods) +(require racket/class sugar/class racket/generic racket/private/generic-methods "generic.rkt") +(require sugar/debug) (provide (all-defined-out)) (define-generics codable @@ -35,16 +36,49 @@ (define (dump o) (send o dump)))]))) -(define RestructureBase +(define xenomorph-base% (class* object% (codable<%> sizable<%> dumpable<%>) (super-new) (field [_hash (make-hash)] [_list null]) - (define/public (decode stream . args) (void)) - (define/public (encode . xs) (void)) - (define/public (size . xs) (void)) - (define/public (process . args) (void)) - (define/public (preEncode . args) (void)) + + (define/pubment (decode port [parent #f]) + (when parent (unless (indexable? parent) + (raise-argument-error 'Xenomorph "indexable" parent))) + (define ip (cond + [(bytes? port) (open-input-bytes port)] + [(input-port? port) port] + [else (raise-argument-error 'Xenomorph "bytes or input port" port)])) + (post-decode (inner (void) decode ip parent))) + + (define/pubment (encode port val-in [parent #f]) + #;(report* port val-in parent) + (define val (pre-encode val-in)) + (when parent (unless (indexable? parent) + (raise-argument-error 'Xenomorph "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 port val parent)) + (when (bytes? encode-result) + (write-bytes encode-result op)) + (when (not port) (get-output-bytes op))) + + (define/pubment (size [val #f] [parent #f]) + (when parent (unless (indexable? parent) + (raise-argument-error 'Xenomorph "indexable" parent))) + (define result (inner (void) size val parent)) + (when result (unless (and (integer? result) (not (negative? result))) + (raise-argument-error 'Xenomorph "integer" result))) + result) + + (define/public (post-decode val) val) + (define/public (pre-encode val) val) (define/public (dump) (void)))) -(define-class-predicates RestructureBase) \ No newline at end of file +(define-class-predicates xenomorph-base%) + +(define-subclass xenomorph-base% (RestructureBase)) +(define-subclass RestructureBase (Streamcoder)) + diff --git a/pitfall/xenomorph/private/bitfield.rkt b/pitfall/xenomorph/private/bitfield.rkt index aa0dd35e..60dc8c16 100644 --- a/pitfall/xenomorph/private/bitfield.rkt +++ b/pitfall/xenomorph/private/bitfield.rkt @@ -19,19 +19,19 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee (hash-set! flag-hash flag (bitwise-bit-set? val i))) flag-hash) - (define/override (size . _) (send type size)) + (define/augment (size . _) (send type size)) - (define/augment (encode stream flag-hash [ctx #f]) - (define bitfield-integer (for/sum ([(flag i) (in-indexed flags)] + (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 stream bitfield-integer))) + (send type encode port bit-int))) (test-module (require "number.rkt" "stream.rkt") (define bfer (+Bitfield uint16be '(bold italic underline #f shadow condensed extended))) - (define bf (send bfer decode (+DecodeStream #"\0\25"))) + (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)) @@ -39,7 +39,4 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee (check-false (ref bf 'italic)) (check-false (ref bf 'condensed)) (check-false (ref bf 'extended)) - - (define os (+EncodeStream)) - (send bfer encode os bf) - (check-equal? (send os dump) #"\0\25")) \ No newline at end of file + (check-equal? (encode bfer bf #f) #"\0\25")) \ No newline at end of file diff --git a/pitfall/xenomorph/private/buffer.rkt b/pitfall/xenomorph/private/buffer.rkt index 2190f582..45d78fb8 100644 --- a/pitfall/xenomorph/private/buffer.rkt +++ b/pitfall/xenomorph/private/buffer.rkt @@ -21,18 +21,18 @@ A Restructure RBuffer object is separate. (define-subclass RestructureBase (RBuffer [len #xffff]) - (define/override (decode port [parent #f]) + (define/augment (decode port [parent #f]) (define decoded-len (resolve-length len port parent)) (read-bytes decoded-len port)) - (define/override (size [val #f] [parent #f]) + (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/override (encode port buf [parent #f]) + (define/augment (encode port buf [parent #f]) (unless (bytes? buf) (raise-argument-error 'Buffer:encode "bytes" buf)) (define op (or port (open-output-bytes))) diff --git a/pitfall/xenomorph/private/enum.rkt b/pitfall/xenomorph/private/enum.rkt index ceebeace..9778b7a9 100644 --- a/pitfall/xenomorph/private/enum.rkt +++ b/pitfall/xenomorph/private/enum.rkt @@ -13,7 +13,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee (define index (send type decode stream)) (or (list-ref options index) index)) - (define/override (size . _) (send type size)) + (define/augment (size . _) (send type size)) (define/augment (encode stream val [ctx #f]) (define index (index-of options val)) diff --git a/pitfall/xenomorph/private/number.rkt b/pitfall/xenomorph/private/number.rkt index 7066c92d..f0560b73 100644 --- a/pitfall/xenomorph/private/number.rkt +++ b/pitfall/xenomorph/private/number.rkt @@ -1,5 +1,5 @@ #lang reader (submod "racket.rkt" reader) -(require "stream.rkt" "sizes.rkt" (for-syntax "sizes.rkt" racket/match)) +(require "sizes.rkt" (for-syntax "sizes.rkt" racket/match)) (provide (all-defined-out)) #| @@ -21,7 +21,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define (exact-if-possible x) (if (integer? x) (inexact->exact x) x)) (define system-endian (if (system-big-endian?) 'be 'le)) -(define-subclass Streamcoder (Integer [type 'uint16] [endian system-endian]) +(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)) @@ -34,7 +34,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define bits (* _size 8)) - (define/override (size . args) _size) + (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)). @@ -43,44 +43,44 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee [delta (if _signed? 0 signed-min)]) (values (- signed-min delta) (- signed-max delta)))) - (define/augment (decode stream . args) - (define bstr (send stream readBuffer _size)) + (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)))) - (post-decode unsigned-int)) + unsigned-int) - (define/public (post-decode unsigned-int) - (if _signed? (unsigned->signed unsigned-int bits) unsigned-int)) + (define/override (post-decode unsigned-val) + (if _signed? (unsigned->signed unsigned-val bits) unsigned-val)) - (define/public (pre-encode val-in) - (exact-if-possible val-in)) + (define/override (pre-encode val) + (exact-if-possible val)) - (define/augment (encode stream val-in [parent #f]) - (define val (pre-encode val-in)) + (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)))) - (define bstr (apply bytes ((if (eq? endian 'be) identity reverse) bs))) - (send stream write bstr))) + (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 Streamcoder (Float _size [endian system-endian]) + +(define-subclass xenomorph-base% (Float _size [endian system-endian]) (define byte-size (/ _size 8)) - (define/augment (decode stream . args) ; convert int to float - (define bs (send stream readBuffer byte-size)) + (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 stream val-in [parent #f]) ; convert float to int - (define bs (real->floating-point-bytes val-in byte-size (eq? endian 'be))) - (send stream write bs)) + (define/augment (encode 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/override (size . args) byte-size)) (define-instance float (make-object Float 32)) (define-instance floatbe (make-object Float 32 'be)) @@ -111,34 +111,34 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (test-module (check-exn exn:fail:contract? (λ () (+Integer 'not-a-valid-type))) - (check-exn exn:fail:contract? (λ () (send uint8 encode (+EncodeStream) 256))) - (check-not-exn (λ () (send uint8 encode (+EncodeStream) 255))) - (check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) 256))) - (check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) 255))) - (check-not-exn (λ () (send int8 encode (+EncodeStream) 127))) - (check-not-exn (λ () (send int8 encode (+EncodeStream) -128))) - (check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) -129))) - (check-exn exn:fail:contract? (λ () (send uint16 encode (+EncodeStream) (add1 #xffff)))) - (check-not-exn (λ () (send uint16 encode (+EncodeStream) #xffff))) + (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 (+DecodeStream (bytes 1 2 3 4))] + [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 - (send o encode op 513) + (encode o 513 op) (check-equal? (get-output-bytes op) (bytes 1 2)) - (send o encode op 1027) + (encode o 1027 op) (check-equal? (get-output-bytes op) (bytes 1 2 3 4))) (let ([o (+Integer 'uint16 'be)] - [ip (+DecodeStream (bytes 1 2 3 4))] + [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 - (send o encode op 258) + (encode o 258 op) (check-equal? (get-output-bytes op) (bytes 1 2)) - (send o encode op 772) + (encode o 772 op) (check-equal? (get-output-bytes op) (bytes 1 2 3 4)))) @@ -172,17 +172,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (make-int-types) (test-module - (check-equal? (send uint8 size) 1) - (check-equal? (send uint16 size) 2) - (check-equal? (send uint32 size) 4) - (check-equal? (send double size) 8) + (check-equal? (size uint8) 1) + (check-equal? (size uint16) 2) + (check-equal? (size uint32) 4) + (check-equal? (size double) 8) - (define bs (send fixed16be encode #f 123.45)) + (define bs (encode fixed16be 123.45 #f)) (check-equal? bs #"{s") - (check-equal? (ceiling (* (send fixed16be decode bs) 100)) 12345.0) + (check-equal? (ceiling (* (decode fixed16be bs) 100)) 12345.0) - (check-equal? (send int8 decode (bytes 127)) 127) - (check-equal? (send int8 decode (bytes 255)) -1) + (check-equal? (decode int8 (bytes 127)) 127) + (check-equal? (decode int8 (bytes 255)) -1) - (check-equal? (send int8 encode #f -1) (bytes 255)) - (check-equal? (send int8 encode #f 127) (bytes 127))) + (check-equal? (encode int8 -1 #f) (bytes 255)) + (check-equal? (encode int8 127 #f) (bytes 127))) diff --git a/pitfall/xenomorph/private/reserved.rkt b/pitfall/xenomorph/private/reserved.rkt index 4efae96c..2ee8ff17 100644 --- a/pitfall/xenomorph/private/reserved.rkt +++ b/pitfall/xenomorph/private/reserved.rkt @@ -13,7 +13,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee (send stream pos (+ (· stream pos) (size #f parent))) (void)) - (define/override (size [val #f] [parent #f]) + (define/augment (size [val #f] [parent #f]) (* (send type size) (resolve-length count #f parent))) (define/augment (encode stream val [parent #f]) diff --git a/pitfall/xenomorph/private/stream.rkt b/pitfall/xenomorph/private/stream.rkt index 5f826e78..a275683f 100644 --- a/pitfall/xenomorph/private/stream.rkt +++ b/pitfall/xenomorph/private/stream.rkt @@ -196,35 +196,12 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee (check-exn exn:fail? (λ () (send ds read 1)))) -;; Streamcoder is a helper class that checks / converts stream arguments before decode / encode -;; not a subclass of DecodeStream or EncodeStream, however. -(define-subclass RestructureBase (Streamcoder) - (define/overment (decode x [parent #f]) - (when parent (unless (indexable? parent) - (raise-argument-error 'Streamcoder:decode "hash or indexable" x))) - (define stream (cond - [(bytes? x) (+DecodeStream x)] - [(input-port? x) (+DecodeStream (port->bytes x))] - [else x])) - (unless (DecodeStream? stream) - (raise-argument-error 'Streamcoder:decode "bytes or input port or DecodeStream" x)) - (inner (void) decode stream parent)) - - (define/overment (encode x [val #f] [parent #f]) - (define stream (cond - [(output-port? x) (+EncodeStream x)] - [(not x) (+EncodeStream)] - [else x])) - (unless (EncodeStream? stream) - (raise-argument-error 'Streamcoder:encode "output port or EncodeStream" x)) - (inner (void) encode stream val parent) - (when (not x) (send stream dump)))) (test-module - (define-subclass Streamcoder (Dummy) + (define-subclass xenomorph-base% (Dummy) (define/augment (decode stream parent) "foo") (define/augment (encode stream val parent) "bar") - (define/override (size) 42)) + (define/augment (size) 42)) (define d (+Dummy)) (check-true (Dummy? d)) diff --git a/pitfall/xenomorph/private/string.rkt b/pitfall/xenomorph/private/string.rkt index 18724b4b..8c07a84d 100644 --- a/pitfall/xenomorph/private/string.rkt +++ b/pitfall/xenomorph/private/string.rkt @@ -37,7 +37,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee (when (not len) (send stream writeUInt8 #x00)))) ; null terminated when no len - (define/override (size [val #f] [parent #f]) + (define/augment (size [val #f] [parent #f]) (if (not val) (resolve-length len #f parent) (let* ([encoding (if (procedure? encoding) @@ -54,8 +54,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee (test-module (require "stream.rkt") - (define stream (+DecodeStream #"\2BCDEF")) (define S (+String uint8 'utf8)) - (check-equal? (send S decode stream) "BC") + (check-equal? (send S decode #"\2BCDEF") "BC") (check-equal? (send S encode #f "Mike") #"\4Mike") (check-equal? (send (+String) size "foobar") 7)) ; null terminated when no len \ No newline at end of file