From 34a2c117a8db18361704e588f1db3dd914dbeac1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 16 Dec 2018 05:22:48 -0800 Subject: [PATCH] reserved --- xenomorph/xenomorph/reserved.rkt | 43 +++++++++++----------- xenomorph/xenomorph/test/reserved-test.rkt | 16 +++++--- 2 files changed, 33 insertions(+), 26 deletions(-) diff --git a/xenomorph/xenomorph/reserved.rkt b/xenomorph/xenomorph/reserved.rkt index 09c4c93d..94261ed5 100644 --- a/xenomorph/xenomorph/reserved.rkt +++ b/xenomorph/xenomorph/reserved.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "helper.rkt" "util.rkt") +(require racket/class "helper.rkt" "util.rkt") (provide (all-defined-out)) #| @@ -7,27 +7,28 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee |# -(define/post-decode (xreserved-decode xo [port-arg (current-input-port)] #:parent [parent #f]) - (define port (->input-port port-arg)) - (pos port (+ (pos port) (size xo #f #:parent parent))) - (void)) +(define xreserved% + (class xenobase% + (super-new) + (init-field type count) -(define/pre-encode (xreserved-encode xo val [port-arg (current-output-port)] #:parent [parent #f]) - (define port (if (output-port? port-arg) port-arg (open-output-bytes))) - (write-bytes (make-bytes (size xo val #:parent parent) 0) port) - (unless port-arg (get-output-bytes port))) + (unless (xenomorphic-type? type) + (raise-argument-error '+xoptional"xenomorphic type" type)) -(define/finalize-size (xreserved-size xo [val #f] #:parent [parent #f]) - (define item-size (size (xreserved-type xo))) - (define count (resolve-length (xreserved-count xo) #f #:parent parent)) - (* item-size count)) + (define/augment (xxdecode port parent) + (pos port (+ (pos port) (xxsize #f parent))) + (void)) -(struct xreserved xbase (type count) #:transparent - #:methods gen:xenomorphic - [(define decode xreserved-decode) - (define xdecode xreserved-decode) - (define encode xreserved-encode) - (define size xreserved-size)]) + (define/augment (xxencode val port [parent #f]) + (make-bytes (xxsize val parent) 0)) + + (define/augment (xxsize [val #f] [parent #f]) + (* (send type xxsize) (resolve-length count #f #:parent parent))))) -(define (+xreserved type [count 1]) - (xreserved type count)) \ No newline at end of file +(define (+xreserved [type-arg #f] [count-arg #f] + #:type [type-kwarg #f] + #:count [count-kwarg #f] + #:subclass [class xreserved%]) + (define type (or type-arg type-kwarg)) + (define count (or count-arg count-kwarg 1)) + (new class [type type] [count count])) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/reserved-test.rkt b/xenomorph/xenomorph/test/reserved-test.rkt index 8857b812..fc15e251 100644 --- a/xenomorph/xenomorph/test/reserved-test.rkt +++ b/xenomorph/xenomorph/test/reserved-test.rkt @@ -1,8 +1,10 @@ #lang racket/base (require rackunit + racket/class "../number.rkt" "../helper.rkt" - "../reserved.rkt") + "../reserved.rkt" + "../generic.rkt") #| approximates @@ -27,8 +29,10 @@ https://github.com/mbutterick/restructure/blob/master/test/Reserved.coffee (test-case "should decode with post-decode" (parameterize ([current-input-port (open-input-bytes (bytes 0 0))]) - (define reserved (+xreserved uint16be)) - (set-post-decode! reserved (λ (val) 42)) + (define myxres% (class xreserved% + (super-new) + (define/override (post-decode val) 42))) + (define reserved (+xreserved uint16be #:subclass myxres%)) (check-equal? (decode reserved) 42) (check-equal? (pos (current-input-port)) 2))) @@ -42,7 +46,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Reserved.coffee (test-case "should encode with pre-encode" (parameterize ([current-output-port (open-output-bytes)]) - (define reserved (+xreserved uint32be)) - (set-pre-encode! reserved (λ (val) 42)) + (define myxres% (class xreserved% + (super-new) + (define/override (pre-encode val) 42))) + (define reserved (+xreserved uint32be #:subclass myxres%)) (encode reserved #f) (check-equal? (get-output-bytes (current-output-port)) (bytes 0 0 0 0)))) \ No newline at end of file