diff --git a/xenomorph/xenomorph/redo/base.rkt b/xenomorph/xenomorph/redo/base.rkt index cf13ad87..21984f1b 100644 --- a/xenomorph/xenomorph/redo/base.rkt +++ b/xenomorph/xenomorph/redo/base.rkt @@ -1,4 +1,5 @@ #lang racket/base +(require racket/generic) (provide (all-defined-out)) (define (->input-port arg) @@ -14,4 +15,9 @@ (- (bitwise-xor uint most-significant-bit-mask) most-significant-bit-mask)) (define (signed->unsigned sint bits) - (bitwise-and sint (arithmetic-shift 1 bits))) \ No newline at end of file + (bitwise-and sint (arithmetic-shift 1 bits))) + +(define-generics xenomorphic + (encode xenomorphic val [port]) + (decode xenomorphic [port]) + (size xenomorphic)) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/number.rkt b/xenomorph/xenomorph/redo/number.rkt index 8103a261..461cb166 100644 --- a/xenomorph/xenomorph/redo/number.rkt +++ b/xenomorph/xenomorph/redo/number.rkt @@ -6,27 +6,61 @@ (define system-endian (if (system-big-endian?) 'be 'le)) -(struct int (bytes signed endian) #:transparent) +(define (int-encode i val [port #f]) + (unless (int? i) + (raise-argument-error 'encode "integer instance" i)) + (define-values (bound-min bound-max) (bounds i)) + (unless (<= bound-min val bound-max) + (raise-argument-error 'encode (format "value that fits within ~a ~a-byte int (~a to ~a)" (if (int-signed i) "signed" "unsigned") (int-size i) bound-min bound-max) val)) + (unless (or (not port) (output-port? port)) + (raise-argument-error 'encode "output port or #f" port)) + (define bs (for/fold ([bs null] + [val (exact-if-possible val)] + #:result bs) + ([i (in-range (int-size i))]) + (values (cons (bitwise-and val #xff) bs) (arithmetic-shift val -8)))) + (define res (apply bytes ((if (eq? (int-endian i) 'be) values reverse) bs))) + (if port (write-bytes res port) res)) -(define (+integer [bytes 2] [signed #false] [endian system-endian]) - (unless (exact-positive-integer? bytes) - (raise-argument-error '+integer "exact positive integer" bytes)) +(define (int-decode i [port-arg (current-input-port)]) + (unless (int? i) + (raise-argument-error 'decode "integer instance" i)) + (define bstr (read-bytes (int-size i) (->input-port port-arg))) + (define bs ((if (eq? (int-endian i) system-endian) + values + reverse-bytes) bstr)) + (define uint (for/sum ([b (in-bytes bs)] + [i (in-naturals)]) + (arithmetic-shift b (* 8 i)))) + (if (int-signed i) (unsigned->signed uint (bits i)) uint)) + +(struct int (size signed endian) #:transparent + #:methods gen:xenomorphic + [(define decode int-decode) + (define encode int-encode) + (define size (λ (i) (int-size i)))]) + +(define (+integer [size 2] [signed #false] [endian system-endian]) + (unless (exact-positive-integer? size) + (raise-argument-error '+integer "exact positive integer" size)) (unless (boolean? signed) (raise-argument-error '+integer "boolean" signed)) (unless (memq endian '(le be)) (raise-argument-error '+integer "'le or 'be" endian)) - (int bytes signed endian)) + (int size signed endian)) (define (type-tag i) (string->symbol (string-append (if (int-signed i) "" "u") "int" (number->string (bits i)) - (if (> (int-bytes i) 1) (symbol->string (int-endian i)) "")))) + (if (> (int-size i) 1) (symbol->string (int-endian i)) "")))) -(define (bits i) (* (int-bytes i) 8)) +(define (bits i) (* (int-size i) 8)) (define (bounds i) + (unless (int? i) + (raise-argument-error 'bounds "integer instance" i)) ;; if a signed integer has n bits, it can contain a number ;; between - (expt 2 (sub1 n)) and (sub1 (expt 2 (sub1 n)). (let* ([signed-max (sub1 (arithmetic-shift 1 (sub1 (bits i))))] @@ -34,31 +68,6 @@ [delta (if (int-signed i) 0 signed-min)]) (values (- signed-min delta) (- signed-max delta)))) -(define (decode i [port-arg (current-input-port)]) - (define bstr (read-bytes (int-bytes i) (->input-port port-arg))) - (define bs ((if (eq? (int-endian i) system-endian) - values - reverse-bytes) bstr)) - (define uint (for/sum ([b (in-bytes bs)] - [i (in-naturals)]) - (arithmetic-shift b (* 8 i)))) - (if (int-signed i) (unsigned->signed uint (bits i)) uint)) - -(define (encode int val [port #f]) - (define-values (bound-min bound-max) (bounds int)) - (unless (<= bound-min val bound-max) - (raise-argument-error 'encode (format "value that fits within ~a ~a-byte int (~a to ~a)" (if (int-signed int) "signed" "unsigned") (int-bytes int) bound-min bound-max) val)) - (unless (or (not port) (output-port? port)) - (raise-argument-error 'encode "output port or #f" port)) - (define bs (for/fold ([bs null] - [val (exact-if-possible val)] - #:result bs) - ([i (in-range (int-bytes int))]) - (values (cons (bitwise-and val #xff) bs) (arithmetic-shift val -8)))) - (define res (apply bytes ((if (eq? (int-endian int) 'be) values reverse) bs))) - (if port (write-bytes res port) res)) - - (define uint8 (+integer 1)) (define int8 (+integer 1 #t)) (define uint16 (+integer 2)) @@ -95,15 +104,13 @@ (check-equal? (get-output-bytes op) (bytes 1 2)) (encode i 772 op) (check-equal? (get-output-bytes op) (bytes 1 2 3 4))) -#| + (check-equal? (size (+integer 1) ) 1) (check-equal? (size (+integer)) 2) (check-equal? (size (+integer 4)) 4) (check-equal? (size (+integer 8)) 8) - (check-equal? (size (+number 1)) 1) - (check-equal? (size (+number)) 2) - (check-equal? (size (+number 4)) 4) - (check-equal? (size (+number 8)) 8) -|# - ) \ No newline at end of file + (check-equal? (decode int8 (bytes 127)) 127) + (check-equal? (decode int8 (bytes 255)) -1) + (check-equal? (encode int8 -1) (bytes 255)) + (check-equal? (encode int8 127) (bytes 127))) \ No newline at end of file