diff --git a/xenomorph/xenomorph/array.rkt b/xenomorph/xenomorph/array.rkt index f7067707..9be5809f 100644 --- a/xenomorph/xenomorph/array.rkt +++ b/xenomorph/xenomorph/array.rkt @@ -17,7 +17,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (class xenobase% (super-new) (init-field type len) - (unless (xenomorphic? type) + (unless (is-a? type xenobase%) (raise-argument-error '+xarray "xenomorphic type" type)) (unless (length-resolvable? len) (raise-argument-error '+xarray "length-resolvable?" len)))) @@ -104,7 +104,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee [length-type (if count-bytes? 'bytes length-type-arg)])) (module+ test - (require rackunit) + (require rackunit "generic.rkt") (check-equal? (decode (+xarray uint16be 3) #"ABCDEF") '(16706 17220 17734)) (check-equal? (encode (+xarray uint16be 3) '(16706 17220 17734) #f) #"ABCDEF") (check-equal? (size (+xarray uint16be) '(1 2 3)) 6) diff --git a/xenomorph/xenomorph/generic.rkt b/xenomorph/xenomorph/generic.rkt new file mode 100644 index 00000000..b5f07efa --- /dev/null +++ b/xenomorph/xenomorph/generic.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require racket/generic) +(provide (all-defined-out)) + +(define-generics xenomorphic + (encode xenomorphic val [port] #:parent [parent]) + (decode xenomorphic [port] #:parent [parent]) + (size xenomorphic [item] #:parent [parent])) \ No newline at end of file diff --git a/xenomorph/xenomorph/helper.rkt b/xenomorph/xenomorph/helper.rkt index fac76c2c..076eaeab 100644 --- a/xenomorph/xenomorph/helper.rkt +++ b/xenomorph/xenomorph/helper.rkt @@ -1,25 +1,18 @@ #lang debug racket/base -(require racket/generic - racket/private/generic-methods +(require racket/private/generic-methods racket/dict racket/port - racket/class) + racket/class + "generic.rkt") (provide (all-defined-out)) -(define (->output-port arg) - (if (output-port? arg) arg (open-output-bytes))) - -(define (->input-port arg) - (cond - [(bytes? arg) (open-input-bytes arg)] - [(input-port? arg) arg] - [else (raise-argument-error '->input-port "byte string or input port" arg)])) (define private-keys '(parent _startOffset _currentOffset _length)) + (define (dump-mutable x) (define h (make-hasheq)) (for ([(k v) (in-dict (dump x))]) - (hash-set! h k v)) + (hash-set! h k v)) h) (define (dump x) @@ -28,7 +21,7 @@ [(output-port? x) (get-output-bytes x)] [(dict? x) (for/hasheq ([(k v) (in-dict x)] #:unless (memq k private-keys)) - (values k v))] + (values k v))] [(list? x) (map dump x)] [else x])) @@ -37,56 +30,29 @@ (file-position p new-pos)) (file-position p)) -(struct xbase ([pre-encode #:auto] [post-decode #:auto]) #:transparent #:mutable - #:auto-value values) - -(define (pre-encode xb val) - ((xbase-pre-encode xb) val)) - -(define (set-pre-encode! xb func) - (set-xbase-pre-encode! xb func)) - -(define (post-decode xb val) - ((xbase-post-decode xb) val)) - -(define (set-post-decode! xb func) - (set-xbase-post-decode! xb func)) - -(define-syntax-rule (define/post-decode (ID X VAL . ARGS) . BODY) - (define (ID X VAL . ARGS) (post-decode X (let () . BODY)))) - -(define-syntax-rule (define/pre-encode (ID X VAL . ARGS) . BODY) - (define (ID X val-in . ARGS) (let ([VAL (pre-encode X val-in)]) . BODY))) - -(define-syntax-rule (define/finalize-size ID+ARGS . BODY) (define ID+ARGS (finalize-size (let () . BODY)))) - -(define-generics xenomorphic - (encode xenomorphic val [port] #:parent [parent]) - (decode xenomorphic [port] #:parent [parent]) - (size xenomorphic [item] #:parent [parent])) - -(define (finalize-size size) - (cond - [(void? size) 0] - [(and (integer? size) (not (negative? size))) size] - [else (raise-argument-error 'size "nonnegative integer" size)])) - (define xenomorphic<%> (interface* () ([(generic-property gen:xenomorphic) (generic-method-table gen:xenomorphic (define (decode xo [port-arg (current-input-port)] #:parent [parent #f]) - (send xo xxdecode (->input-port port-arg) parent)) + (define port + (cond + [(input-port? port-arg) port-arg] + [(bytes? port-arg) (open-input-bytes port-arg)] + [else (raise-argument-error 'decode "byte string or input port" port-arg)])) + (send xo xxdecode port parent)) (define (encode xo val [port-arg (current-output-port)] #:parent [parent #f]) - (define port (->output-port port-arg)) + (define port (if (output-port? port-arg) port-arg (open-output-bytes))) (send xo xxencode val port parent) (unless port-arg (get-output-bytes port))) (define (size xo [val #f] #:parent [parent #f]) (send xo xxsize val parent)))]))) +(define (xenomorphic-type? x) (is-a? x xenobase%)) + (define xenobase% (class* object% (xenomorphic<%>) (super-new) @@ -99,7 +65,10 @@ (when (bytes? encode-result) (write-bytes encode-result output-port))) (define/pubment (xxsize [val #f] [parent #f]) - (finalize-size (inner 0 xxsize val parent))) + (define size (inner 0 xxsize val parent)) + (unless (and (integer? size) (not (negative? size))) + (raise-argument-error 'size "nonnegative integer" size)) + size) (define/public (post-decode val) val) (define/public (pre-encode val) val))) \ No newline at end of file diff --git a/xenomorph/xenomorph/number.rkt b/xenomorph/xenomorph/number.rkt index f7bce783..e32b5a60 100644 --- a/xenomorph/xenomorph/number.rkt +++ b/xenomorph/xenomorph/number.rkt @@ -99,7 +99,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define uint32le (+xint 4 #:signed #f #:endian 'le)) (module+ test - (require rackunit) + (require rackunit "generic.rkt") (check-exn exn:fail:contract? (λ () (+xint 'not-a-valid-type))) (check-exn exn:fail:contract? (λ () (encode uint8 256 #f))) (check-not-exn (λ () (encode uint8 255 #f))) diff --git a/xenomorph/xenomorph/test/array-test.rkt b/xenomorph/xenomorph/test/array-test.rkt index fb31930c..94662914 100644 --- a/xenomorph/xenomorph/test/array-test.rkt +++ b/xenomorph/xenomorph/test/array-test.rkt @@ -5,6 +5,7 @@ "../array.rkt" "../number.rkt" "../pointer.rkt" + "../generic.rkt" sugar/unstable/dict) #| diff --git a/xenomorph/xenomorph/util.rkt b/xenomorph/xenomorph/util.rkt index 84104fa6..8903f70f 100644 --- a/xenomorph/xenomorph/util.rkt +++ b/xenomorph/xenomorph/util.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/dict "number.rkt" "helper.rkt") +(require racket/dict "number.rkt" "helper.rkt" "generic.rkt") (provide (all-defined-out)) (define (length-resolvable? x)