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

hashier

Browse Source
main
Matthew Butterick 6 years ago
parent 1f447658a4
commit d895e12fb2
8 changed files with 54 additions and 54 deletions
Show Stats Download Patch File Download Diff File

10
xenomorph/xenomorph/array.rkt
Unescape Escape View File

@ -39,8 +39,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
;; resolved-len is byte length ;; resolved-len is byte length
[len (+ (pos port) len)] [len (+ (pos port) len)]
;; no resolved-len, but parent has length ;; no resolved-len, but parent has length
[(and parent (not (zero? (dict-ref parent x:length-key)))) [(and parent (not (zero? (hash-ref parent x:length-key))))
(+ (dict-ref parent x:start-offset-key) (dict-ref parent x:length-key))] (+ (hash-ref parent x:start-offset-key) (hash-ref parent x:length-key))]
;; no resolved-len or parent, so consume whole stream ;; no resolved-len or parent, so consume whole stream
[else +inf.0])) [else +inf.0]))
(for/list ([i (in-naturals)] (for/list ([i (in-naturals)]
@ -66,11 +66,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
(define new-parent (mhash 'pointers null (define new-parent (mhash 'pointers null
'startOffset (pos port) 'startOffset (pos port)
x:parent-key parent)) x:parent-key parent))
(dict-set! new-parent 'pointerOffset (+ (pos port) (x:size array new-parent))) (hash-set! new-parent 'pointerOffset (+ (pos port) (x:size array new-parent)))
(send @len x:encode (length array) port) ; encode length at front (send @len x:encode (length array) port) ; encode length at front
(encode-items new-parent) (encode-items new-parent)
(for ([ptr (in-list (dict-ref new-parent 'pointers))]) ; encode pointer data at end (for ([ptr (in-list (hash-ref new-parent 'pointers))]) ; encode pointer data at end
(send (dict-ref ptr 'type) x:encode (dict-ref ptr 'val) port))] (send (hash-ref ptr 'type) x:encode (hash-ref ptr 'val) port))]
[else (encode-items parent)])) [else (encode-items parent)]))
(define/augride (x:size [val #f] [parent #f]) (define/augride (x:size [val #f] [parent #f])

16
xenomorph/xenomorph/bitfield.rkt
Unescape Escape View File

@ -24,7 +24,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(define/augment (x:encode flag-hash port [parent #f]) (define/augment (x:encode flag-hash port [parent #f])
(define bit-int (for/sum ([(flag idx) (in-indexed @flags)] (define bit-int (for/sum ([(flag idx) (in-indexed @flags)]
#:when (and flag (dict-ref flag-hash flag #f))) #:when (and flag (hash-ref flag-hash flag #f)))
(arithmetic-shift 1 idx))) (arithmetic-shift 1 idx)))
(send @type x:encode bit-int port)) (send @type x:encode bit-int port))
@ -44,11 +44,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(require rackunit "number.rkt" "generic.rkt") (require rackunit "number.rkt" "generic.rkt")
(define bfer (x:bitfield uint16be '(bold italic underline #f shadow condensed extended))) (define bfer (x:bitfield uint16be '(bold italic underline #f shadow condensed extended)))
(define bf (decode bfer #"\0\25")) (define bf (decode bfer #"\0\25"))
(check-equal? (length (dict-keys bf)) 6) ; omits #f flag (check-equal? (length (hash-keys bf)) 6) ; omits #f flag
(check-true (dict-ref bf 'bold)) (check-true (hash-ref bf 'bold))
(check-true (dict-ref bf 'underline)) (check-true (hash-ref bf 'underline))
(check-true (dict-ref bf 'shadow)) (check-true (hash-ref bf 'shadow))
(check-false (dict-ref bf 'italic)) (check-false (hash-ref bf 'italic))
(check-false (dict-ref bf 'condensed)) (check-false (hash-ref bf 'condensed))
(check-false (dict-ref bf 'extended)) (check-false (hash-ref bf 'extended))
(check-equal? (encode bfer bf #f) #"\0\25")) (check-equal? (encode bfer bf #f) #"\0\25"))

4
xenomorph/xenomorph/helper.rkt
Unescape Escape View File

@ -14,10 +14,10 @@
(define private-keys (list x:parent-key x:start-offset-key x:current-offset-key x:length-key)) (define private-keys (list x:parent-key x:start-offset-key x:current-offset-key x:length-key))
(define (dict-ref* d . keys) (define (hash-ref* d . keys)
(for/fold ([d d]) (for/fold ([d d])
([k (in-list keys)]) ([k (in-list keys)])
(dict-ref d k))) (hash-ref d k)))
(define (pos p [new-pos #f]) (define (pos p [new-pos #f])
(when new-pos (when new-pos

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

@ -14,7 +14,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(define (find-top-parent parent) (define (find-top-parent parent)
(cond (cond
[(dict-ref parent x:parent-key #f) => find-top-parent] [(hash-ref parent x:parent-key #f) => find-top-parent]
[else parent])) [else parent]))
(define (resolve-pointer type val) (define (resolve-pointer type val)
@ -39,10 +39,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[(and @allow-null? (= offset @null-value)) #f] ; handle null pointers [(and @allow-null? (= offset @null-value)) #f] ; handle null pointers
[else [else
(define relative (+ (case @pointer-relative-to (define relative (+ (case @pointer-relative-to
[(local) (dict-ref parent x:start-offset-key)] [(local) (hash-ref parent x:start-offset-key)]
[(immediate) (- (pos port) (send @offset-type x:size))] [(immediate) (- (pos port) (send @offset-type x:size))]
[(parent) (dict-ref (dict-ref parent x:parent-key) x:start-offset-key)] [(parent) (hash-ref (hash-ref parent x:parent-key) x:start-offset-key)]
[(global) (or (dict-ref (find-top-parent parent) x:start-offset-key) 0)] [(global) (or (hash-ref (find-top-parent parent) x:start-offset-key) 0)]
[else (error 'unknown-pointer-style)]))) [else (error 'unknown-pointer-style)])))
(define ptr (+ offset relative)) (define ptr (+ offset relative))
(cond (cond
@ -62,32 +62,32 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[val-in [val-in
(define new-parent (case @pointer-relative-to (define new-parent (case @pointer-relative-to
[(local immediate) parent] [(local immediate) parent]
[(parent) (dict-ref parent x:parent-key)] [(parent) (hash-ref parent x:parent-key)]
[(global) (find-top-parent parent)] [(global) (find-top-parent parent)]
[else (error 'unknown-pointer-style)])) [else (error 'unknown-pointer-style)]))
(define relative (+ (case @pointer-relative-to (define relative (+ (case @pointer-relative-to
[(local parent) (dict-ref new-parent 'startOffset)] [(local parent) (hash-ref new-parent 'startOffset)]
[(immediate) (+ (pos port) (send @offset-type x:size val-in parent))] [(immediate) (+ (pos port) (send @offset-type x:size val-in parent))]
[(global) 0]))) [(global) 0])))
(send @offset-type x:encode (- (dict-ref new-parent 'pointerOffset) relative) port) (send @offset-type x:encode (- (hash-ref new-parent 'pointerOffset) relative) port)
(define-values (type val) (resolve-pointer @type val-in)) (define-values (type val) (resolve-pointer @type val-in))
(dict-update! new-parent 'pointers (hash-update! new-parent 'pointers
(λ (ptrs) (append ptrs (list (mhasheq 'type type 'val val x:parent-key parent))))) (λ (ptrs) (append ptrs (list (mhasheq 'type type 'val val x:parent-key parent)))))
(dict-set! new-parent 'pointerOffset (hash-set! new-parent 'pointerOffset
(+ (dict-ref new-parent 'pointerOffset) (send type x:size val parent)))] (+ (hash-ref new-parent 'pointerOffset) (send type x:size val parent)))]
[else (send @offset-type x:encode @null-value port)])) [else (send @offset-type x:encode @null-value port)]))
(define/augment (x:size [val-in #f] [parent #f]) (define/augment (x:size [val-in #f] [parent #f])
(define new-parent (case @pointer-relative-to (define new-parent (case @pointer-relative-to
[(local immediate) parent] [(local immediate) parent]
[(parent) (dict-ref parent x:parent-key)] [(parent) (hash-ref parent x:parent-key)]
[(global) (find-top-parent parent)] [(global) (find-top-parent parent)]
[else (error 'unknown-pointer-style)])) [else (error 'unknown-pointer-style)]))
(define-values (type val) (resolve-pointer @type val-in)) (define-values (type val) (resolve-pointer @type val-in))
(when (and val new-parent) (when (and val new-parent)
(dict-set! new-parent 'pointerSize (hash-set! new-parent 'pointerSize
(and (dict-ref new-parent 'pointerSize #f) (and (hash-ref new-parent 'pointerSize #f)
(+ (dict-ref new-parent 'pointerSize) (send type x:size val new-parent))))) (+ (hash-ref new-parent 'pointerSize) (send type x:size val new-parent)))))
(send @offset-type x:size)))) (send @offset-type x:size))))
(define (x:pointer [offset-arg #f] [type-arg #f] (define (x:pointer [offset-arg #f] [type-arg #f]

4
xenomorph/xenomorph/string.rkt
Unescape Escape View File

@ -51,7 +51,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(define/augment (x:encode val-arg port [parent #f]) (define/augment (x:encode val-arg port [parent #f])
(define val (if (string? val-arg) val-arg (format "~a" val-arg))) (define val (if (string? val-arg) val-arg (format "~a" val-arg)))
(define encoding (if (procedure? @encoding) (define encoding (if (procedure? @encoding)
(or (@encoding (and parent (dict-ref parent val)) 'ascii)) (or (@encoding (and parent (hash-ref parent val)) 'ascii))
@encoding)) @encoding))
(define encoded-str (encode-string val encoding)) (define encoded-str (encode-string val encoding))
(define encoded-length (bytes-length encoded-str)) (define encoded-length (bytes-length encoded-str))
@ -69,7 +69,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
[else (format "~a" val-arg)])) [else (format "~a" val-arg)]))
(cond (cond
[val (define encoding (if (procedure? @encoding) [val (define encoding (if (procedure? @encoding)
(or (@encoding (and parent (dict-ref parent val)) 'ascii)) (or (@encoding (and parent (hash-ref parent val)) 'ascii))
@encoding)) @encoding))
(define string-size (bytes-length (encode-string val encoding))) (define string-size (bytes-length (encode-string val encoding)))
(define strlen-size (cond (define strlen-size (cond

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

@ -52,38 +52,38 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
"pointer: decode should support decoding pointers lazily" "pointer: decode should support decoding pointers lazily"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))]) (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(define res (decode (x:struct 'ptr (x:pointer #:lazy #t)))) (define res (decode (x:struct 'ptr (x:pointer #:lazy #t))))
(check-true (promise? (dict-ref res 'ptr))) (check-true (promise? (hash-ref res 'ptr)))
(check-equal? (force (dict-ref res 'ptr)) 53))) (check-equal? (force (hash-ref res 'ptr)) 53)))
(test-case (test-case
"pointer: size" "pointer: size"
(let ([parent (mhash 'pointerSize 0)]) (let ([parent (mhash 'pointerSize 0)])
(check-equal? (size (x:pointer) 10 #:parent parent) 1) (check-equal? (size (x:pointer) 10 #:parent parent) 1)
(check-equal? (dict-ref parent 'pointerSize) 1))) (check-equal? (hash-ref parent 'pointerSize) 1)))
(test-case (test-case
"pointer: size should add to immediate pointerSize" "pointer: size should add to immediate pointerSize"
(let ([parent (mhash 'pointerSize 0)]) (let ([parent (mhash 'pointerSize 0)])
(check-equal? (size (x:pointer #:relative-to 'immediate) 10 #:parent parent) 1) (check-equal? (size (x:pointer #:relative-to 'immediate) 10 #:parent parent) 1)
(check-equal? (dict-ref parent 'pointerSize) 1))) (check-equal? (hash-ref parent 'pointerSize) 1)))
(test-case (test-case
"pointer: size should add to parent pointerSize" "pointer: size should add to parent pointerSize"
(let ([parent (mhash x:parent-key (mhash 'pointerSize 0))]) (let ([parent (mhash x:parent-key (mhash 'pointerSize 0))])
(check-equal? (size (x:pointer #:relative-to 'parent) 10 #:parent parent) 1) (check-equal? (size (x:pointer #:relative-to 'parent) 10 #:parent parent) 1)
(check-equal? (dict-ref* parent x:parent-key 'pointerSize) 1))) (check-equal? (hash-ref* parent x:parent-key 'pointerSize) 1)))
(test-case (test-case
"pointer: size should add to global pointerSize" "pointer: size should add to global pointerSize"
(let ([parent (mhash x:parent-key (mhash x:parent-key (mhash x:parent-key (mhash 'pointerSize 0))))]) (let ([parent (mhash x:parent-key (mhash x:parent-key (mhash x:parent-key (mhash 'pointerSize 0))))])
(check-equal? (size (x:pointer #:relative-to 'global) 10 #:parent parent) 1) (check-equal? (size (x:pointer #:relative-to 'global) 10 #:parent parent) 1)
(check-equal? (dict-ref* parent x:parent-key x:parent-key x:parent-key 'pointerSize) 1))) (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key 'pointerSize) 1)))
(test-case (test-case
"pointer: size should handle void pointers" "pointer: size should handle void pointers"
(let ([parent (mhash 'pointerSize 0)]) (let ([parent (mhash 'pointerSize 0)])
(check-equal? (size (x:pointer uint8 'void) (x:void-pointer uint8 50) #:parent parent) 1) (check-equal? (size (x:pointer uint8 'void) (x:void-pointer uint8 50) #:parent parent) 1)
(check-equal? (dict-ref parent 'pointerSize) 1))) (check-equal? (hash-ref parent 'pointerSize) 1)))
(test-case (test-case
"pointer: size should throw if no type and not a void pointer" "pointer: size should throw if no type and not a void pointer"
@ -102,7 +102,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'pointerOffset 0 'pointerOffset 0
'pointers null)) 'pointers null))
(encode (x:pointer) #f #:parent parent) (encode (x:pointer) #f #:parent parent)
(check-equal? (dict-ref parent 'pointerSize) 0) (check-equal? (hash-ref parent 'pointerSize) 0)
(check-equal? (get-output-bytes (current-output-port)) (bytes 0)))) (check-equal? (get-output-bytes (current-output-port)) (bytes 0))))
(test-case (test-case
@ -113,8 +113,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'pointerOffset 1 'pointerOffset 1
'pointers null)) 'pointers null))
(encode (x:pointer) 10 #:parent parent) (encode (x:pointer) 10 #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 2) (check-equal? (hash-ref parent 'pointerOffset) 2)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 (check-equal? (hash-ref parent 'pointers) (list (mhasheq 'type uint8
'val 10 'val 10
x:parent-key parent))) x:parent-key parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 1)))) (check-equal? (get-output-bytes (current-output-port)) (bytes 1))))
@ -127,8 +127,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'pointerOffset 1 'pointerOffset 1
'pointers null)) 'pointers null))
(encode (x:pointer #:relative-to 'immediate) 10 #:parent parent) (encode (x:pointer #:relative-to 'immediate) 10 #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 2) (check-equal? (hash-ref parent 'pointerOffset) 2)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 (check-equal? (hash-ref parent 'pointers) (list (mhasheq 'type uint8
'val 10 'val 10
x:parent-key parent))) x:parent-key parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 0)))) (check-equal? (get-output-bytes (current-output-port)) (bytes 0))))
@ -141,8 +141,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'pointerOffset 5 'pointerOffset 5
'pointers null))) 'pointers null)))
(encode (x:pointer #:relative-to 'parent) 10 #:parent parent) (encode (x:pointer #:relative-to 'parent) 10 #:parent parent)
(check-equal? (dict-ref* parent x:parent-key 'pointerOffset) 6) (check-equal? (hash-ref* parent x:parent-key 'pointerOffset) 6)
(check-equal? (dict-ref* parent x:parent-key 'pointers) (list (mhasheq 'type uint8 (check-equal? (hash-ref* parent x:parent-key 'pointers) (list (mhasheq 'type uint8
'val 10 'val 10
x:parent-key parent))) x:parent-key parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 2)))) (check-equal? (get-output-bytes (current-output-port)) (bytes 2))))
@ -157,8 +157,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'pointerOffset 5 'pointerOffset 5
'pointers null))))) 'pointers null)))))
(encode (x:pointer #:relative-to 'global) 10 #:parent parent) (encode (x:pointer #:relative-to 'global) 10 #:parent parent)
(check-equal? (dict-ref* parent x:parent-key x:parent-key x:parent-key 'pointerOffset) 6) (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key 'pointerOffset) 6)
(check-equal? (dict-ref* parent x:parent-key x:parent-key x:parent-key 'pointers) (check-equal? (hash-ref* parent x:parent-key x:parent-key x:parent-key 'pointers)
(list (mhasheq 'type uint8 (list (mhasheq 'type uint8
'val 10 'val 10
x:parent-key parent))) x:parent-key parent)))
@ -172,8 +172,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
'pointerOffset 1 'pointerOffset 1
'pointers null)) 'pointers null))
(encode (x:pointer uint8 'void) (x:void-pointer uint8 55) #:parent parent) (encode (x:pointer uint8 'void) (x:void-pointer uint8 55) #:parent parent)
(check-equal? (dict-ref parent 'pointerOffset) 2) (check-equal? (hash-ref parent 'pointerOffset) 2)
(check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8 'val 55 x:parent-key parent))) (check-equal? (hash-ref parent 'pointers) (list (mhasheq 'type uint8 'val 55 x:parent-key parent)))
(check-equal? (get-output-bytes (current-output-port)) (bytes 1)))) (check-equal? (get-output-bytes (current-output-port)) (bytes 1))))
(test-case (test-case

6
xenomorph/xenomorph/test/struct-test.rkt
Unescape Escape View File

@ -24,7 +24,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(test-case (test-case
"struct: decode with process hook" "struct: decode with process hook"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (x:struct #:post-decode (λ (o) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o) (define struct (x:struct #:post-decode (λ (o) (hash-set! o 'canDrink (>= (hash-ref o 'age) 21)) o)
'name (x:string #:length uint8) 'age uint8)) 'name (x:string #:length uint8) 'age uint8))
(check-equal? (decode struct) (check-equal? (decode struct)
(mhasheq 'name "roxyb" 'age 32 'canDrink #t)))) (mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
@ -32,7 +32,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(test-case (test-case
"struct: decode supports function keys" "struct: decode supports function keys"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (x:struct 'name (x:string #:length uint8) 'age uint8 'canDrink (λ (o) (>= (dict-ref o 'age) 21)))) (define struct (x:struct 'name (x:string #:length uint8) 'age uint8 'canDrink (λ (o) (>= (hash-ref o 'age) 21))))
(check-equal? (decode struct) (check-equal? (decode struct)
(mhasheq 'name "roxyb" 'age 32 'canDrink #t)))) (mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
@ -66,7 +66,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
"struct: support pre-encode hook" "struct: support pre-encode hook"
(parameterize ([current-output-port (open-output-bytes)]) (parameterize ([current-output-port (open-output-bytes)])
(define struct (x:struct #:pre-encode (λ (val) (define struct (x:struct #:pre-encode (λ (val)
(dict-set! val 'nameLength (string-length (dict-ref val 'name))) val) (hash-set! val 'nameLength (string-length (hash-ref val 'name))) val)
'nameLength uint8 'nameLength uint8
'name (x:string 'nameLength) 'name (x:string 'nameLength)
'age uint8)) 'age uint8))

4
xenomorph/xenomorph/test/versioned-struct-test.rkt
Unescape Escape View File

@ -101,7 +101,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(test-case (test-case
"versioned struct: decode should support process hook" "versioned struct: decode should support process hook"
(let ([vstruct (x:versioned-struct #:post-decode (λ (val) (dict-set! val 'processed "true") val) (let ([vstruct (x:versioned-struct #:post-decode (λ (val) (hash-set! val 'processed "true") val)
uint8 uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
@ -244,7 +244,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
(set-pre-encode! vstruct (λ (val) (dict-set! val x:version-key (if (dict-ref val 'gender #f) 1 0)) val)) (set-pre-encode! vstruct (λ (val) (hash-set! val x:version-key (if (hash-ref val 'gender #f) 1 0)) val))
(encode vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 0) op) (encode vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 0) op)
(encode vstruct (mhasheq 'name "roxyb 🤘" 'age 21 'gender 0) op) (encode vstruct (mhasheq 'name "roxyb 🤘" 'age 21 'gender 0) op)
(check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00")))) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00"))))
Write Preview
Loading…
Cancel
Save