From 601d3b58f559543cee0c958e52915ce7deb8338b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 23 Jun 2017 09:47:31 -0700 Subject: [PATCH] number tests pass --- pitfall/restructure/number-test.rkt | 165 +++++++++++++--------------- pitfall/restructure/number.rkt | 82 +++++++------- pitfall/sugar/class.rkt | 5 + 3 files changed, 128 insertions(+), 124 deletions(-) diff --git a/pitfall/restructure/number-test.rkt b/pitfall/restructure/number-test.rkt index a1e8311b..28c4f27e 100644 --- a/pitfall/restructure/number-test.rkt +++ b/pitfall/restructure/number-test.rkt @@ -66,15 +66,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; uint16be.encode(stream, 0xabff) ; stream.end() -(let ([stream (+DecodeStream (bytes #xab #xff))]) - (check-equal? (send uint16be decode stream) #xabff)) - +(check-equal? (send uint16be decode (+DecodeStream (bytes #xab #xff))) #xabff) (check-equal? (send uint16be size) 2) - -(let ([stream (+EncodeStream)]) - (send uint16be encode stream #xabff) - (check-equal? (send stream dump) (bytes #xab #xff))) - +(check-equal? (send uint16be encode #f #xabff) (bytes #xab #xff)) ; ; describe 'uint16le', -> @@ -94,14 +88,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; uint16le.encode(stream, 0xabff) ; stream.end() -(let ([stream (+DecodeStream (bytes #xff #xab))]) - (check-equal? (send uint16le decode stream) #xabff)) - +(check-equal? (send uint16le decode (+DecodeStream (bytes #xff #xab))) #xabff) (check-equal? (send uint16le size) 2) - -(let ([stream (+EncodeStream)]) - (send uint16le encode stream #xabff) - (check-equal? (send stream dump) (bytes #xff #xab))) +(check-equal? (send uint16le encode #f #xabff) (bytes #xff #xab)) ; ; describe 'uint24', -> @@ -131,14 +120,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; uint24be.encode(stream, 0xffab24) ; stream.end() -(let ([stream (+DecodeStream (bytes #xff #xab #x24))]) - (check-equal? (send uint24be decode stream) #xffab24)) - +(check-equal? (send uint24be decode (+DecodeStream (bytes #xff #xab #x24))) #xffab24) (check-equal? (send uint24be size) 3) - -(let ([stream (+EncodeStream)]) - (send uint24be encode stream #xffab24) - (check-equal? (send stream dump) (bytes #xff #xab #x24))) +(check-equal? (send uint24be encode #f #xffab24) (bytes #xff #xab #x24)) ; ; describe 'uint24le', -> @@ -158,14 +142,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; uint24le.encode(stream, 0xffab24) ; stream.end() -(let ([stream (+DecodeStream (bytes #x24 #xab #xff))]) - (check-equal? (send uint24le decode stream) #xffab24)) - +(check-equal? (send uint24le decode (+DecodeStream (bytes #x24 #xab #xff))) #xffab24) (check-equal? (send uint24le size) 3) - -(let ([stream (+EncodeStream)]) - (send uint24le encode stream #xffab24) - (check-equal? (send stream dump) (bytes #x24 #xab #xff))) +(check-equal? (send uint24le encode #f #xffab24) (bytes #x24 #xab #xff)) ; ; describe 'uint32', -> @@ -195,14 +174,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; uint32be.encode(stream, 0xffab24bf) ; stream.end() -(let ([stream (+DecodeStream (bytes #xff #xab #x24 #xbf))]) - (check-equal? (send uint32be decode stream) #xffab24bf)) - +(check-equal? (send uint32be decode (+DecodeStream (bytes #xff #xab #x24 #xbf))) #xffab24bf) (check-equal? (send uint32be size) 4) - -(let ([stream (+EncodeStream)]) - (send uint32be encode stream #xffab24bf) - (check-equal? (send stream dump) (bytes #xff #xab #x24 #xbf))) +(check-equal? (send uint32be encode #f #xffab24bf) (bytes #xff #xab #x24 #xbf)) ; ; describe 'uint32le', -> @@ -222,14 +196,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; uint32le.encode(stream, 0xffab24bf) ; stream.end() -(let ([stream (+DecodeStream (bytes #xbf #x24 #xab #xff))]) - (check-equal? (send uint32le decode stream) #xffab24bf)) - +(check-equal? (send uint32le decode (+DecodeStream (bytes #xbf #x24 #xab #xff))) #xffab24bf) (check-equal? (send uint32le size) 4) - -(let ([stream (+EncodeStream)]) - (send uint32le encode stream #xffab24bf) - (check-equal? (send stream dump) (bytes #xbf #x24 #xab #xff))) +(check-equal? (send uint32le encode #f #xffab24bf) (bytes #xbf #x24 #xab #xff)) ; @@ -321,14 +290,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; stream.end() -(let ([stream (+DecodeStream (bytes #xab #xff))]) - (check-equal? (send int16le decode stream) -85)) - +(check-equal? (send int16le decode (+DecodeStream (bytes #xab #xff))) -85) (check-equal? (send int16le size) 2) - -(let ([stream (+EncodeStream)]) - (send int16le encode stream -85) - (check-equal? (send stream dump) (bytes #xab #xff))) +(check-equal? (send int16le encode #f -85) (bytes #xab #xff)) ; @@ -360,14 +324,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; int24be.encode(stream, -21724) ; stream.end() -(let ([stream (+DecodeStream (bytes #xff #xab #x24))]) - (check-equal? (send int24be decode stream) -21724)) - +(check-equal? (send int24be decode (+DecodeStream (bytes #xff #xab #x24))) -21724) (check-equal? (send int24be size) 3) - -(let ([stream (+EncodeStream)]) - (send int24be encode stream -21724) - (check-equal? (send stream dump) (bytes #xff #xab #x24))) +(check-equal? (send int24be encode #f -21724) (bytes #xff #xab #x24)) ; ; describe 'int24le', -> @@ -388,14 +347,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; stream.end() ; -(let ([stream (+DecodeStream (bytes #x24 #xab #xff))]) - (check-equal? (send int24le decode stream) -21724)) - +(check-equal? (send int24le decode (+DecodeStream (bytes #x24 #xab #xff))) -21724) (check-equal? (send int24le size) 3) - -(let ([stream (+EncodeStream)]) - (send int24le encode stream -21724) - (check-equal? (send stream dump) (bytes #x24 #xab #xff))) +(check-equal? (send int24le encode #f -21724) (bytes #x24 #xab #xff)) @@ -428,14 +382,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; int32be.encode(stream, -5561153) ; stream.end() -(let ([stream (+DecodeStream (bytes #xff #xab #x24 #xbf))]) - (check-equal? (send int32be decode stream) -5561153)) - +(check-equal? (send int32be decode (+DecodeStream (bytes #xff #xab #x24 #xbf))) -5561153) (check-equal? (send int32be size) 4) - -(let ([stream (+EncodeStream)]) - (send int32be encode stream -5561153) - (check-equal? (send stream dump) (bytes #xff #xab #x24 #xbf))) +(check-equal? (send int32be encode #f -5561153) (bytes #xff #xab #x24 #xbf)) ; ; describe 'int32le', -> @@ -455,14 +404,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; int32le.encode(stream, -5561153) ; stream.end() -(let ([stream (+DecodeStream (bytes #xbf #x24 #xab #xff))]) - (check-equal? (send int32le decode stream) -5561153)) - +(check-equal? (send int32le decode (+DecodeStream (bytes #xbf #x24 #xab #xff))) -5561153) (check-equal? (send int32le size) 4) - -(let ([stream (+EncodeStream)]) - (send int32le encode stream -5561153) - (check-equal? (send stream dump) (bytes #xbf #x24 #xab #xff))) +(check-equal? (send int32le encode #f -5561153) (bytes #xbf #x24 #xab #xff)) ; ; describe 'float', -> @@ -492,15 +436,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; floatbe.encode(stream, 250.55) ; stream.end() -(let ([stream (+DecodeStream (bytes #x43 #x7a #x8c #xcd))]) - (check-equal? (send floatbe decode stream) 250.55)) - +(check-true (< (abs (- (send floatbe decode (+DecodeStream (bytes #x43 #x7a #x8c #xcd))) 250.55)) 0.01)) (check-equal? (send floatbe size) 4) - -(let ([stream (+EncodeStream)]) - (send floatbe encode stream 250.55) - (check-equal? (send stream dump) (bytes #xbf #x24 #xab #xff))) - +(check-equal? (send floatbe encode #f 250.55) (bytes #x43 #x7a #x8c #xcd)) ; ; describe 'floatle', -> @@ -519,10 +457,22 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; ; floatle.encode(stream, 250.55) ; stream.end() + + +(check-true (< (abs (- (send floatle decode (+DecodeStream (bytes #xcd #x8c #x7a #x43))) 250.55)) 0.01)) +(check-equal? (send floatle size) 4) +(check-equal? (send floatle encode #f 250.55) (bytes #xcd #x8c #x7a #x43)) + ; ; describe 'double', -> ; it 'is an alias for doublebe', -> ; double.should.equal doublebe + +;; modified test: `double` is the same endianness as the platform +(check-equal? (send double decode (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', -> @@ -540,6 +490,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; ; doublebe.encode(stream, 1234.56) ; stream.end() + +(check-equal? (send doublebe decode (+DecodeStream (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a))) 1234.56) +(check-equal? (send doublebe size) 8) +(check-equal? (send doublebe encode #f 1234.56) (bytes #x40 #x93 #x4a #x3d #x70 #xa3 #xd7 #x0a)) + ; ; describe 'doublele', -> ; it 'should decode', -> @@ -557,10 +512,21 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; ; doublele.encode(stream, 1234.56) ; stream.end() + +(check-equal? (send doublele decode (+DecodeStream (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40))) 1234.56) +(check-equal? (send doublele size) 8) +(check-equal? (send doublele encode #f 1234.56) (bytes #x0a #xd7 #xa3 #x70 #x3d #x4a #x93 #x40)) + ; ; describe 'fixed16', -> ; it 'is an alias for fixed16be', -> ; fixed16.should.equal fixed16be + +;; modified test: `fixed16` is the same endianness as the platform +(check-equal? (send fixed16 decode (bytes 0 1)) (send (if (system-big-endian?) + fixed16be + fixed16le) decode (bytes 0 1))) + ; ; describe 'fixed16be', -> ; it 'should decode', -> @@ -578,6 +544,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; ; fixed16be.encode(stream, 25.34) ; stream.end() + +(check-true (< (abs (- (send fixed16be decode (+DecodeStream (bytes #x19 #x57))) 25.34)) 0.01)) +(check-equal? (send fixed16be size) 2) +(check-equal? (send fixed16be encode #f 25.34) (bytes #x19 #x57)) + ; ; describe 'fixed16le', -> ; it 'should decode', -> @@ -595,10 +566,21 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; ; fixed16le.encode(stream, 25.34) ; stream.end() + +(check-true (< (abs (- (send fixed16le decode (+DecodeStream (bytes #x57 #x19))) 25.34)) 0.01)) +(check-equal? (send fixed16le size) 2) +(check-equal? (send fixed16le encode #f 25.34) (bytes #x57 #x19)) + ; ; describe 'fixed32', -> ; it 'is an alias for fixed32be', -> ; fixed32.should.equal fixed32be + +;; modified test: `fixed32` is the same endianness as the platform +(check-equal? (send fixed32 decode (bytes 0 1 2 3)) (send (if (system-big-endian?) + fixed32be + fixed32le) decode (bytes 0 1 2 3))) + ; ; describe 'fixed32be', -> ; it 'should decode', -> @@ -616,6 +598,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; ; fixed32be.encode(stream, 250.55) ; stream.end() + +(check-true (< (abs (- (send fixed32be decode (+DecodeStream (bytes #x00 #xfa #x8c #xcc))) 250.55)) 0.01)) +(check-equal? (send fixed32be size) 4) +(check-equal? (send fixed32be encode #f 250.55) (bytes #x00 #xfa #x8c #xcc)) + ; ; describe 'fixed32le', -> ; it 'should decode', -> @@ -632,4 +619,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee ; done() ; ; fixed32le.encode(stream, 250.55) -; stream.end() \ No newline at end of file +; stream.end() + +(check-true (< (abs (- (send fixed32le decode (+DecodeStream (bytes #xcc #x8c #xfa #x00))) 250.55)) 0.01)) +(check-equal? (send fixed32le size) 4) +(check-equal? (send fixed32le encode #f 250.55) (bytes #xcc #x8c #xfa #x00)) \ No newline at end of file diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index 26c94f17..bf4c01ad 100644 --- a/pitfall/restructure/number.rkt +++ b/pitfall/restructure/number.rkt @@ -19,7 +19,6 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (check-true (signed-type? 'int16))) (define-subclass Streamcoder (Number [type 'uint16] [endian (if (system-big-endian?) 'be 'le)]) - (getter-field [number-type (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))]) (define _signed? (signed-type? type)) @@ -49,17 +48,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define (signed->unsigned sint) (bitwise-and sint (arithmetic-shift 1 bits))) - (define/augride (decode stream . args) + (define/augment (decode stream . args) (define bstr (send stream read _size)) (define system-endian (if (system-big-endian?) 'be 'le)) (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)))) - ((if _signed? unsigned->signed identity) unsigned-int)) + (inner ((if _signed? unsigned->signed identity) unsigned-int) decode unsigned-int)) - (define/augride (encode stream val-in) - (define val ((if (integer? val-in) inexact->exact identity) val-in)) - ;; todo: better bounds checking + (define/augment (encode stream val-in) + (define val (let ([val-in (inner val-in encode val-in)]) + ((if (integer? val-in) inexact->exact identity) val-in))) (unless (<= bound-min val bound-max) (raise-argument-error 'Number: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]) @@ -67,29 +66,44 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (values (cons (bitwise-and n #xff) bs) (arithmetic-shift n -8)))) (send stream write (apply bytes ((if (eq? endian 'be) identity reverse) bs))))) + +(define-subclass Streamcoder (Float _size [endian (if (system-big-endian?) 'be 'le)]) + + (define/augment (decode stream . args) ; convert int to float + (floating-point-bytes->real (send stream read (/ _size 8)) (eq? endian 'be))) + + (define/augment (encode stream val-in) ; convert float to int + (define bs (bytes->list (real->floating-point-bytes val-in (/ _size 8) (eq? endian 'be)))) + (send stream write (apply bytes bs))) + + (define/override (size) (/ _size 8))) + +(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* Number (Fixed size [fixed-endian (if (system-big-endian?) 'be 'le)] [fracBits (floor (/ size 2))]) (super-make-object (string->symbol (format "int~a" size)) fixed-endian) - (field [_point (expt 2 fracBits)]) + (define _point (arithmetic-shift 1 fracBits)) - (define/override (decode stream . args) - (define result (/ (super decode stream args) _point 1.0)) + (define/augment (decode int) + (define result (/ int _point 1.0)) (if (integer? result) (inexact->exact result) result)) - (define/override (encode stream val) - (super encode stream (floor (* val _point))))) - + (define/augment (encode fixed) + (floor (* fixed _point)))) -(define-macro (define-subclass+provide ID (BASE-CLASS . ARGS)) - (with-pattern ([ID-CLASS (prefix-id #'BASE-CLASS ":" #'ID)]) - #'(define+provide ID (let ([ID-CLASS (class BASE-CLASS (super-new))]) - (make-object ID-CLASS . ARGS))))) - -(define-subclass+provide fixed16 (Fixed 16)) -(define-subclass+provide fixed16be (Fixed 16 'be)) -(define-subclass+provide fixed16le (Fixed 16 'le)) -(define-subclass+provide fixed32 (Fixed 32)) -(define-subclass+provide fixed32be (Fixed 32 'be)) -(define-subclass+provide fixed32le (Fixed 32 'le)) +(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 @@ -133,8 +147,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee ;; 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)]) - (define kstr (format "~a" k)) + (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 @@ -144,7 +159,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee suffix (if (system-big-endian?) "be" "le")))))] [(ID ...) (suffix-id #'(ID ...) #:context caller-stx)]) - #'(begin (define-subclass+provide ID (Number 'BASE 'ENDIAN)) ...))) + #'(begin (define-instance ID (make-object Number 'BASE 'ENDIAN)) ...))) (make-int-types) @@ -154,19 +169,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (check-equal? (send uint32 size) 4) (check-equal? (send double size) 8) - (define es (+EncodeStream)) - (send fixed16be encode es 123.45) - (check-equal? (send es dump) #"{s") - (define ds (+DecodeStream (send es dump))) - #;(check-equal? (ceiling (* (send fixed16be decode ds) 100)) 12345.0) + (define bs (send fixed16be encode #f 123.45)) + (check-equal? bs #"{s") + (check-equal? (ceiling (* (send fixed16be decode bs) 100)) 12345.0) (check-equal? (send int8 decode (bytes 127)) 127) (check-equal? (send int8 decode (bytes 255)) -1) (check-equal? (send int8 encode #f -1) (bytes 255)) - (check-equal? (send int8 encode #f 127) (bytes 127)) - - - ) - - + (check-equal? (send int8 encode #f 127) (bytes 127))) diff --git a/pitfall/sugar/class.rkt b/pitfall/sugar/class.rkt index cab6a85e..50d026a1 100644 --- a/pitfall/sugar/class.rkt +++ b/pitfall/sugar/class.rkt @@ -28,6 +28,11 @@ #'(begin (as-method ID) ...)) +(define-macro (define-instance ID (MAKER BASE-CLASS . ARGS)) + (with-pattern ([ID-CLASS (prefix-id #'BASE-CLASS ":" #'ID)]) + #'(define ID (let ([ID-CLASS (class BASE-CLASS (super-new))]) + (MAKER ID-CLASS . ARGS))))) + (define-macro (define-subclass SUPERCLASS (ID . INIT-ARGS) . BODY) #'(define-subclass* SUPERCLASS (ID . INIT-ARGS) (super-new) . BODY))