pre-encode and post-deocde

main
Matthew Butterick 6 years ago
parent 60ac5e801d
commit 7d22b9224c

@ -7,7 +7,7 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
|#
(define (xarray-decode xa [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xarray-decode xa [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(parameterize ([current-input-port port])
(define new-parent (if (xint? (xarray-base-len xa))
@ -33,7 +33,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
[else (for/list ([i (in-range decoded-len)])
(decode (xarray-base-type xa) #:parent new-parent))])))
(define (xarray-encode xa array [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xarray-encode xa array [port-arg (current-output-port)] #:parent [parent #f])
(unless (sequence? array)
(raise-argument-error 'xarray-encode "sequence" array))
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
@ -59,22 +59,21 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
[else (encode-items parent)])
(unless port-arg (get-output-bytes port))))
(define (xarray-size xa [val #f] #:parent [parent #f])
(define/finalize-size (xarray-size xa [val #f] #:parent [parent #f])
(when val (unless (sequence? val)
(raise-argument-error 'xarray-size "sequence" val)))
(finalize-size
(cond
[val (define-values (new-parent len-size) (if (xint? (xarray-base-len xa))
(values (mhasheq 'parent parent) (size (xarray-base-len xa)))
(values parent 0)))
(define items-size (for/sum ([item val])
(size (xarray-base-type xa) item #:parent new-parent)))
(+ items-size len-size)]
[else (define item-count (resolve-length (xarray-base-len xa) #f #:parent parent))
(define item-size (size (xarray-base-type xa) #f #:parent parent))
(* item-size item-count)])))
(cond
[val (define-values (new-parent len-size) (if (xint? (xarray-base-len xa))
(values (mhasheq 'parent parent) (size (xarray-base-len xa)))
(values parent 0)))
(define items-size (for/sum ([item val])
(size (xarray-base-type xa) item #:parent new-parent)))
(+ items-size len-size)]
[else (define item-count (resolve-length (xarray-base-len xa) #f #:parent parent))
(define item-size (size (xarray-base-type xa) #f #:parent parent))
(* item-size item-count)]))
(struct xarray-base (type len) #:transparent)
(struct xarray-base xbase (type len) #:transparent)
(struct xarray xarray-base (length-type) #:transparent
#:methods gen:xenomorphic
[(define decode xarray-decode)

@ -7,7 +7,7 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
|#
(define (xbitfield-decode xb [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xbitfield-decode xb [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(parameterize ([current-input-port port])
(define flag-hash (mhasheq))
@ -17,7 +17,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(hash-set! flag-hash flag (bitwise-bit-set? val i)))
flag-hash))
(define (xbitfield-encode xb flag-hash [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xbitfield-encode xb flag-hash [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port])
(define bit-int (for/sum ([(flag i) (in-indexed (xbitfield-flags xb))]
@ -29,7 +29,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(define (xbitfield-size xb [val #f] #:parent [parent #f])
(size (xbitfield-type xb)))
(struct xbitfield (type flags) #:transparent
(struct xbitfield xbase (type flags) #:transparent
#:methods gen:xenomorphic
[(define decode xbitfield-decode)
(define encode xbitfield-encode)

@ -7,13 +7,13 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
|#
(define (xbuffer-decode xb [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xbuffer-decode xb [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(parameterize ([current-input-port port])
(define decoded-len (resolve-length (xbuffer-len xb) #:parent parent))
(read-bytes decoded-len)))
(define (xbuffer-encode xb buf [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xbuffer-encode xb buf [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port])
(unless (bytes? buf)
@ -23,15 +23,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
(write-bytes buf)
(unless port-arg (get-output-bytes port))))
(define (xbuffer-size xb [val #f] #:parent [parent #f])
(define/finalize-size (xbuffer-size xb [val #f] #:parent [parent #f])
(when val (unless (bytes? val)
(raise-argument-error 'xbuffer-size "bytes" val)))
(finalize-size
(if (bytes? val)
(bytes-length val)
(resolve-length (xbuffer-len xb) val #:parent parent))))
(if (bytes? val)
(bytes-length val)
(resolve-length (xbuffer-len xb) val #:parent parent)))
(struct xbuffer (len) #:transparent
(struct xbuffer xbase (len) #:transparent
#:methods gen:xenomorphic
[(define decode xbuffer-decode)
(define encode xbuffer-encode)

@ -7,7 +7,7 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
|#
(define (xenum-decode xe [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xenum-decode xe [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(parameterize ([current-input-port port])
(define index (decode (xenum-type xe)))
@ -16,7 +16,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
(define (xenum-size xe [val #f] #:parent [parent #f])
(size (xenum-type xe)))
(define (xenum-encode xe val [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xenum-encode xe val [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port])
(define index (index-of (xenum-options xe) val))
@ -25,7 +25,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
(encode (xenum-type xe) index)
(unless port-arg (get-output-bytes port))))
(struct xenum (type options) #:transparent
(struct xenum xbase (type options) #:transparent
#:methods gen:xenomorphic
[(define decode xenum-decode)
(define encode xenum-encode)

@ -24,7 +24,28 @@
(file-position p new-pos))
(file-position p))
(struct xbase (pre-encode post-decode) #:transparent #:mutable)
(struct xbase ([pre-encode #:auto] [post-decode #:auto]) #:transparent #:mutable
#:auto-value values)
(define (pre-encode xb val)
((xbase-pre-encode xb) val))
(define (set-pre-encode! xb func)
(set-xbase-pre-encode! xb func))
(define (post-decode xb val)
((xbase-post-decode xb) val))
(define (set-post-decode! xb func)
(set-xbase-post-decode! xb func))
(define-syntax-rule (define/post-decode (ID X VAL . ARGS) . BODY)
(define (ID X VAL . ARGS) (post-decode X (let () . BODY))))
(define-syntax-rule (define/pre-encode (ID X VAL . ARGS) . BODY)
(define (ID X val-in . ARGS) (let ([VAL (pre-encode X val-in)]) . BODY)))
(define-syntax-rule (define/finalize-size ID+ARGS . BODY) (define ID+ARGS (finalize-size (let () . BODY))))
(define-generics xenomorphic
(encode xenomorphic val [port] #:parent [parent])

@ -26,7 +26,7 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
(pos port (+ starting-pos (* (size type #f #:parent parent) index)))
;; use explicit `port` arg below because this evaluation is delayed
(begin0
(decode type port #:parent parent)
(post-decode xla (decode type port #:parent parent))
(pos port orig-pos)))
(pos port (+ (pos port) (* decoded-len (size (xarray-base-type xla) #f #:parent parent))))))))

@ -23,7 +23,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(define system-endian (if (system-big-endian?) 'be 'le))
(define (xint-encode i val [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xint-encode i val [port-arg (current-output-port)] #:parent [parent #f])
(unless (xint? i)
(raise-argument-error 'encode "xint instance" i))
(define-values (bound-min bound-max) (bounds i))
@ -41,7 +41,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(define res (apply bytes ((if (eq? (xint-endian i) 'be) values reverse) bs)))
(if port-arg (write-bytes res) res)))
(define (xint-decode i [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xint-decode i [port-arg (current-input-port)] #:parent [parent #f])
(unless (xint? i)
(raise-argument-error 'decode "xint instance" i))
(define port (->input-port port-arg))
@ -55,7 +55,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(arithmetic-shift b (* 8 i))))
(if (xint-signed i) (unsigned->signed uint (bits i)) uint)))
(struct xnumber () #:transparent)
(struct xnumber xbase () #:transparent)
(struct xint xnumber (size signed endian) #:transparent
#:methods gen:xenomorphic
@ -157,13 +157,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(check-equal? (encode int8 -1 #f) (bytes 255))
(check-equal? (encode int8 127 #f) (bytes 127)))
(define (xfloat-decode xf [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xfloat-decode xf [port-arg (current-input-port)] #:parent [parent #f])
(unless (xfloat? xf)
(raise-argument-error 'decode "xfloat instance" xf))
(define bs (read-bytes (xfloat-size xf) (->input-port port-arg)))
(floating-point-bytes->real bs (eq? (xfloat-endian xf) 'be)))
(define (xfloat-encode xf val [port (current-output-port)] #:parent [parent #f])
(define/pre-encode (xfloat-encode xf val [port (current-output-port)] #:parent [parent #f])
(unless (xfloat? xf)
(raise-argument-error 'encode "xfloat instance" xf))
(unless (or (not port) (output-port? port))
@ -192,13 +192,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(define doublebe (+xfloat 8 #:endian 'be))
(define doublele (+xfloat 8 #:endian 'le))
(define (xfixed-decode xf [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xfixed-decode xf [port-arg (current-input-port)] #:parent [parent #f])
(unless (xfixed? xf)
(raise-argument-error 'decode "xfixed instance" xf))
(define int (xint-decode xf port-arg))
(exact-if-possible (/ int (fixed-shift xf) 1.0)))
(define (xfixed-encode xf val [port (current-output-port)] #:parent [parent #f])
(define/pre-encode (xfixed-encode xf val [port (current-output-port)] #:parent [parent #f])
(unless (xfixed? xf)
(raise-argument-error 'encode "xfixed instance" xf))
(define int (exact-if-possible (floor (* val (fixed-shift xf)))))

@ -13,25 +13,24 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee
(maybe-proc parent)
maybe-proc))
(define (xoptional-decode xo [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xoptional-decode xo [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(parameterize ([current-input-port port])
(when (resolve-condition xo parent)
(decode (xoptional-type xo) #:parent parent))))
(define (xoptional-encode xo val [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xoptional-encode xo val [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port])
(when (resolve-condition xo parent)
(encode (xoptional-type xo) val #:parent parent))
(unless port-arg (get-output-bytes port))))
(define (xoptional-size xo [val #f] #:parent [parent #f])
(finalize-size
(when (resolve-condition xo parent)
(size (xoptional-type xo) val #:parent parent))))
(define/finalize-size (xoptional-size xo [val #f] #:parent [parent #f])
(when (resolve-condition xo parent)
(size (xoptional-type xo) val #:parent parent)))
(struct xoptional (type condition) #:transparent
(struct xoptional xbase (type condition) #:transparent
#:methods gen:xenomorphic
[(define decode xoptional-decode)
(define encode xoptional-encode)

@ -14,7 +14,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[(dict-ref parent 'parent #f) => find-top-parent]
[else parent]))
(define (xpointer-decode xp [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xpointer-decode xp [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(parameterize ([current-input-port port])
(define offset (decode (xpointer-offset-type xp) #:parent parent))
@ -52,7 +52,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[(xvoid-pointer? val) (values (xvoid-pointer-type val) (xvoid-pointer-value val))]
[else (raise-argument-error 'Pointer:size "VoidPointer" val)]))
(define (xpointer-encode xp val [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xpointer-encode xp val [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(unless parent ; todo: furnish default pointer context? adapt from Struct?
(raise-argument-error 'xpointer-encode "valid pointer context" parent))
@ -90,7 +90,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(+ (dict-ref parent 'pointerSize) (size type val #:parent parent)))))
(size (xpointer-offset-type xp))))
(struct xpointer (offset-type type options) #:transparent
(struct xpointer xbase (offset-type type options) #:transparent
#:methods gen:xenomorphic
[(define decode xpointer-decode)
(define encode xpointer-encode)

@ -7,22 +7,22 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
|#
(define (xreserved-decode xo [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xreserved-decode xo [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(pos port (+ (pos port) (size xo #f #:parent parent)))
(void))
(define (xreserved-encode xo val [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xreserved-encode xo val [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(write-bytes (make-bytes (size xo val #:parent parent) 0) port)
(unless port-arg (get-output-bytes port)))
(define (xreserved-size xo [val #f] #:parent [parent #f])
(define/finalize-size (xreserved-size xo [val #f] #:parent [parent #f])
(define item-size (size (xreserved-type xo)))
(define count (resolve-length (xreserved-count xo) #f #:parent parent))
(finalize-size (* item-size count)))
(* item-size count))
(struct xreserved (type count) #:transparent
(struct xreserved xbase (type count) #:transparent
#:methods gen:xenomorphic
[(define decode xreserved-decode)
(define encode xreserved-encode)

@ -39,7 +39,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
[(ascii utf8) string->bytes/utf-8]))
(bytes-length (encoder (format "~a" val))))
(define (xstring-decode xs [port-arg (current-input-port)] #:parent [parent #f])
(define/post-decode (xstring-decode xs [port-arg (current-input-port)] #:parent [parent #f])
(define port (->input-port port-arg))
(parameterize ([current-input-port port])
(let ([len (or (resolve-length (xstring-len xs) #:parent parent) (count-nonzero-chars port))]
@ -51,7 +51,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(pos port (+ (pos port) adjustment))
string)))
(define (xstring-encode xs val [port-arg (current-output-port)] #:parent [parent #f])
(define/pre-encode (xstring-encode xs val [port-arg (current-output-port)] #:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port])
(let* ([val (format "~a" val)]
@ -67,21 +67,20 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(when (not (xstring-len xs)) (write-byte #x00)) ; null terminated when no len
(unless port-arg (get-output-bytes port)))))
(define (xstring-size xs [val #f] #:parent [parent #f])
(finalize-size
(cond
[val (define encoding (if (procedure? (xstring-encoding xs))
(or ((xstring-encoding xs) (and parent (dict-ref parent val)) 'ascii))
(xstring-encoding xs)))
(define string-size (byte-length val (if (eq? encoding 'utf16be) 'utf16le encoding)))
(define strlen-size (cond
[(not (xstring-len xs)) 1]
[(xint? (xstring-len xs)) (size (xstring-len xs))]
[else 0]))
(+ string-size strlen-size)]
[else (resolve-length (xstring-len xs) #f #:parent parent)])))
(struct xstring (len encoding) #:transparent
(define/finalize-size (xstring-size xs [val #f] #:parent [parent #f])
(cond
[val (define encoding (if (procedure? (xstring-encoding xs))
(or ((xstring-encoding xs) (and parent (dict-ref parent val)) 'ascii))
(xstring-encoding xs)))
(define string-size (byte-length val (if (eq? encoding 'utf16be) 'utf16le encoding)))
(define strlen-size (cond
[(not (xstring-len xs)) 1]
[(xint? (xstring-len xs)) (size (xstring-len xs))]
[else 0]))
(+ string-size strlen-size)]
[else (resolve-length (xstring-len xs) #f #:parent parent)]))
(struct xstring xbase (len encoding) #:transparent
#:methods gen:xenomorphic
[(define decode xstring-decode)
(define encode xstring-encode)

@ -60,20 +60,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(let* ([sdr (_setup port parent len)] ; returns StructDictRes
[sdr (_parse-fields port sdr (xstruct-fields xs))])
sdr))
(let* ([res ((xstruct-post-decode xs) res port parent)]
(let* ([res (post-decode xs res)]
#;[res (inner res post-decode res . args)])
(unless (d:dict? res) (raise-result-error 'xstruct-decode "dict" res))
res)))
(define (xstruct-size xs [val #f] #:parent [parent-arg #f] [include-pointers #t])
(define/finalize-size (xstruct-size xs [val #f] #:parent [parent-arg #f] [include-pointers #t])
(define parent (mhasheq 'parent parent-arg
'val val
'pointerSize 0))
'val val
'pointerSize 0))
(define fields-size (for/sum ([(key type) (d:in-dict (xstruct-fields xs))]
#:when (xenomorphic? type))
(size type (and val (d:dict-ref val key)) #:parent parent)))
#:when (xenomorphic? type))
(size type (and val (d:dict-ref val key)) #:parent parent)))
(define pointers-size (if include-pointers (d:dict-ref parent 'pointerSize) 0))
(finalize-size (+ fields-size pointers-size)))
(+ fields-size pointers-size))
(define (xstruct-encode xs val-arg [port-arg (current-output-port)] #:parent [parent-arg #f])
(unless (d:dict? val-arg)
@ -81,7 +81,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(parameterize ([current-output-port port])
;; check keys first, since `size` also relies on keys being valid
(define val (let* ([val ((xstruct-pre-encode xs) val-arg port)]
(define val (let* ([val (pre-encode xs val-arg)]
#;[val (inner res pre-encode val . args)])
(unless (d:dict? val) (raise-result-error 'xstruct-encode "dict" val))
val))
@ -90,10 +90,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(format "dict that contains superset of Struct keys: ~a" (d:dict-keys (xstruct-fields xs))) (d:dict-keys val)))
(define parent (mhash 'pointers empty
'startOffset (pos port)
'parent parent-arg
'val val
'pointerSize 0))
'startOffset (pos port)
'parent parent-arg
'val val
'pointerSize 0))
; deliberately use `xstruct-size` instead of `size` to use extra arg
(d:dict-set! parent 'pointerOffset (+ (pos port) (xstruct-size xs val #:parent parent #f)))
@ -104,17 +104,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(encode (d:dict-ref ptr 'type) (d:dict-ref ptr 'val) #:parent (d:dict-ref ptr 'parent)))
(unless port-arg (get-output-bytes port))))
(struct structish () #:transparent)
(struct xstruct structish (fields post-decode pre-encode) #:transparent #:mutable
(struct structish xbase () #:transparent)
(struct xstruct structish (fields) #:transparent #:mutable
#:methods gen:xenomorphic
[(define decode xstruct-decode)
(define encode xstruct-encode)
(define size xstruct-size)])
(define (+xstruct [fields null] [post-decode (λ (val port parent) val)] [pre-encode (λ (val port) val)])
(define (+xstruct [fields null])
(unless (d:dict? fields)
(raise-argument-error '+xstruct "dict" fields))
(xstruct fields post-decode pre-encode))
(xstruct fields))
(module+ test
(require rackunit "number.rkt")

Loading…
Cancel
Save