From c1ca6d6560385e569a93a6e0feb49a1159a4e92f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 18 Dec 2018 21:52:24 -0800 Subject: [PATCH] match it --- xenomorph/xenomorph/buffer.rkt | 18 +++---- xenomorph/xenomorph/enum.rkt | 13 +++-- xenomorph/xenomorph/optional.rkt | 10 ++-- xenomorph/xenomorph/pointer.rkt | 4 +- xenomorph/xenomorph/string.rkt | 16 +++--- xenomorph/xenomorph/struct.rkt | 10 ++-- xenomorph/xenomorph/util.rkt | 16 +++--- xenomorph/xenomorph/versioned-struct.rkt | 62 +++++++++++------------- 8 files changed, 72 insertions(+), 77 deletions(-) diff --git a/xenomorph/xenomorph/buffer.rkt b/xenomorph/xenomorph/buffer.rkt index f6c29ea0..c4a3c1a6 100644 --- a/xenomorph/xenomorph/buffer.rkt +++ b/xenomorph/xenomorph/buffer.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class "helper.rkt" "util.rkt" "number.rkt") +(require racket/class racket/match "helper.rkt" "util.rkt" "number.rkt") (provide (all-defined-out)) #| @@ -12,25 +12,23 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee (super-new) (init-field [(@len len)]) (unless (length-resolvable? @len) - (raise-argument-error '+xbuffer "resolvable length" @len)) + (raise-argument-error 'x:buffer "resolvable length" @len)) (define/augment (x:decode port parent) - (define len (resolve-length @len port parent)) - (read-bytes len)) + (read-bytes (resolve-length @len port parent))) (define/augment (x:encode buf port [parent #f]) (unless (bytes? buf) - (raise-argument-error 'xbuffer-encode "bytes" buf)) + (raise-argument-error 'x:buffer-encode "bytes" buf)) (when (x:int? @len) (send @len x:encode (bytes-length buf) port)) (write-bytes buf port)) (define/augment (x:size [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))))) + (match val + [(? bytes?) (bytes-length val)] + [(== #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] diff --git a/xenomorph/xenomorph/enum.rkt b/xenomorph/xenomorph/enum.rkt index 909e8dfb..dc686a5b 100644 --- a/xenomorph/xenomorph/enum.rkt +++ b/xenomorph/xenomorph/enum.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class "helper.rkt" racket/list) +(require racket/class racket/match "helper.rkt" racket/list) (provide (all-defined-out)) #| @@ -13,19 +13,18 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee (init-field [(@type type)] [(@values values)]) (unless (xenomorphic-type? @type) - (raise-argument-error '+xenum "xenomorphic type" @type)) + (raise-argument-error 'x:enum "xenomorphic type" @type)) (unless (list? @values) - (raise-argument-error '+xenum "list of values" @values)) + (raise-argument-error 'x:enum "list of values" @values)) (define/augment (x:decode port parent) (define index (send @type x:decode port parent)) (or (list-ref @values index) index)) (define/augment (x:encode val port [parent #f]) - (define index (index-of @values val)) - (unless index - (raise-argument-error 'xenum-encode "valid option" val)) - (send @type x:encode index port parent)) + (match (index-of @values val) + [(? values idx) (send @type x:encode idx port parent)] + [_ (raise-argument-error 'x:enum-encode "valid option" val)])) (define/augment (x:size [val #f] [parent #f]) (send @type x:size val parent)))) diff --git a/xenomorph/xenomorph/optional.rkt b/xenomorph/xenomorph/optional.rkt index 78ef7bbf..5bb764df 100644 --- a/xenomorph/xenomorph/optional.rkt +++ b/xenomorph/xenomorph/optional.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "helper.rkt" racket/class) +(require "helper.rkt" racket/class racket/match) (provide (all-defined-out)) #| @@ -13,11 +13,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee (init-field [(@type type)] [(@condition condition)]) (unless (xenomorphic-type? @type) - (raise-argument-error '+xoptional"xenomorphic type" @type)) + (raise-argument-error 'x:optional"xenomorphic type" @type)) (define (resolve-condition parent) - (define maybe-proc @condition) - (if (procedure? maybe-proc) (maybe-proc parent) maybe-proc)) + (match @condition + [(? procedure? proc) (proc parent)] + [val val])) (define/augment (x:decode port parent) (when (resolve-condition parent) @@ -30,7 +31,6 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee (define/augment (x:size [val #f] [parent #f]) (if (resolve-condition parent) (send @type x:size val parent) 0)))) - (define no-val (gensym)) (define (x:optional [type-arg #f] [cond-arg no-val] #:type [type-kwarg #f] diff --git a/xenomorph/xenomorph/pointer.rkt b/xenomorph/xenomorph/pointer.rkt index b1d13d49..bccac770 100644 --- a/xenomorph/xenomorph/pointer.rkt +++ b/xenomorph/xenomorph/pointer.rkt @@ -21,7 +21,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee (cond [type (values type val)] [(xvoid-pointer? val) (values (xvoid-pointer-type val) (xvoid-pointer-value val))] - [else (raise-argument-error 'Pointer:size "VoidPointer" val)])) + [else (raise-argument-error 'x:pointer "VoidPointer" val)])) (define x:pointer% (class xenobase% @@ -36,7 +36,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee (define/augment (x:decode port parent) (define offset (send @offset-type x:decode port parent)) (cond - [(and @allow-null? (= offset @null-value)) #f] ; handle null pointers + [(and @allow-null? (= offset @null-value)) #false] ; handle null pointers [else (define relative (+ (case @pointer-relative-to [(local) (hash-ref parent x:start-offset-key)] diff --git a/xenomorph/xenomorph/string.rkt b/xenomorph/xenomorph/string.rkt index ed44f799..da45b688 100644 --- a/xenomorph/xenomorph/string.rkt +++ b/xenomorph/xenomorph/string.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class racket/dict "helper.rkt" "util.rkt" "number.rkt") +(require racket/class racket/match "helper.rkt" "util.rkt" "number.rkt") (provide (all-defined-out)) #| @@ -40,9 +40,9 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee (define/augment (x:decode port parent) (define len (or (resolve-length @len port parent) (count-nonzero-chars port))) - (define encoding (if (procedure? @encoding) - (or (@encoding parent) 'ascii) - @encoding)) + (define encoding (match @encoding + [(? procedure? proc) (or (proc parent) 'ascii)] + [enc enc])) (define adjustment (if (and (not @len) (bytes-left-in-port? port)) 1 0)) (begin0 (decode-string len port encoding) @@ -50,16 +50,16 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee (define/augment (x:encode val-arg port [parent #f]) (define val (if (string? val-arg) val-arg (format "~a" val-arg))) - (define encoding (if (procedure? @encoding) - (or (@encoding (and parent (hash-ref parent val)) 'ascii)) - @encoding)) + (define encoding (match @encoding + [(? procedure?) (@encoding (and parent (hash-ref parent val)) 'ascii)] + [enc enc])) (define encoded-str (encode-string val encoding)) (define encoded-length (bytes-length encoded-str)) (when (and (exact-nonnegative-integer? @len) (> encoded-length @len)) (raise-argument-error 'xstring-encode (format "string no longer than ~a" @len) val)) (when (x:int? @len) (send @len x:encode encoded-length port parent)) - (define string-terminator (if (not @len) (bytes 0) (bytes))) ; null terminated when no len + (define string-terminator (if @len (bytes) (bytes 0))) ; null terminated when no len (bytes-append encoded-str string-terminator)) (define/augment (x:size [val-arg #f] [parent #f]) diff --git a/xenomorph/xenomorph/struct.rkt b/xenomorph/xenomorph/struct.rkt index 9e99405a..304faf52 100644 --- a/xenomorph/xenomorph/struct.rkt +++ b/xenomorph/xenomorph/struct.rkt @@ -2,6 +2,7 @@ (require racket/dict racket/class racket/sequence + racket/match racket/list "helper.rkt" "number.rkt" @@ -27,9 +28,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (unless (assocs? fields) (raise-argument-error 'x:struct-parse-fields "assocs" fields)) (for ([(key type) (in-dict fields)]) - (define val (if (procedure? type) - (type mheq) - (send type x:decode port mheq))) + (define val (match type + [(? procedure? proc) (proc mheq)] + [_ (send type x:decode port mheq)])) (unless (void? val) (hash-set! mheq key val)) (hash-set! mheq x:current-offset-key (- (pos port) (hash-ref mheq x:start-offset-key)))) @@ -74,7 +75,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (for ([(key type) (in-dict @fields)]) (send type x:encode (dict-ref field-data key) port parent)) (for ([ptr (in-list (hash-ref parent x:pointers-key))]) - (send (x:ptr-type ptr) x:encode (x:ptr-val ptr) port (x:ptr-parent ptr)))) + (match ptr + [(x:ptr type val parent) (send type x:encode val port parent)]))) (define/augride (x:size [val #f] [parent-arg #f] [include-pointers #t]) (define parent (mhasheq x:parent-key parent-arg diff --git a/xenomorph/xenomorph/util.rkt b/xenomorph/xenomorph/util.rkt index e4e2ef72..00647012 100644 --- a/xenomorph/xenomorph/util.rkt +++ b/xenomorph/xenomorph/util.rkt @@ -1,15 +1,15 @@ #lang racket/base -(require racket/dict "number.rkt" "helper.rkt" "generic.rkt") +(require racket/match racket/dict "number.rkt" "helper.rkt" "generic.rkt") (provide (all-defined-out)) (define (length-resolvable? x) (or (not x) (symbol? x) (xenomorphic? x) (procedure? x) (exact-nonnegative-integer? x))) (define (resolve-length x port [parent #f]) - (cond - [(not x) #f] - [(exact-nonnegative-integer? x) x] - [(procedure? x) (x parent)] - [(and parent (symbol? x)) (dict-ref parent x)] - [(and port (x:int? x)) (decode x port)] - [else (raise-argument-error 'resolve-length "fixed-size argument" x)])) \ No newline at end of file + (match x + [#false #false] + [(? exact-nonnegative-integer?) x] + [(? procedure? proc) (proc parent)] + [(? symbol? key) #:when parent (dict-ref parent key)] + [(? x:int?) #:when port (decode x port)] + [_ (raise-argument-error 'resolve-length "fixed-size argument" x)])) \ No newline at end of file diff --git a/xenomorph/xenomorph/versioned-struct.rkt b/xenomorph/xenomorph/versioned-struct.rkt index 68c238f3..920245d4 100644 --- a/xenomorph/xenomorph/versioned-struct.rkt +++ b/xenomorph/xenomorph/versioned-struct.rkt @@ -1,6 +1,7 @@ #lang racket/base (require "helper.rkt" "struct.rkt" racket/dict + racket/match racket/class sugar/unstable/dict) (provide (all-defined-out)) @@ -21,14 +22,6 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (unless (and (dict? @versions) (andmap (λ (v) (or (dict? v) (x:struct? v))) (dict-values @versions))) (raise-argument-error 'x:versioned-struct "dict of dicts or structish" @versions)) - (define version-getter (cond - [(procedure? @type) @type] - [(symbol? @type) (λ (parent) (dict-ref parent @type))])) - - (define version-setter (cond - [(procedure? @type) @type] - [(symbol? @type) (λ (parent version) (dict-set! parent @type version))])) - (define (select-field-set val) (define version-key (or (dict-ref val x:version-key #f) @@ -40,26 +33,28 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define/override (x:decode port parent [length 0]) (define res (setup-private-fields port parent length)) - (define which-version (cond - [(integer? @type) @type] - [(or (symbol? @type) (procedure? @type)) - (unless parent - (raise-argument-error 'x:versioned-struct-decode "valid parent" parent)) - (version-getter parent)] - [else (send @type x:decode port parent)])) + (define which-version (match @type + [(? integer? int) int] + [(? symbol? key) #:when parent (dict-ref parent key)] + [(? procedure? proc) #:when parent (proc parent)] + [(or (? symbol?) (? procedure?)) + (raise-argument-error 'x:versioned-struct-decode "valid parent" parent)] + [_ (send @type x:decode port parent)])) (dict-set! res x:version-key which-version) - (define maybe-header-val (dict-ref @versions 'header #f)) - (when maybe-header-val - (parse-fields port res maybe-header-val)) + (cond + [(dict-ref @versions 'header #f) + => (λ (header-val) (parse-fields port res header-val))]) (define field-object - (or (dict-ref @versions which-version #f) - (raise-argument-error 'x:versioned-struct-decode (format "valid field version: ~v" (dict-keys @versions)) which-version))) - - (if (x:versioned-struct? field-object) - (send field-object x:decode port parent) - (parse-fields port res field-object))) + (cond + [(dict-ref @versions which-version #f) => values] + [else + (raise-argument-error 'x:versioned-struct-decode (format "valid field version: ~v" (dict-keys @versions)) which-version)])) + + (match field-object + [(? x:versioned-struct?) (send field-object x:decode port parent)] + [_ (parse-fields port res field-object)])) (define/override (x:encode field-data port [parent-arg #f]) (unless (dict? field-data) @@ -76,12 +71,13 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (send type x:encode (dict-ref field-data key) port parent)) (define fields (select-field-set field-data)) - (unless (andmap (λ (key) (member key (dict-keys field-data))) (dict-keys fields)) + (unless (andmap (λ (key) (member key (hash-keys field-data))) (dict-keys fields)) (raise-argument-error 'x:versioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys field-data))) (for ([(key type) (in-dict fields)]) - (send type x:encode (dict-ref field-data key) port parent)) - (for ([ptr (in-list (dict-ref parent x:pointers-key))]) - (send (x:ptr-type ptr) x:encode (x:ptr-val ptr) port (x:ptr-parent ptr)))) + (send type x:encode (hash-ref field-data key) port parent)) + (for ([ptr (in-list (hash-ref parent x:pointers-key))]) + (match ptr + [(x:ptr type val parent) (send type x:encode val port parent)]))) (define/override (x:size [val #f] [parent-arg #f] [include-pointers #t]) (unless val @@ -90,12 +86,12 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee x:val-key val x:pointer-size-key 0)) (define version-size - (let ([struct-type @type]) - (if (or (symbol? struct-type) (procedure? struct-type)) - 0 - (send @type x:size (dict-ref val x:version-key) parent)))) + (match @type + [(or (? symbol?) (? procedure?)) 0] + [_ (send @type x:size (dict-ref val x:version-key) parent)])) + (define header-size - (for/sum ([(key type) (in-dict (or (dict-ref @versions 'header #f) null))]) + (for/sum ([(key type) (in-dict (dict-ref @versions 'header null))]) (send type x:size (and val (dict-ref val key)) parent))) (define fields-size (for/sum ([(key type) (in-dict (select-field-set val))])