From 3fb2990284aaee90e2d36c6f7666cf717a3a734e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 7 Jun 2017 17:11:37 -0700 Subject: [PATCH] resume in struct --- pitfall/pitfall/directory.rkt | 94 +++++++++++++++++----------------- pitfall/restructure/helper.rkt | 18 ++++++- pitfall/restructure/main.rkt | 4 ++ pitfall/restructure/number.rkt | 43 +++++++++++++--- pitfall/restructure/racket.rkt | 1 + pitfall/restructure/struct.rkt | 19 +++++++ 6 files changed, 123 insertions(+), 56 deletions(-) create mode 100644 pitfall/restructure/main.rkt create mode 100644 pitfall/restructure/struct.rkt diff --git a/pitfall/pitfall/directory.rkt b/pitfall/pitfall/directory.rkt index 1acf0a78..146f5a10 100644 --- a/pitfall/pitfall/directory.rkt +++ b/pitfall/pitfall/directory.rkt @@ -1,50 +1,50 @@ #lang pitfall/racket (provide (all-defined-out)) -(require binparser/object) - - - -(define TableEntry (:seq ([tag (:make-string 4)] - [checkSum uint32be] - [offset uint32be] - [length uint32be]))) - -(define Directory (:seq ([tag hexbytes #:assert (curry equal? "00 01 00 00")] - [numTables uint16be #:assert ] - [searchRange uint16be] - [entrySelector uint16be] - [rangeShift uint16be] - [tables (:repeat numTables TableEntry)]))) - -(define (directory-decode ip [options (mhash)]) - (Directory ip)) - - -(define ip (open-input-file "test/assets/Charter.ttf")) -(directory-decode ip (mhash '_startOffset 0)) -(module+ test - (require rackunit) - (define ip (open-input-file "test/assets/Charter.ttf")) - (check-equal? - (directory-decode ip (mhash '_startOffset 0)) - '((tag . "00 01 00 00") - (numTables . 14) - (searchRange . 128) - (entrySelector . 3) - (rangeShift . 96) - (tables - ((tag . "OS/2") (checkSum . 2351070438) (offset . 360) (length . 96)) - ((tag . "VDMX") (checkSum . 1887795202) (offset . 1372) (length . 1504)) - ((tag . "cmap") (checkSum . 1723761408) (offset . 2876) (length . 1262)) - ((tag . "cvt ") (checkSum . 10290865) (offset . 4592) (length . 26)) - ((tag . "fpgm") (checkSum . 106535991) (offset . 4140) (length . 371)) - ((tag . "glyf") (checkSum . 1143629849) (offset . 4620) (length . 34072)) - ((tag . "head") (checkSum . 4281190895) (offset . 236) (length . 54)) - ((tag . "hhea") (checkSum . 132056097) (offset . 292) (length . 36)) - ((tag . "hmtx") (checkSum . 3982043058) (offset . 456) (length . 916)) - ((tag . "loca") (checkSum . 2795817194) (offset . 38692) (length . 460)) - ((tag . "maxp") (checkSum . 50135594) (offset . 328) (length . 32)) - ((tag . "name") (checkSum . 2629707307) (offset . 39152) (length . 2367)) - ((tag . "post") (checkSum . 1670855689) (offset . 41520) (length . 514)) - ((tag . "prep") (checkSum . 490862356) (offset . 4512) (length . 78)))))) \ No newline at end of file +(require restructure) + + +#;(define TableEntry (new RStruct + 'tag (RString 4) + 'checkSum uint32be + 'offset uint32be + 'length uint32be)) + +#;(define Directory (:seq ([tag hexbytes #:assert (curry equal? "/00 01 00 00")] + [numTables uint16be #:assert ] + [searchRange uint16be] + [entrySelector uint16be] + [rangeShift uint16be] + [tables (:repeat numTables TableEntry)]))) + +#;(define (directory-decode ip [options (mhash)]) + (Directory ip)) + + +#;(define ip (open-input-file "test/assets/Charter.ttf")) +#;(directory-decode ip (mhash '_startOffset 0)) +#;(module+ test + (require rackunit) + (define ip (open-input-file "test/assets/Charter.ttf")) + (check-equal? + (directory-decode ip (mhash '_startOffset 0)) + '((tag . "00 01 00 00") + (numTables . 14) + (searchRange . 128) + (entrySelector . 3) + (rangeShift . 96) + (tables + ((tag . "OS/2") (checkSum . 2351070438) (offset . 360) (length . 96)) + ((tag . "VDMX") (checkSum . 1887795202) (offset . 1372) (length . 1504)) + ((tag . "cmap") (checkSum . 1723761408) (offset . 2876) (length . 1262)) + ((tag . "cvt ") (checkSum . 10290865) (offset . 4592) (length . 26)) + ((tag . "fpgm") (checkSum . 106535991) (offset . 4140) (length . 371)) + ((tag . "glyf") (checkSum . 1143629849) (offset . 4620) (length . 34072)) + ((tag . "head") (checkSum . 4281190895) (offset . 236) (length . 54)) + ((tag . "hhea") (checkSum . 132056097) (offset . 292) (length . 36)) + ((tag . "hmtx") (checkSum . 3982043058) (offset . 456) (length . 916)) + ((tag . "loca") (checkSum . 2795817194) (offset . 38692) (length . 460)) + ((tag . "maxp") (checkSum . 50135594) (offset . 328) (length . 32)) + ((tag . "name") (checkSum . 2629707307) (offset . 39152) (length . 2367)) + ((tag . "post") (checkSum . 1670855689) (offset . 41520) (length . 514)) + ((tag . "prep") (checkSum . 490862356) (offset . 4512) (length . 78)))))) \ No newline at end of file diff --git a/pitfall/restructure/helper.rkt b/pitfall/restructure/helper.rkt index cfd7e55a..9f6dbbf9 100644 --- a/pitfall/restructure/helper.rkt +++ b/pitfall/restructure/helper.rkt @@ -8,7 +8,7 @@ (raise-argument-error 'read-bytes-exact (format "byte string length ~a" count) bs)) bs) -(define RestructureBase% +(define RBase (class object% (super-new) (abstract decode) @@ -56,4 +56,18 @@ (define-macro (unfinished) (with-pattern ([ID-UNFINISHED (prefix-id (syntax-source caller-stx) ":" (syntax-line caller-stx) ":" #'unfinished)]) - #'(error 'ID-UNFINISHED))) \ No newline at end of file + #'(error 'ID-UNFINISHED))) + +(define-macro (define+provide ID . EXPRS) + #'(begin + (provide ID) + (define ID . EXPRS))) + +(require sugar/list) +(define (listify kvs) + (for/list ([slice (in-list (slice-at kvs 2))]) + (cons (car slice) (cadr slice)))) +(define-syntax-rule (define-hashifier id hasher) (define (id . kvs) (hasher (listify kvs)))) +(define-hashifier mhash make-hash) +(define-hashifier mhasheq make-hasheq) +(define-hashifier mhasheqv make-hasheqv) \ No newline at end of file diff --git a/pitfall/restructure/main.rkt b/pitfall/restructure/main.rkt new file mode 100644 index 00000000..74affd7b --- /dev/null +++ b/pitfall/restructure/main.rkt @@ -0,0 +1,4 @@ +#lang restructure/racket + +(r+p "number.rkt" + "struct.rkt") \ No newline at end of file diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index 30b66d34..a1d8bc86 100644 --- a/pitfall/restructure/number.rkt +++ b/pitfall/restructure/number.rkt @@ -14,11 +14,11 @@ (check-true (unsigned-type? 'UInt16)) (check-false (unsigned-type? 'Int16))) -(define-subclass RestructureBase% (NumberT type [endian (if (system-big-endian?) 'BE 'LE)]) +(define-subclass RBase (Number [type 'UInt16] [endian (if (system-big-endian?) 'BE 'LE)]) (getter-field [fn (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))]) (unless (hash-has-key? type-sizes fn) - (raise-argument-error 'NumberT "valid type and endian" (format "~v ~v" type endian))) + (raise-argument-error 'Number "valid type and endian" (format "~v ~v" type endian))) (getter-field [size (hash-ref type-sizes fn)]) @@ -39,7 +39,7 @@ (test-module - (let ([o (make-object NumberT 'UInt16 'LE)] + (let ([o (make-object Number 'UInt16 'LE)] [ip (open-input-bytes (bytes 1 2 3 4))] [op (open-output-bytes)]) (check-equal? (send o decode ip) 513) ;; 1000 0000 0100 0000 @@ -47,7 +47,7 @@ (check-equal? (send o encode op 513) (bytes 1 2)) (check-equal? (send o encode op 1027) (bytes 3 4))) - (let ([o (make-object NumberT 'UInt16 'BE)] + (let ([o (make-object Number 'UInt16 'BE)] [ip (open-input-bytes (bytes 1 2 3 4))] [op (open-output-bytes)]) (check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000 @@ -57,7 +57,36 @@ (test-module - (check-equal? (send (make-object NumberT 'UInt8) size) 1) - (check-equal? (send (make-object NumberT 'UInt32) size) 4) - (check-equal? (send (make-object NumberT 'Double) size) 8)) + (check-equal? (send (make-object Number 'UInt8) size) 1) + (check-equal? (send (make-object Number) size) 2) + (check-equal? (send (make-object Number 'UInt32) size) 4) + (check-equal? (send (make-object Number 'Double) size) 8)) + + +(require (for-syntax "decodestream.rkt" racket/match)) + +;; use keys of type-sizes hash to generate corresponding number definitions +(define-macro (make-int-types) + (with-pattern ([((ID BASE ENDIAN) ...) (for/list ([k (in-hash-keys type-sizes)]) + (define kstr (format "~a" k)) + (match-define (list* prefix suffix _) + (regexp-split #rx"(?=[BL]E|$)" kstr)) + (map string->symbol + (list (string-downcase kstr) + prefix + (if (positive? (string-length suffix)) + suffix + (if (system-big-endian?) "BE" "LE")))))] + [(ID ...) (suffix-id #'(ID ...) #:context caller-stx)]) + #'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...))) + + +(make-int-types) + + +(test-module + (check-equal? (send uint8 size) 1) + (check-equal? (send uint16 size) 2) + (check-equal? (send uint32 size) 4) + (check-equal? (send double size) 8)) diff --git a/pitfall/restructure/racket.rkt b/pitfall/restructure/racket.rkt index f48ae201..c11ec2c7 100644 --- a/pitfall/restructure/racket.rkt +++ b/pitfall/restructure/racket.rkt @@ -8,6 +8,7 @@ (r+p "helper.rkt" sugar/debug racket/class + racket/string br/define) (module reader syntax/module-reader diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt new file mode 100644 index 00000000..955dc9b8 --- /dev/null +++ b/pitfall/restructure/struct.rkt @@ -0,0 +1,19 @@ +#lang restructure/racket +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee +|# + +(define-subclass RBase (RStruct [fields (mhash)]) + + (define/override (decode stream parent [length 0]) + (unfinished)) + + (define/override (encode stream val parent) + (unfinished)) + ) + + +(make-object RStruct (mhash 'foo "bar")) \ No newline at end of file