From 6db247f2221877bdcfc5b2010820423b72787126 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 2 Jul 2017 12:33:35 -0700 Subject: [PATCH] refac --- pitfall/restructure/bitfield-test.rkt | 4 +- pitfall/restructure/buffer.rkt | 21 +++-- pitfall/restructure/pointer.rkt | 110 +++++++++++--------------- 3 files changed, 57 insertions(+), 78 deletions(-) diff --git a/pitfall/restructure/bitfield-test.rkt b/pitfall/restructure/bitfield-test.rkt index f1091570..a10dc04b 100644 --- a/pitfall/restructure/bitfield-test.rkt +++ b/pitfall/restructure/bitfield-test.rkt @@ -35,7 +35,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee (let ([stream (+DecodeStream (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK))))]) (for/and ([(k v) (in-hash (send bitfield decode stream))]) - (check-equal? v (hash-ref #hash((Quack . #t) (Nack . #t) (Lack . #f) (Oack . #f) (Pack . #t) (Mack . #t) (Jack . #t) (Kack . #f)) k)))) + (check-equal? v (hash-ref #hasheq((Quack . #t) (Nack . #t) (Lack . #f) (Oack . #f) (Pack . #t) (Mack . #t) (Jack . #t) (Kack . #f)) k)))) ; @@ -48,6 +48,6 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee ; bitfield.encode stream, Jack: yes, Kack: no, Lack: no, Mack: yes, Nack: yes, Oack: no, Pack: yes, Quack: yes (let ([stream (+EncodeStream)]) - (define h #hash((Quack . #t) (Nack . #t) (Lack . #f) (Oack . #f) (Pack . #t) (Mack . #t) (Jack . #t) (Kack . #f))) + (define h #hasheq((Quack . #t) (Nack . #t) (Lack . #f) (Oack . #f) (Pack . #t) (Mack . #t) (Jack . #t) (Kack . #f))) (send bitfield encode stream h) (check-equal? (send stream dump) (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK))))) diff --git a/pitfall/restructure/buffer.rkt b/pitfall/restructure/buffer.rkt index 08fea45b..e79093ad 100644 --- a/pitfall/restructure/buffer.rkt +++ b/pitfall/restructure/buffer.rkt @@ -1,5 +1,5 @@ #lang restructure/racket -(require "number.rkt" (prefix-in utils- "utils.rkt")) +(require "number.rkt" "utils.rkt") (provide (all-defined-out)) #| @@ -15,29 +15,28 @@ A Restructure RBuffer object is separate. |# (define (+Buffer xs [type #f]) - (cond - [(string? xs) (string->bytes/utf-8 xs)] - [else (list->bytes xs)])) + ((if (string? xs) + string->bytes/utf-8 + list->bytes) xs)) - -(define-subclass RestructureBase (RBuffer [length_ #xffff]) +(define-subclass RestructureBase (RBuffer [len #xffff]) (define/override (decode stream [parent #f]) - (define length__ (utils-resolveLength length_ stream parent)) - (send stream readBuffer length__)) + (define decoded-len (resolve-length len stream parent)) + (send stream readBuffer decoded-len)) (define/override (size [val #f] [parent #f]) (when val (unless (bytes? val) (raise-argument-error 'Buffer:size "bytes" val))) (if val (bytes-length val) - (utils-resolveLength length_ val parent))) + (resolve-length len val parent))) (define/override (encode stream buf [parent #f]) (unless (bytes? buf) (raise-argument-error 'Buffer:encode "bytes" buf)) - (when (NumberT? length_) - (send length_ encode stream (length buf))) + (when (NumberT? len) + (send len encode stream (length buf))) (send stream writeBuffer buf))) (define-subclass RBuffer (BufferT)) diff --git a/pitfall/restructure/pointer.rkt b/pitfall/restructure/pointer.rkt index 916da928..0a55ee89 100644 --- a/pitfall/restructure/pointer.rkt +++ b/pitfall/restructure/pointer.rkt @@ -6,78 +6,60 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee |# -(define-subclass object% (Pointer offsetType type [options (mhash)]) +(define-subclass object% (Pointer offset-type type [options (mhash)]) (when (eq? type 'void) (set! type #f)) (hash-ref! options 'type 'local) (hash-ref! options 'allowNull #t) (hash-ref! options 'nullValue 0) (hash-ref! options 'lazy #f) - (define relativeToGetter (ref options 'relativeTo)) ; change this to a simple lambda + (define relative-getter-or-0 (or (ref options 'relativeTo) (λ (ctx) 0))) ; changed this to a simple lambda (define/public (decode stream [ctx #f]) - (define offset (send offsetType decode stream ctx)) - + (define offset (send offset-type decode stream ctx)) (cond ;; handle NULL pointers - [(and (eq? offset (ref options 'nullValue)) (ref options 'allowNull)) #f] + [(and (ref options 'allowNull) (= offset (ref options 'nullValue))) #f] [else - (define relative (caseq (ref options 'type) - [(local) (ref ctx '_startOffset)] - [(immediate) (- (· stream pos) (send offsetType size))] - [(parent) (ref* ctx 'parent '_startOffset)] - [else (let loop ([ctx ctx]) - (cond - [(· ctx parent) => loop] - [(ref ctx '_startOffset)] - [else 0]))])) - - (when (ref options 'relativeTo) - ; relativeToGetter only defined if 'relativeTo key exists, so this is safe - (increment! relative (relativeToGetter ctx))) - + (define relative (+ (caseq (ref options 'type) + [(local) (ref ctx '_startOffset)] + [(immediate) (- (· stream pos) (send offset-type size))] + [(parent) (ref* ctx 'parent '_startOffset)] + [else (let loop ([ctx ctx]) + (cond + [(· ctx parent) => loop] + [(ref ctx '_startOffset)] + [else 0]))]) + (relative-getter-or-0 ctx))) (define ptr (+ offset relative)) - (cond - [type (define val #f) - (define (decodeValue) - (cond - [val] - [else (define pos (· stream pos)) - (send stream pos ptr) - (define val (send type decode stream ctx)) - (send stream pos pos) - val])) - - ;; skip lazy pointer chores - - (decodeValue)] + ;; omitted: lazy pointer implementation + [type (define orig-pos (· stream pos)) + (send stream pos ptr) + (define val (send type decode stream ctx)) + (send stream pos orig-pos) + val] [else ptr])])) - (define/public (size [val #f] [ctx #f]) - (define parent ctx) - (caseq (ref options 'type) - [(local immediate) (void)] - [(parent) (set! ctx (ref ctx 'parent))] - [else ; global - (set! ctx (let loop ([ctx ctx]) - (cond - [(ref ctx 'parent) => loop] - [else ctx])))]) - - (define type_ type) - (unless type_ + (define/public (size [val #f] [ctx-in #f]) + (define parent ctx-in) + (define ctx (caseq (ref options 'type) + [(local immediate) ctx-in] + [(parent) (· ctx-in parent)] + [(global) (let loop ([ctx ctx-in]) + (cond + [(· ctx parent) => loop] + [else ctx]))] + [else (error 'unknown-pointer-type)])) + (unless type (unless (VoidPointer? val) (raise-argument-error 'Pointer:size "VoidPointer" val)) - (set! type (ref val 'type)) (set! val (ref val 'value))) - (when (and val ctx) - (ref-set! ctx 'pointerSize (and (ref ctx 'pointerSize) - (+ (ref ctx 'pointerSize) (send type size val parent))))) - - (send offsetType size)) + (ref-set! ctx 'pointerSize (and (· ctx pointerSize) + (+ (· ctx pointerSize) (send type size val parent))))) + (send offset-type size)) (define/public (encode stream val [ctx #f]) @@ -85,24 +67,22 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee (define relative #f) (cond [(not val) - (send offsetType encode stream (ref options 'nullValue))] + (send offset-type encode stream (ref options 'nullValue))] [else (caseq (ref options 'type) [(local) (set! relative (ref ctx 'startOffset))] - [(immediate) (set! relative (+ (· stream pos) (send offsetType size val parent)))] + [(immediate) (set! relative (+ (· stream pos) (send offset-type size val parent)))] [(parent) (set! ctx (ref ctx 'parent)) (set! relative (ref ctx 'startOffset))] - [else ; global - (set! relative 0) - (set! ctx (let loop ([ctx ctx]) - (cond - [(ref ctx 'parent) => loop] - [else ctx])))]) - - (when (ref options 'relativeTo) - (increment! relative (relativeToGetter (ref parent 'val)))) - - (send offsetType encode stream (- (ref ctx 'pointerOffset) relative)) + [(global) (set! relative 0) + (set! ctx (let loop ([ctx ctx]) + (cond + [(ref ctx 'parent) => loop] + [else ctx])))] + [else (error 'unknown-pointer-type)]) + + (increment! relative (relative-getter-or-0 (ref parent 'val))) + (send offset-type encode stream (- (ref ctx 'pointerOffset) relative)) (define type_ type) (unless type_