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

change #:style to #:relative-to

Browse Source
main
Matthew Butterick 6 years ago
parent 50a553c18f
commit 12c4e5dad8
2 changed files with 21 additions and 48 deletions
Show Stats Download Patch File Download Diff File

29
xenomorph/xenomorph/pointer.rkt
Unescape Escape View File

@ -23,13 +23,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(cond
[(and allow-null (= offset (null-value xp))) #f] ; handle null pointers
[else
(define relative (+ (case (pointer-style xp)
(define relative (+ (case (pointer-relative-to xp)
[(local) (dict-ref parent '_startOffset)]
[(immediate) (- (pos port) (size (xpointer-offset-type xp)))]
[(parent) (dict-ref (dict-ref parent 'parent) '_startOffset)]
[(global) (or (dict-ref (find-top-parent parent) '_startOffset) 0)]
[else (error 'unknown-pointer-style)])
((relative-getter-or-0 xp) parent)))
[else (error 'unknown-pointer-style)])))
(define ptr (+ offset relative))
(cond
[(xpointer-type xp)
@ -61,16 +60,15 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(parameterize ([current-output-port port])
(if (not val)
(encode (xpointer-offset-type xp) (null-value xp) port)
(let* ([new-parent (case (pointer-style xp)
(let* ([new-parent (case (pointer-relative-to xp)
[(local immediate) parent]
[(parent) (dict-ref parent 'parent)]
[(global) (find-top-parent parent)]
[else (error 'unknown-pointer-style)])]
[relative (+ (case (pointer-style xp)
[relative (+ (case (pointer-relative-to xp)
[(local parent) (dict-ref new-parent 'startOffset)]
[(immediate) (+ (pos port) (size (xpointer-offset-type xp) val #:parent parent))]
[(global) 0])
((relative-getter-or-0 xp) (dict-ref parent 'val #f)))])
[(global) 0]))])
(encode (xpointer-offset-type xp) (- (dict-ref new-parent 'pointerOffset) relative))
(let-values ([(type val) (resolve-void-pointer (xpointer-type xp) val)])
(dict-set! new-parent 'pointers (append (dict-ref new-parent 'pointers)
@ -81,7 +79,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(unless port-arg (get-output-bytes port)))
(define (xpointer-size xp [val #f] #:parent [parent #f])
(let*-values ([(parent) (case (pointer-style xp)
(let*-values ([(parent) (case (pointer-relative-to xp)
[(local immediate) parent]
[(parent) (dict-ref parent 'parent)]
[(global) (find-top-parent parent)]
@ -101,16 +99,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(define (+xpointer [offset-arg #f] [type-arg #f]
#:offset-type [offset-kwarg #f]
#:type [type-kwarg #f]
#:style [style 'local]
#:relative-to [relative-to #f]
#:relative-to [relative-to 'local]
#:lazy [lazy? #f]
#:allow-null [allow-null? #t]
#:null [null-value 0])
(define valid-pointer-styles '(local immediate parent global))
(unless (memq style valid-pointer-styles)
(raise-argument-error '+xpointer (format "~v" valid-pointer-styles) style))
(define options (mhasheq 'style style
'relativeTo relative-to
(define valid-pointer-relatives '(local immediate parent global))
(unless (memq relative-to valid-pointer-relatives)
(raise-argument-error '+xpointer (format "~v" valid-pointer-relatives) relative-to))
(define options (mhasheq 'relative-to relative-to
'lazy lazy?
'allowNull allow-null?
'nullValue null-value))
@ -118,11 +114,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(define type-in (or type-arg type-kwarg uint8))
(xpointer offset-type (case type-in [(void) #f][else type-in]) options))
(define (pointer-style xp) (dict-ref (xpointer-options xp) 'style))
(define (pointer-relative-to xp) (dict-ref (xpointer-options xp) 'relative-to))
(define (allow-null xp) (dict-ref (xpointer-options xp) 'allowNull))
(define (null-value xp) (dict-ref (xpointer-options xp) 'nullValue))
(define (pointer-lazy? xp) (dict-ref (xpointer-options xp) 'lazy))
(define (relative-getter-or-0 xp) (or (dict-ref (xpointer-options xp) 'relativeTo #f) (λ (parent) 0))) ; changed this to a simple lambda
;; A pointer whose type is determined at decode time
(struct xvoid-pointer (type value) #:transparent)

40
xenomorph/xenomorph/test/pointer-test.rkt
Unescape Escape View File

@ -26,30 +26,23 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
(test-case
"decode should support immediate offsets"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(check-equal? (decode (+xpointer #:style 'immediate)) 53)))
(check-equal? (decode (+xpointer #:relative-to 'immediate)) 53)))
(test-case
"decode should support offsets relative to the parent"
(parameterize ([current-input-port (open-input-bytes (bytes 0 0 1 53))])
(pos (current-input-port) 2)
(check-equal? (decode (+xpointer #:style 'parent)
(check-equal? (decode (+xpointer #:relative-to 'parent)
#:parent (mhash 'parent (mhash '_startOffset 2))) 53)))
(test-case
"decode should support global offsets"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 4 0 0 0 53))])
(pos (current-input-port) 2)
(check-equal? (decode (+xpointer #:style 'global)
(check-equal? (decode (+xpointer #:relative-to 'global)
#:parent (mhash 'parent (mhash 'parent (mhash '_startOffset 2))))
53)))
(test-case
"decode should support offsets relative to a property on the parent"
(parameterize ([current-input-port (open-input-bytes (bytes 1 0 0 0 0 53))])
(check-equal? (decode (+xpointer #:relative-to (λ (parent) (dict-ref (dict-ref parent 'parent) 'ptr)))
#:parent (mhash '_startOffset 0 'parent (mhash 'ptr 4)))
53)))
(test-case
"decode should support returning pointer if there is no decode type"
(parameterize ([current-input-port (open-input-bytes (bytes 4))])
@ -72,19 +65,19 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
(test-case
"size should add to immediate pointerSize"
(let ([parent (mhash 'pointerSize 0)])
(check-equal? (size (+xpointer #:style 'immediate) 10 #:parent parent) 1)
(check-equal? (size (+xpointer #:relative-to 'immediate) 10 #:parent parent) 1)
(check-equal? (dict-ref parent 'pointerSize) 1)))
(test-case
"size should add to parent pointerSize"
(let ([parent (mhash 'parent (mhash 'pointerSize 0))])
(check-equal? (size (+xpointer #:style 'parent) 10 #:parent parent) 1)
(check-equal? (size (+xpointer #:relative-to 'parent) 10 #:parent parent) 1)
(check-equal? (dict-ref (dict-ref parent 'parent) 'pointerSize) 1)))
(test-case
"size should add to global pointerSize"
(let ([parent (mhash 'parent (mhash 'parent (mhash 'parent (mhash 'pointerSize 0))))])
(check-equal? (size (+xpointer #:style 'global) 10 #:parent parent) 1)
(check-equal? (size (+xpointer #:relative-to 'global) 10 #:parent parent) 1)
(check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointerSize) 1)))
(test-case
@ -134,7 +127,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 0
'pointerOffset 1
'pointers null))
(encode (+xpointer #:style 'immediate) 10 #:parent parent)
(encode (+xpointer #:relative-to 'immediate) 10 #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 2)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8
'val 10
@ -148,7 +141,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 3
'pointerOffset 5
'pointers null)))
(encode (+xpointer #:style 'parent) 10 #:parent parent)
(encode (+xpointer #:relative-to 'parent) 10 #:parent parent)
(check-equal? (dict-ref (dict-ref parent 'parent) 'pointerOffset) 6)
(check-equal? (dict-ref (dict-ref parent 'parent) 'pointers) (list (mhasheq 'type uint8
'val 10
@ -164,7 +157,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'startOffset 3
'pointerOffset 5
'pointers null)))))
(encode (+xpointer #:style 'global) 10 #:parent parent)
(encode (+xpointer #:relative-to 'global) 10 #:parent parent)
(check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointerOffset) 6)
(check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointers)
(list (mhasheq 'type uint8
@ -172,21 +165,6 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'parent parent)))
(check-equal? (dump (current-output-port)) (bytes 5))))
(test-case
"encode should support offsets relative to a property on the parent"
(parameterize ([current-output-port (open-output-bytes)])
(define parent (mhash 'pointerSize 0
'startOffset 0
'pointerOffset 10
'pointers null
'val (mhash 'ptr 4)))
(encode (+xpointer #:relative-to (λ (parent) (dict-ref parent 'ptr))) 10 #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 11)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8
'val 10
'parent parent)))
(check-equal? (dump (current-output-port)) (bytes 6))))
(test-case
"encode should support void pointers"
(parameterize ([current-output-port (open-output-bytes)])

Write Preview
Loading…
Cancel
Save