diff --git a/xenomorph/xenomorph/bitfield.rkt b/xenomorph/xenomorph/bitfield.rkt index 3314654b..8e90edeb 100644 --- a/xenomorph/xenomorph/bitfield.rkt +++ b/xenomorph/xenomorph/bitfield.rkt @@ -13,18 +13,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee (init-field type flags) (define/augment (xxdecode port parent) - - (define flag-hash (mhasheq)) + (define flag-hash (mhasheq)) (define val (send type xxdecode port)) (for ([(flag idx) (in-indexed flags)] #:when flag) - (hash-set! flag-hash flag (bitwise-bit-set? val idx))) + (hash-set! flag-hash flag (bitwise-bit-set? val idx))) flag-hash) (define/augment (xxencode flag-hash port [parent #f]) (define bit-int (for/sum ([(flag idx) (in-indexed flags)] #:when (and flag (dict-ref flag-hash flag #f))) - (arithmetic-shift 1 idx))) + (arithmetic-shift 1 idx))) (send type xxencode bit-int port)) (define/augment (xxsize [val #f] [parent #f]) diff --git a/xenomorph/xenomorph/buffer.rkt b/xenomorph/xenomorph/buffer.rkt index 1f23b277..8c35a0a3 100644 --- a/xenomorph/xenomorph/buffer.rkt +++ b/xenomorph/xenomorph/buffer.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "helper.rkt" "util.rkt" "number.rkt") +(require racket/class "helper.rkt" "util.rkt" "number.rkt") (provide (all-defined-out)) #| @@ -7,39 +7,33 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee |# -(define/post-decode (xbuffer-decode xb [port-arg (current-input-port)] #:parent [parent #f]) - (define port (->input-port port-arg)) - (parameterize ([current-input-port port]) - (define decoded-len (resolve-length (xbuffer-len xb) #:parent parent)) - (read-bytes decoded-len))) +(define xbuffer% + (class xenobase% + (super-new) + (init-field len) -(define/pre-encode (xbuffer-encode xb buf [port-arg (current-output-port)] #:parent [parent #f]) - (define port (if (output-port? port-arg) port-arg (open-output-bytes))) - (parameterize ([current-output-port port]) - (unless (bytes? buf) - (raise-argument-error 'xbuffer-encode "bytes" buf)) - (when (xint? (xbuffer-len xb)) - (encode (xbuffer-len xb) (bytes-length buf))) - (write-bytes buf) - (unless port-arg (get-output-bytes port)))) + (define/augment (xxdecode port parent) + (define decoded-len (resolve-length len #:parent parent)) + (read-bytes decoded-len)) -(define/finalize-size (xbuffer-size xb [val #f] #:parent [parent #f]) - (when val (unless (bytes? val) - (raise-argument-error 'xbuffer-size "bytes" val))) - (if (bytes? val) - (bytes-length val) - (resolve-length (xbuffer-len xb) val #:parent parent))) - -(struct xbuffer xbase (len) #:transparent - #:methods gen:xenomorphic - [(define decode xbuffer-decode) - (define xdecode xbuffer-decode) - (define encode xbuffer-encode) - (define size xbuffer-size)]) + (define/augment (xxencode buf port [parent #f]) + (unless (bytes? buf) + (raise-argument-error 'xbuffer-encode "bytes" buf)) + (when (xint? len) + (send len xxencode (bytes-length buf) port)) + (write-bytes buf port)) + + (define/augment (xxsize [val #f] [parent #f]) + (when val (unless (bytes? val) + (raise-argument-error 'xbuffer-size "bytes" val))) + (if (bytes? val) + (bytes-length val) + (resolve-length len val #:parent parent))))) (define (+xbuffer [len-arg #f] - #:length [len-kwarg #f]) + #:length [len-kwarg #f] + #:subclass [class xbuffer%]) (define len (or len-arg len-kwarg #xffff)) (unless (length-resolvable? len) (raise-argument-error '+xbuffer "resolvable length" len)) - (xbuffer len)) \ No newline at end of file + (new class [len len])) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/buffer-test.rkt b/xenomorph/xenomorph/test/buffer-test.rkt index dcf1fb02..2d6c4cd8 100644 --- a/xenomorph/xenomorph/test/buffer-test.rkt +++ b/xenomorph/xenomorph/test/buffer-test.rkt @@ -1,9 +1,11 @@ #lang racket/base (require rackunit + racket/class sugar/unstable/dict "../buffer.rkt" "../number.rkt" - "../helper.rkt") + "../helper.rkt" + "../generic.rkt") #| approximates @@ -24,8 +26,10 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee (test-case "buffer should decode with post-decode" (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))]) - (define buf (+xbuffer #:length 2)) - (set-post-decode! buf (λ (bs) (bytes 1 2))) + (define myboof% (class xbuffer% + (super-new) + (define/override (post-decode val) (bytes 1 2)))) + (define buf (+xbuffer #:length 2 #:subclass myboof%)) (check-equal? (decode buf) (bytes 1 2)) (check-equal? (decode buf) (bytes 1 2)))) @@ -33,8 +37,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee "buffer should decode with parent key length" (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))]) (define buf (+xbuffer #:length 'len)) - (check-equal? (xdecode buf #:parent (hash 'len 3)) (bytes #xab #xff #x1f)) - (check-equal? (xdecode buf #:parent (hash 'len 1)) (bytes #xb6)))) + (check-equal? (decode buf #:parent (hash 'len 3)) (bytes #xab #xff #x1f)) + (check-equal? (decode buf #:parent (hash 'len 1)) (bytes #xb6)))) (test-case "size should return size" @@ -53,8 +57,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee (test-case "encode should encode with pre-encode" - (let ([buf (+xbuffer 2)]) - (set-pre-encode! buf (λ (bs) (bytes 1 2))) + (let () + (define myboof% (class xbuffer% + (super-new) + (define/override (pre-encode val) (bytes 1 2)))) + (define buf (+xbuffer 2 #:subclass myboof%)) (check-equal? (bytes-append (encode buf (bytes #xab #xff) #f) (encode buf (bytes #x1f #xb6) #f)) (bytes 1 2 1 2))))