diff --git a/xenomorph/xenomorph/number.rkt b/xenomorph/xenomorph/number.rkt index dde6cdc7..6da15f54 100644 --- a/xenomorph/xenomorph/number.rkt +++ b/xenomorph/xenomorph/number.rkt @@ -36,21 +36,16 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define xint% (class* xnumber% () (super-new) - (init-field size - signed - endian) + (init-field size signed endian) - (define/augment (xxdecode port [parent #f]) - (define bstr (read-bytes size port)) - (define bs ((if (eq? endian system-endian) - values - reverse-bytes) bstr)) + (define/augment (xxdecode port . _) + (define bs ((if (eq? endian system-endian) values reverse-bytes) (read-bytes size port))) (define uint (for/sum ([b (in-bytes bs)] [i (in-naturals)]) (arithmetic-shift b (* 8 i)))) (if signed (unsigned->signed uint (bits this)) uint)) - (define/augment (xxencode val port [parent #f]) + (define/augment (xxencode val . _) (define-values (bound-min bound-max) (bounds this)) (unless (<= bound-min val bound-max) (raise-argument-error 'encode @@ -61,7 +56,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee ([i (in-range size)]) (values (cons (bitwise-and val #xff) bs) (arithmetic-shift val -8)))) - (define/augment (xxsize [val #f] [parent #f]) size))) + (define/augment (xxsize . _) size))) (define (+xint [size 2] #:signed [signed #true] #:endian [endian system-endian]) @@ -71,13 +66,6 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (raise-argument-error '+xint "'le or 'be" endian)) (make-object xint% size signed endian)) -#;(define (type-tag i) - (string->symbol - (string-append (if signed "" "u") - "int" - (number->string (bits i)) - (if (> (xint-size i) 1) (symbol->string (xint-endian i)) "")))) - (define (bits i) (* (get-field size i) 8)) (define (bounds i) @@ -157,3 +145,30 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (check-equal? (decode int8 (bytes 255)) -1) (check-equal? (encode int8 -1 #f) (bytes 255)) (check-equal? (encode int8 127 #f) (bytes 127))) + +(define xfloat% (class* xnumber% () + (super-new) + (init-field size endian) + + (define/augment (xxdecode port . _) + (floating-point-bytes->real (read-bytes size port) (eq? endian 'be))) + + (define/augment (xxencode val . _) + (real->floating-point-bytes val size (eq? endian 'be))) + + (define/augment (xxsize . _) size))) + +(define (+xfloat [size 4] #:endian [endian system-endian]) + (unless (exact-positive-integer? size) + (raise-argument-error '+xfloat "exact positive integer" size)) + (unless (memq endian '(le be)) + (raise-argument-error '+xfloat "'le or 'be" endian)) + (make-object xfloat% size endian)) + +(define float (+xfloat 4)) +(define floatbe (+xfloat 4 #:endian 'be)) +(define floatle (+xfloat 4 #:endian 'le)) + +(define double (+xfloat 8)) +(define doublebe (+xfloat 8 #:endian 'be)) +(define doublele (+xfloat 8 #:endian 'le))