From e3f4d88f8f828e6d3689a244a7e77d95175b0b30 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 5 Mar 2019 12:10:48 -0800 Subject: [PATCH] add `base-class` option to constructor funcs --- xenomorph/xenomorph/array.rkt | 5 +++-- xenomorph/xenomorph/bitfield.rkt | 5 +++-- xenomorph/xenomorph/buffer.rkt | 7 ++++--- xenomorph/xenomorph/enum.rkt | 5 +++-- xenomorph/xenomorph/lazy-array.rkt | 5 +++-- xenomorph/xenomorph/number.rkt | 21 ++++++++++++--------- xenomorph/xenomorph/optional.rkt | 5 +++-- xenomorph/xenomorph/pointer.rkt | 5 +++-- xenomorph/xenomorph/reserved.rkt | 5 +++-- xenomorph/xenomorph/string.rkt | 10 ++++++---- xenomorph/xenomorph/struct.rkt | 10 ++++++---- xenomorph/xenomorph/versioned-struct.rkt | 5 +++-- 12 files changed, 52 insertions(+), 36 deletions(-) diff --git a/xenomorph/xenomorph/array.rkt b/xenomorph/xenomorph/array.rkt index d43fb39b..9bb4d23e 100644 --- a/xenomorph/xenomorph/array.rkt +++ b/xenomorph/xenomorph/array.rkt @@ -91,8 +91,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee #:length [len-kwarg #f] #:count-bytes [count-bytes? #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) - (new (generate-subclass x:array% pre-proc post-proc) [type (or type-arg type-kwarg)] + #:post-decode [post-proc #f] + #:base-class [base-class x:array%]) + (new (generate-subclass base-class pre-proc post-proc) [type (or type-arg type-kwarg)] [len (or len-arg len-kwarg)] [count-bytes? count-bytes?])) diff --git a/xenomorph/xenomorph/bitfield.rkt b/xenomorph/xenomorph/bitfield.rkt index f5e19a49..fd661589 100644 --- a/xenomorph/xenomorph/bitfield.rkt +++ b/xenomorph/xenomorph/bitfield.rkt @@ -35,10 +35,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee #:type [type-kwarg #f] #:flags [flag-kwarg #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:bitfield%]) (define type (or type-arg type-kwarg)) (define flags (or flag-arg flag-kwarg null)) - (new (generate-subclass x:bitfield% pre-proc post-proc) [type type] [flags flags])) + (new (generate-subclass base-class pre-proc post-proc) [type type] [flags flags])) (module+ test (require rackunit "number.rkt" "base.rkt") diff --git a/xenomorph/xenomorph/buffer.rkt b/xenomorph/xenomorph/buffer.rkt index 0a10bcc1..f1f105a7 100644 --- a/xenomorph/xenomorph/buffer.rkt +++ b/xenomorph/xenomorph/buffer.rkt @@ -27,12 +27,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee (define/augment (size [val #f] [parent #f]) (match val [(? bytes?) (bytes-length val)] - [(== #false) (resolve-length @len val parent)] + [#false (resolve-length @len val parent)] [_ (raise-argument-error 'x:buffer-size "bytes or #f" val)])))) (define (x:buffer [len-arg #f] #:length [len-kwarg #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:buffer%]) (define len (or len-arg len-kwarg #xffff)) - (new (generate-subclass x:buffer% pre-proc post-proc) [len len])) \ No newline at end of file + (new (generate-subclass base-class pre-proc post-proc) [len len])) \ No newline at end of file diff --git a/xenomorph/xenomorph/enum.rkt b/xenomorph/xenomorph/enum.rkt index c7dfc4ac..de92efb1 100644 --- a/xenomorph/xenomorph/enum.rkt +++ b/xenomorph/xenomorph/enum.rkt @@ -33,7 +33,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee #:type [type-kwarg #f] #:values [values-kwarg #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:enum%]) (define type (or type-arg type-kwarg)) (define values (or values-arg values-kwarg)) - (new (generate-subclass x:enum% pre-proc post-proc) [type type] [values values])) \ No newline at end of file + (new (generate-subclass base-class pre-proc post-proc) [type type] [values values])) \ No newline at end of file diff --git a/xenomorph/xenomorph/lazy-array.rkt b/xenomorph/xenomorph/lazy-array.rkt index b93c7982..f2fa3ead 100644 --- a/xenomorph/xenomorph/lazy-array.rkt +++ b/xenomorph/xenomorph/lazy-array.rkt @@ -42,10 +42,11 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee #:type [type-kwarg #f] #:length [len-kwarg #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:lazy-array%]) (define type (or type-arg type-kwarg)) (define len (or len-arg len-kwarg)) - (new (generate-subclass x:lazy-array% pre-proc post-proc) [type type] + (new (generate-subclass base-class pre-proc post-proc) [type type] [len len] [count-bytes? #false])) diff --git a/xenomorph/xenomorph/number.rkt b/xenomorph/xenomorph/number.rkt index f7dd7ac6..d47eaeaa 100644 --- a/xenomorph/xenomorph/number.rkt +++ b/xenomorph/xenomorph/number.rkt @@ -17,7 +17,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define (reverse-bytes bstr) (apply bytes (for/list ([b (in-bytes bstr (sub1 (bytes-length bstr)) -1 -1)]) - b))) + b))) (define (exact-if-possible x) (if (integer? x) (inexact->exact x) x)) @@ -57,7 +57,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (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)))) + (arithmetic-shift b (* 8 i)))) (if signed (unsigned->signed uint @bits) uint)) (define/augment (encode val . _) @@ -74,9 +74,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:size [size-kwarg 2] #:signed [signed #true] #:endian [endian system-endian] - #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) - (new (generate-subclass x:int% pre-proc post-proc) + #:pre-encode [pre-proc #f] + #:post-decode [post-proc #f] + #:base-class [base-class x:int%]) + (new (generate-subclass base-class pre-proc post-proc) [size (or size-arg size-kwarg)] [signed signed] [endian endian])) @@ -162,8 +163,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (define (x:float [size 4] #:endian [endian system-endian] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) - (new (generate-subclass x:float% pre-proc post-proc) [size size] [endian endian])) + #:post-decode [post-proc #f] + #:base-class [base-class x:float%]) + (new (generate-subclass base-class pre-proc post-proc) [size size] [endian endian])) (define float (x:float 4)) (define floatbe (x:float 4 #:endian 'be)) @@ -193,8 +195,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee #:endian [endian system-endian] #:fracbits [fracbits (/ (* size 8) 2)] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) - (new (generate-subclass x:fixed% pre-proc post-proc) [size size] [signed signed] [endian endian] [fracbits fracbits])) + #:post-decode [post-proc #f] + #:base-class [base-class x:fixed%]) + (new (generate-subclass base-class pre-proc post-proc) [size size] [signed signed] [endian endian] [fracbits fracbits])) (define fixed16 (x:fixed 2)) (define fixed16be (x:fixed 2 #:endian 'be)) diff --git a/xenomorph/xenomorph/optional.rkt b/xenomorph/xenomorph/optional.rkt index f196818a..9ac33365 100644 --- a/xenomorph/xenomorph/optional.rkt +++ b/xenomorph/xenomorph/optional.rkt @@ -36,10 +36,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee #:type [type-kwarg #f] #:condition [cond-kwarg no-val] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:optional%]) (define type (or type-arg type-kwarg)) (define condition (cond [(and (eq? cond-arg no-val) (eq? cond-kwarg no-val)) #true] [(not (eq? cond-arg no-val)) cond-arg] [(not (eq? cond-kwarg no-val)) cond-kwarg])) - (new (generate-subclass x:optional% pre-proc post-proc) [type type] [condition condition])) + (new (generate-subclass base-class pre-proc post-proc) [type type] [condition condition])) diff --git a/xenomorph/xenomorph/pointer.rkt b/xenomorph/xenomorph/pointer.rkt index 6f94f305..2c22b706 100644 --- a/xenomorph/xenomorph/pointer.rkt +++ b/xenomorph/xenomorph/pointer.rkt @@ -98,12 +98,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee #:allow-null [allow-null? #t] #:null [null-value 0] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:pointer%]) (define valid-pointer-relatives '(local immediate parent global)) (unless (memq pointer-relative-to valid-pointer-relatives) (raise-argument-error '+xpointer (format "~v" valid-pointer-relatives) pointer-relative-to)) (define type-in (or type-arg type-kwarg uint8)) - (new (generate-subclass x:pointer% pre-proc post-proc) + (new (generate-subclass base-class pre-proc post-proc) [offset-type (or offset-arg offset-kwarg uint8)] [type (case type-in [(void) #f][else type-in])] [pointer-relative-to pointer-relative-to] diff --git a/xenomorph/xenomorph/reserved.rkt b/xenomorph/xenomorph/reserved.rkt index 8ad4dbf8..8e45ef8f 100644 --- a/xenomorph/xenomorph/reserved.rkt +++ b/xenomorph/xenomorph/reserved.rkt @@ -29,7 +29,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee #:type [type-kwarg #f] #:count [count-kwarg #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:reserved%]) (define type (or type-arg type-kwarg)) (define count (or count-arg count-kwarg 1)) - (new (generate-subclass x:reserved% pre-proc post-proc) [type type] [count count])) \ No newline at end of file + (new (generate-subclass base-class pre-proc post-proc) [type type] [count count])) \ No newline at end of file diff --git a/xenomorph/xenomorph/string.rkt b/xenomorph/xenomorph/string.rkt index 8c892e6d..23f68d5e 100644 --- a/xenomorph/xenomorph/string.rkt +++ b/xenomorph/xenomorph/string.rkt @@ -84,10 +84,11 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee #:length [len-kwarg #f] #:encoding [enc-kwarg #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:string%]) (define len (or len-arg len-kwarg)) (define encoding (or enc-arg enc-kwarg 'ascii)) - (new (generate-subclass x:string% pre-proc post-proc) [len len] [encoding encoding])) + (new (generate-subclass base-class pre-proc post-proc) [len len] [encoding encoding])) (define x:symbol% (class x:string% @@ -105,10 +106,11 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee #:length [len-kwarg #f] #:encoding [enc-kwarg #f] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) + #:post-decode [post-proc #f] + #:base-class [base-class x:symbol%]) (define len (or len-arg len-kwarg)) (define encoding (or enc-arg enc-kwarg 'utf8)) - (new (generate-subclass x:symbol% pre-proc post-proc) [len len] [encoding encoding])) + (new (generate-subclass base-class pre-proc post-proc) [len len] [encoding encoding])) (module+ test (require rackunit "base.rkt") diff --git a/xenomorph/xenomorph/struct.rkt b/xenomorph/xenomorph/struct.rkt index 59a3f66e..1a695d0f 100644 --- a/xenomorph/xenomorph/struct.rkt +++ b/xenomorph/xenomorph/struct.rkt @@ -91,17 +91,19 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (define (x:struct? x) (is-a? x x:struct%)) (define (x:struct #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f] . dicts) + #:post-decode [post-proc #f] + #:base-class [base-class x:struct%] + . dicts) (define args (flatten dicts)) (unless (even? (length args)) - (raise-argument-error '+xstruct "equal number of keys and values" dicts)) + (raise-argument-error 'x:struct "equal number of keys and values" dicts)) (define fields (for/list ([kv (in-slice 2 args)]) (unless (symbol? (car kv)) (raise-argument-error '+xstruct "symbol" (car kv))) (apply cons kv))) - (new (generate-subclass x:struct% pre-proc post-proc) [fields fields])) + (new (generate-subclass base-class pre-proc post-proc) [fields fields])) -#;(module+ test +(module+ test (require rackunit "number.rkt" "base.rkt") (define (random-pick xs) (list-ref xs (random (length xs)))) (check-exn exn:fail:contract? (λ () (x:struct 42))) diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index b74e7d73..01cda14e 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -103,6 +103,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define (x:versioned-struct type [versions (dictify)] #:pre-encode [pre-proc #f] - #:post-decode [post-proc #f]) - (new (generate-subclass x:versioned-struct% pre-proc post-proc) [type type] [versions versions][fields #f])) + #:post-decode [post-proc #f] + #:base-class [base-class x:versioned-struct%]) + (new (generate-subclass base-class pre-proc post-proc) [type type] [versions versions][fields #f]))