mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

refac

Browse Source
main
Matthew Butterick 7 years ago
parent 5eaba0326f
commit 6db247f222
3 changed files with 57 additions and 78 deletions
Show Stats Download Patch File Download Diff File

4
pitfall/restructure/bitfield-test.rkt
Unescape Escape View File

@ -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))))]) (let ([stream (+DecodeStream (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK))))])
(for/and ([(k v) (in-hash (send bitfield decode stream))]) (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 ; bitfield.encode stream, Jack: yes, Kack: no, Lack: no, Mack: yes, Nack: yes, Oack: no, Pack: yes, Quack: yes
(let ([stream (+EncodeStream)]) (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) (send bitfield encode stream h)
(check-equal? (send stream dump) (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK))))) (check-equal? (send stream dump) (+Buffer (list (bitwise-ior JACK MACK PACK NACK QUACK)))))

21
pitfall/restructure/buffer.rkt
Unescape Escape View File

@ -1,5 +1,5 @@
#lang restructure/racket #lang restructure/racket
(require "number.rkt" (prefix-in utils- "utils.rkt")) (require "number.rkt" "utils.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
#| #|
@ -15,29 +15,28 @@ A Restructure RBuffer object is separate.
|# |#
(define (+Buffer xs [type #f]) (define (+Buffer xs [type #f])
(cond ((if (string? xs)
[(string? xs) (string->bytes/utf-8 xs)] string->bytes/utf-8
[else (list->bytes xs)])) list->bytes) xs))
(define-subclass RestructureBase (RBuffer [len #xffff])
(define-subclass RestructureBase (RBuffer [length_ #xffff])
(define/override (decode stream [parent #f]) (define/override (decode stream [parent #f])
(define length__ (utils-resolveLength length_ stream parent)) (define decoded-len (resolve-length len stream parent))
(send stream readBuffer length__)) (send stream readBuffer decoded-len))
(define/override (size [val #f] [parent #f]) (define/override (size [val #f] [parent #f])
(when val (unless (bytes? val) (when val (unless (bytes? val)
(raise-argument-error 'Buffer:size "bytes" val))) (raise-argument-error 'Buffer:size "bytes" val)))
(if val (if val
(bytes-length val) (bytes-length val)
(utils-resolveLength length_ val parent))) (resolve-length len val parent)))
(define/override (encode stream buf [parent #f]) (define/override (encode stream buf [parent #f])
(unless (bytes? buf) (unless (bytes? buf)
(raise-argument-error 'Buffer:encode "bytes" buf)) (raise-argument-error 'Buffer:encode "bytes" buf))
(when (NumberT? length_) (when (NumberT? len)
(send length_ encode stream (length buf))) (send len encode stream (length buf)))
(send stream writeBuffer buf))) (send stream writeBuffer buf)))
(define-subclass RBuffer (BufferT)) (define-subclass RBuffer (BufferT))

110
pitfall/restructure/pointer.rkt
Unescape Escape View File

@ -6,78 +6,60 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee 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)) (when (eq? type 'void) (set! type #f))
(hash-ref! options 'type 'local) (hash-ref! options 'type 'local)
(hash-ref! options 'allowNull #t) (hash-ref! options 'allowNull #t)
(hash-ref! options 'nullValue 0) (hash-ref! options 'nullValue 0)
(hash-ref! options 'lazy #f) (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/public (decode stream [ctx #f])
(define offset (send offsetType decode stream ctx)) (define offset (send offset-type decode stream ctx))
(cond (cond
;; handle NULL pointers ;; handle NULL pointers
[(and (eq? offset (ref options 'nullValue)) (ref options 'allowNull)) #f] [(and (ref options 'allowNull) (= offset (ref options 'nullValue))) #f]
[else [else
(define relative (caseq (ref options 'type) (define relative (+ (caseq (ref options 'type)
[(local) (ref ctx '_startOffset)] [(local) (ref ctx '_startOffset)]
[(immediate) (- (· stream pos) (send offsetType size))] [(immediate) (- (· stream pos) (send offset-type size))]
[(parent) (ref* ctx 'parent '_startOffset)] [(parent) (ref* ctx 'parent '_startOffset)]
[else (let loop ([ctx ctx]) [else (let loop ([ctx ctx])
(cond (cond
[(· ctx parent) => loop] [(· ctx parent) => loop]
[(ref ctx '_startOffset)] [(ref ctx '_startOffset)]
[else 0]))])) [else 0]))])
(relative-getter-or-0 ctx)))
(when (ref options 'relativeTo)
; relativeToGetter only defined if 'relativeTo key exists, so this is safe
(increment! relative (relativeToGetter ctx)))
(define ptr (+ offset relative)) (define ptr (+ offset relative))
(cond (cond
[type (define val #f) ;; omitted: lazy pointer implementation
(define (decodeValue) [type (define orig-pos (· stream pos))
(cond (send stream pos ptr)
[val] (define val (send type decode stream ctx))
[else (define pos (· stream pos)) (send stream pos orig-pos)
(send stream pos ptr) val]
(define val (send type decode stream ctx))
(send stream pos pos)
val]))
;; skip lazy pointer chores
(decodeValue)]
[else ptr])])) [else ptr])]))
(define/public (size [val #f] [ctx #f]) (define/public (size [val #f] [ctx-in #f])
(define parent ctx) (define parent ctx-in)
(caseq (ref options 'type) (define ctx (caseq (ref options 'type)
[(local immediate) (void)] [(local immediate) ctx-in]
[(parent) (set! ctx (ref ctx 'parent))] [(parent) (· ctx-in parent)]
[else ; global [(global) (let loop ([ctx ctx-in])
(set! ctx (let loop ([ctx ctx]) (cond
(cond [(· ctx parent) => loop]
[(ref ctx 'parent) => loop] [else ctx]))]
[else ctx])))]) [else (error 'unknown-pointer-type)]))
(unless type
(define type_ type)
(unless type_
(unless (VoidPointer? val) (unless (VoidPointer? val)
(raise-argument-error 'Pointer:size "VoidPointer" val)) (raise-argument-error 'Pointer:size "VoidPointer" val))
(set! type (ref val 'type)) (set! type (ref val 'type))
(set! val (ref val 'value))) (set! val (ref val 'value)))
(when (and val ctx) (when (and val ctx)
(ref-set! ctx 'pointerSize (and (ref ctx 'pointerSize) (ref-set! ctx 'pointerSize (and (· ctx pointerSize)
(+ (ref ctx 'pointerSize) (send type size val parent))))) (+ (· ctx pointerSize) (send type size val parent)))))
(send offset-type size))
(send offsetType size))
(define/public (encode stream val [ctx #f]) (define/public (encode stream val [ctx #f])
@ -85,24 +67,22 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(define relative #f) (define relative #f)
(cond (cond
[(not val) [(not val)
(send offsetType encode stream (ref options 'nullValue))] (send offset-type encode stream (ref options 'nullValue))]
[else [else
(caseq (ref options 'type) (caseq (ref options 'type)
[(local) (set! relative (ref ctx 'startOffset))] [(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)) [(parent) (set! ctx (ref ctx 'parent))
(set! relative (ref ctx 'startOffset))] (set! relative (ref ctx 'startOffset))]
[else ; global [(global) (set! relative 0)
(set! relative 0) (set! ctx (let loop ([ctx ctx])
(set! ctx (let loop ([ctx ctx]) (cond
(cond [(ref ctx 'parent) => loop]
[(ref ctx 'parent) => loop] [else ctx])))]
[else ctx])))]) [else (error 'unknown-pointer-type)])
(when (ref options 'relativeTo) (increment! relative (relative-getter-or-0 (ref parent 'val)))
(increment! relative (relativeToGetter (ref parent 'val)))) (send offset-type encode stream (- (ref ctx 'pointerOffset) relative))
(send offsetType encode stream (- (ref ctx 'pointerOffset) relative))
(define type_ type) (define type_ type)
(unless type_ (unless type_

Write Preview
Loading…
Cancel
Save