avoid internal interface

main
Matthew Butterick 6 years ago
parent fe70bdf3d8
commit 0214d3f0a7

@ -23,7 +23,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
(unless (boolean? @count-bytes?)
(raise-argument-error 'x:array "boolean" @count-bytes?))
(define/augride (:decode port parent)
(define/augride (decode port parent)
(define new-parent (if (x:int? @len)
(mhasheq x:parent-key parent
x:start-offset-key (pos port)
@ -48,7 +48,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
[else (for/list ([i (in-range len)])
(send @type decode port new-parent))]))
(define/augride (:encode array port [parent #f])
(define/augride (encode array port [parent #f])
(unless (sequence? array)
(raise-argument-error 'xarray-encode "sequence" array))
(define (encode-items parent)
@ -58,32 +58,32 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
#;[item-count (length items)]
#;[max-items (if (number? (xarray-len xa)) (xarray-len xa) item-count)])
(for ([item array])
(send @type :encode item port parent))))
(send @type encode item port parent))))
(cond
[(x:int? @len)
(define new-parent (mhasheq x:pointers-key null
x:start-offset-key (pos port)
x:parent-key parent))
(hash-set! new-parent x:pointer-offset-key (+ (pos port) (:size array new-parent)))
(send @len :encode (length array) port) ; encode length at front
(hash-set! new-parent x:pointer-offset-key (+ (pos port) (size array new-parent)))
(send @len encode (length array) port) ; encode length at front
(encode-items new-parent)
(for ([ptr (in-list (hash-ref new-parent x:pointers-key))]) ; encode pointer data at end
(send (x:ptr-type ptr) :encode (x:ptr-val ptr) port))]
(send (x:ptr-type ptr) encode (x:ptr-val ptr) port))]
[else (encode-items parent)]))
(define/augride (:size [val #f] [parent #f])
(define/augride (size [val #f] [parent #f])
(when val (unless (sequence? val)
(raise-argument-error 'xarray-size "sequence" val)))
(cond
[val (define-values (new-parent len-size)
(if (x:int? @len)
(values (mhasheq x:parent-key parent) (send @len :size))
(values (mhasheq x:parent-key parent) (send @len size))
(values parent 0)))
(define items-size (for/sum ([item val])
(send @type :size item new-parent)))
(send @type size item new-parent)))
(+ items-size len-size)]
[else (define count (resolve-length @len #f parent))
(define size (send @type :size #f parent))
(define size (send @type size #f parent))
(* size count)]))))
(define (x:array [type-arg #f] [len-arg #f] [length-type-arg 'count]

@ -39,11 +39,11 @@
(define (encode xo val [port-arg (current-output-port)]
#:parent [parent #f])
(define port (if (output-port? port-arg) port-arg (open-output-bytes)))
(send xo :encode val port parent)
(send xo encode val port parent)
(unless port-arg (get-output-bytes port)))
(define (size xo [val #f] #:parent [parent #f])
(send xo :size val parent))
(send xo size val parent))
(define (xenomorphic-type? x) (is-a? x xenobase%))
(define xenomorphic? xenomorphic-type?)
@ -69,21 +69,18 @@
(class object%
(super-new)
(define/pubment (:decode input-port [parent #f])
(post-decode (inner (error 'decode-not-augmented) :decode input-port parent)))
(define/public (decode input-port [parent #f])
(:decode input-port parent))
(define/pubment (decode input-port [parent #f])
(post-decode (inner (error 'decode-not-augmented) decode input-port parent)))
(define/pubment (:encode val output-port [parent #f])
(define encode-result (inner (error 'encode-not-augmented) :encode (pre-encode val) output-port parent))
(define/pubment (encode val output-port [parent #f])
(define encode-result (inner (error 'encode-not-augmented) encode (pre-encode val) output-port parent))
(when (bytes? encode-result) (write-bytes encode-result output-port)))
(define/pubment (:size [val #f] [parent #f] . args)
(define size (inner 0 :size val parent . args))
(unless (and (integer? size) (not (negative? size)))
(raise-argument-error 'size "nonnegative integer" size))
size)
(define/pubment (size [val #f] [parent #f] . args)
(define asize (inner 0 size val parent . args))
(unless (and (integer? asize) (not (negative? asize)))
(raise-argument-error 'size "nonnegative integer" asize))
asize)
(define/public (post-decode val) val)
(define/public (pre-encode val) val)))

@ -14,22 +14,22 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
(unless (andmap (λ (f) (or (symbol? f) (not f))) @flags)
(raise-argument-error '+xbitfield "list of symbols" @flags))
(define/augment (:decode port parent)
(define val (send @type :decode port))
(define/augment (decode port parent)
(define val (send @type decode port))
(define flag-hash (mhasheq))
(for ([(flag idx) (in-indexed @flags)]
#:when flag)
(hash-set! flag-hash flag (bitwise-bit-set? val idx)))
flag-hash)
(define/augment (:encode flag-hash port [parent #f])
(define/augment (encode flag-hash port [parent #f])
(define bit-int (for/sum ([(flag idx) (in-indexed @flags)]
#:when (and flag (hash-ref flag-hash flag #f)))
(arithmetic-shift 1 idx)))
(send @type :encode bit-int port))
(send @type encode bit-int port))
(define/augment (:size [val #f] [parent #f])
(send @type :size))))
(define/augment (size [val #f] [parent #f])
(send @type size))))
(define (x:bitfield [type-arg #f] [flag-arg #f]
#:type [type-kwarg #f]

@ -14,17 +14,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
(unless (length-resolvable? @len)
(raise-argument-error 'x:buffer "resolvable length" @len))
(define/augment (:decode port parent)
(define/augment (decode port parent)
(read-bytes (resolve-length @len port parent)))
(define/augment (:encode buf port [parent #f])
(define/augment (encode buf port [parent #f])
(unless (bytes? buf)
(raise-argument-error 'x:buffer-encode "bytes" buf))
(when (x:int? @len)
(send @len :encode (bytes-length buf) port))
(send @len encode (bytes-length buf) port))
(write-bytes buf port))
(define/augment (:size [val #f] [parent #f])
(define/augment (size [val #f] [parent #f])
(match val
[(? bytes?) (bytes-length val)]
[(== #false) (resolve-length @len val parent)]

@ -17,17 +17,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
(unless (list? @values)
(raise-argument-error 'x:enum "list of values" @values))
(define/augment (:decode port parent)
(define index (send @type :decode port parent))
(define/augment (decode port parent)
(define index (send @type decode port parent))
(or (list-ref @values index) index))
(define/augment (:encode val port [parent #f])
(define/augment (encode val port [parent #f])
(match (index-of @values val)
[(? values idx) (send @type :encode idx port parent)]
[(? values idx) (send @type encode idx port parent)]
[_ (raise-argument-error 'x:enum-encode "valid option" val)]))
(define/augment (:size [val #f] [parent #f])
(send @type :size val parent))))
(define/augment (size [val #f] [parent #f])
(send @type size val parent))))
(define (x:enum [type-arg #f] [values-arg #f]
#:type [type-kwarg #f]

@ -13,7 +13,7 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
(super-new)
(inherit-field [@type type] [@len len])
(define/override (:decode port parent)
(define/override (decode port parent)
(define starting-pos (pos port)) ; ! placement matters. `resolve-length` will change `pos`
(define len (resolve-length @len port parent))
(define new-parent (if (x:int? @len)
@ -26,17 +26,17 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
(begin0
(for/stream ([index (in-range len)])
(define orig-pos (pos port))
(pos port (+ stream-starting-pos (* (send @type :size #f new-parent) index)))
(pos port (+ stream-starting-pos (* (send @type size #f new-parent) index)))
(begin0
(send @type decode port new-parent)
(pos port orig-pos)))
(pos port (+ (pos port) (* len (send @type :size #f new-parent))))))
(pos port (+ (pos port) (* len (send @type size #f new-parent))))))
(define/override (:encode val port [parent #f])
(super :encode (if (stream? val) (stream->list val) val) port parent))
(define/override (encode val port [parent #f])
(super encode (if (stream? val) (stream->list val) val) port parent))
(define/override (:size [val #f] [parent #f])
(super :size (if (stream? val) (stream->list val) val) parent))))
(define/override (size [val #f] [parent #f])
(super size (if (stream? val) (stream->list val) val) parent))))
(define (x:lazy-array [type-arg #f] [len-arg #f]
#:type [type-kwarg #f]

@ -16,4 +16,5 @@
"reserved.rkt"
"string.rkt"
"struct.rkt"
"versioned-struct.rkt")
"versioned-struct.rkt"
"util.rkt")

@ -35,7 +35,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(field [@bits (* @size 8)])
(define/augment (:size . _) @size)))
(define/augment (size . _) @size)))
(define (x:int? x) (is-a? x x:int%))
@ -53,14 +53,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(field [bound-min (- signed-min delta)]
[bound-max (- signed-max delta)])
(define/augment (:decode port . _)
(define/augment (decode port . _)
(define bs ((if (eq? @endian system-endian) values reverse-bytes) (read-bytes @size port)))
(define uint (for/sum ([b (in-bytes bs)]
[i (in-naturals)])
(arithmetic-shift b (* 8 i))))
(if signed (unsigned->signed uint @bits) uint))
(define/augment (:encode val . _)
(define/augment (encode val . _)
(unless (<= bound-min val bound-max)
(raise-argument-error 'encode
(format "value that fits within ~a ~a-byte int (~a to ~a)" (if signed "signed" "unsigned") @size bound-min bound-max) val))
@ -154,10 +154,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
(super-new)
(inherit-field (@size size) (@endian endian))
(define/augment (:decode port . _)
(define/augment (decode port . _)
(floating-point-bytes->real (read-bytes @size port) (eq? @endian 'be)))
(define/augment (:encode val . _)
(define/augment (encode val . _)
(real->floating-point-bytes val @size (eq? @endian 'be)))))
(define (x:float [size 4] #:endian [endian system-endian]

@ -20,16 +20,16 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee
[(? procedure? proc) (proc parent)]
[val val]))
(define/augment (:decode port parent)
(define/augment (decode port parent)
(when (resolve-condition parent)
(send @type :decode port parent)))
(send @type decode port parent)))
(define/augment (:encode val port [parent #f])
(define/augment (encode val port [parent #f])
(when (resolve-condition parent)
(send @type :encode val port parent)))
(send @type encode val port parent)))
(define/augment (:size [val #f] [parent #f])
(if (resolve-condition parent) (send @type :size val parent) 0))))
(define/augment (size [val #f] [parent #f])
(if (resolve-condition parent) (send @type size val parent) 0))))
(define no-val (gensym))
(define (x:optional [type-arg #f] [cond-arg no-val]

@ -33,14 +33,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[(@null-value null-value)]
[(@pointer-lazy? pointer-lazy?)])
(define/augment (:decode port parent)
(define offset (send @offset-type :decode port parent))
(define/augride (decode port parent)
(define offset (send @offset-type decode port parent))
(cond
[(and @allow-null? (= offset @null-value)) #false] ; handle null pointers
[else
(define relative (+ (case @pointer-relative-to
[(local) (hash-ref parent x:start-offset-key)]
[(immediate) (- (pos port) (send @offset-type :size))]
[(immediate) (- (pos port) (send @offset-type size))]
[(parent) (hash-ref (hash-ref parent x:parent-key) x:start-offset-key)]
[(global) (or (hash-ref (find-top-parent parent) x:start-offset-key) 0)]
[else (error 'unknown-pointer-style)])))
@ -55,7 +55,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(if @pointer-lazy? (delay (decode-value)) (decode-value))]
[else ptr])]))
(define/augment (:encode val-in port [parent #f])
(define/augride (encode val-in port [parent #f])
(unless parent ; todo: furnish default pointer context? adapt from Struct?
(raise-argument-error 'xpointer-encode "valid pointer context" parent))
(cond
@ -67,17 +67,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
[else (error 'unknown-pointer-style)]))
(define relative (+ (case @pointer-relative-to
[(local parent) (hash-ref new-parent x:start-offset-key)]
[(immediate) (+ (pos port) (send @offset-type :size val-in parent))]
[(immediate) (+ (pos port) (send @offset-type size val-in parent))]
[(global) 0])))
(send @offset-type :encode (- (hash-ref new-parent x:pointer-offset-key) relative) port)
(send @offset-type encode (- (hash-ref new-parent x:pointer-offset-key) relative) port)
(define-values (type val) (resolve-pointer @type val-in))
(hash-update! new-parent x:pointers-key
(λ (ptrs) (append ptrs (list (x:ptr type val parent)))))
(hash-set! new-parent x:pointer-offset-key
(+ (hash-ref new-parent x:pointer-offset-key) (send type :size val parent)))]
[else (send @offset-type :encode @null-value port)]))
(+ (hash-ref new-parent x:pointer-offset-key) (send type size val parent)))]
[else (send @offset-type encode @null-value port)]))
(define/augment (:size [val-in #f] [parent #f])
(define/augride (size [val-in #f] [parent #f])
(define new-parent (case @pointer-relative-to
[(local immediate) parent]
[(parent) (hash-ref parent x:parent-key)]
@ -87,8 +87,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
(when (and val new-parent)
(hash-set! new-parent x:pointer-size-key
(and (hash-ref new-parent x:pointer-size-key #f)
(+ (hash-ref new-parent x:pointer-size-key) (send type :size val new-parent)))))
(send @offset-type :size))))
(+ (hash-ref new-parent x:pointer-size-key) (send type size val new-parent)))))
(send @offset-type size))))
(define (x:pointer [offset-arg #f] [type-arg #f]
#:offset-type [offset-kwarg #f]

@ -15,15 +15,15 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
(unless (xenomorphic-type? @type)
(raise-argument-error '+xoptional "xenomorphic type" @type))
(define/augment (:decode port parent)
(pos port (+ (pos port) (:size #f parent)))
(define/augment (decode port parent)
(pos port (+ (pos port) (size #f parent)))
(void))
(define/augment (:encode val port [parent #f])
(make-bytes (:size val parent) 0))
(define/augment (encode val port [parent #f])
(make-bytes (size val parent) 0))
(define/augment (:size [val #f] [parent #f])
(* (send @type :size) (resolve-length @count #f parent)))))
(define/augment (size [val #f] [parent #f])
(* (send @type size) (resolve-length @count #f parent)))))
(define (x:reserved [type-arg #f] [count-arg #f]
#:type [type-kwarg #f]

@ -38,7 +38,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(unless (or (procedure? @encoding) (memq @encoding supported-encodings))
(raise-argument-error 'xstring (format "procedure or member of ~v" supported-encodings) @encoding))
(define/augment (:decode port parent)
(define/augment (decode port parent)
(define len (or (resolve-length @len port parent) (count-nonzero-chars port)))
(define encoding (match @encoding
[(? procedure? proc) (or (proc parent) 'ascii)]
@ -48,7 +48,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(decode-string len port encoding)
(pos port (+ (pos port) adjustment))))
(define/augment (:encode val-arg port [parent #f])
(define/augment (encode val-arg port [parent #f])
(define val (if (string? val-arg) val-arg (format "~a" val-arg)))
(define encoding (match @encoding
[(? procedure?) (@encoding (and parent (hash-ref parent val)) 'ascii)]
@ -58,11 +58,11 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(when (and (exact-nonnegative-integer? @len) (> encoded-length @len))
(raise-argument-error 'xstring-encode (format "string no longer than ~a" @len) val))
(when (x:int? @len)
(send @len :encode encoded-length port parent))
(send @len encode encoded-length port parent))
(define string-terminator (if @len (bytes) (bytes 0))) ; null terminated when no len
(bytes-append encoded-str string-terminator))
(define/augment (:size [val-arg #f] [parent #f])
(define/augment (size [val-arg #f] [parent #f])
(define val (cond
[(string? val-arg) val-arg]
[(not val-arg) #false]
@ -74,7 +74,7 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
(define string-size (bytes-length (encode-string val encoding)))
(define strlen-size (cond
[(not @len) 1]
[(x:int? @len) (send @len :size)]
[(x:int? @len) (send @len size)]
[else 0]))
(+ string-size strlen-size)]
[else (resolve-length @len #f parent)]))))

@ -51,14 +51,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(when @fields (unless (dict? @fields)
(raise-argument-error '+xstruct "dict" @fields)))
(define/augride (:decode port parent [len 0])
(define/augride (decode port parent [len 0])
(define res (setup-private-fields port parent len))
(parse-fields port res @fields))
(define/override (decode port parent)
(dict->mutable-hash (:decode port parent)))
(define/override (post-decode val)
(dict->mutable-hash val))
(define/augride (:encode field-data port [parent-arg #f])
(define/augride (encode field-data port [parent-arg #f])
(unless (dict? field-data)
(raise-result-error 'x:struct-encode "dict" field-data))
;; check keys, because `size` also relies on keys being valid
@ -71,20 +71,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
x:parent-key parent-arg
x:val-key field-data
x:pointer-size-key 0))
(hash-set! parent x:pointer-offset-key (+ (pos port) (:size field-data parent #f)))
(hash-set! parent x:pointer-offset-key (+ (pos port) (size field-data parent #f)))
(for ([(key type) (in-dict @fields)])
(send type :encode (dict-ref field-data key) port parent))
(send type encode (dict-ref field-data key) port parent))
(for ([ptr (in-list (hash-ref parent x:pointers-key))])
(match ptr
[(x:ptr type val parent) (send type :encode val port parent)])))
[(x:ptr type val parent) (send type encode val port parent)])))
(define/augride (:size [val #f] [parent-arg #f] [include-pointers #t])
(define/augride (size [val #f] [parent-arg #f] [include-pointers #t])
(define parent (mhasheq x:parent-key parent-arg
x:val-key val
x:pointer-size-key 0))
(define fields-size (for/sum ([(key type) (in-dict @fields)]
#:when (xenomorphic-type? type))
(send type :size (and val (dict-ref val key)) parent)))
(send type size (and val (dict-ref val key)) parent)))
(define pointers-size (if include-pointers (dict-ref parent x:pointer-size-key) 0))
(+ fields-size pointers-size))))

@ -31,7 +31,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(raise-argument-error 'x:versioned-struct-encode (format "valid field version: ~v" (dict-keys @versions)) version-key)))
(if (x:struct? field-object) (get-field fields field-object) field-object))
(define/override (:decode port parent [length 0])
(define/override (decode port parent [length 0])
(define res (setup-private-fields port parent length))
(define which-version (match @type
[(? integer? int) int]
@ -39,7 +39,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[(? procedure? proc) #:when parent (proc parent)]
[(or (? symbol?) (? procedure?))
(raise-argument-error 'x:versioned-struct-decode "valid parent" parent)]
[_ (send @type :decode port parent)]))
[_ (send @type decode port parent)]))
(dict-set! res x:version-key which-version)
(cond
@ -56,7 +56,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[(? x:versioned-struct?) (send field-object decode port parent)]
[_ (parse-fields port res field-object)]))
(define/override (:encode field-data port [parent-arg #f])
(define/override (encode field-data port [parent-arg #f])
(unless (dict? field-data)
(raise-argument-error 'x:versioned-struct-encode "dict" field-data))
(define parent (mhasheq x:pointers-key null
@ -64,22 +64,22 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
x:parent-key parent-arg
x:val-key field-data
x:pointer-size-key 0))
(hash-set! parent x:pointer-offset-key (+ (pos port) (:size field-data parent #f)))
(hash-set! parent x:pointer-offset-key (+ (pos port) (size field-data parent #f)))
(unless (or (symbol? @type) (procedure? @type))
(send @type :encode (dict-ref field-data x:version-key #f) port parent))
(send @type encode (dict-ref field-data x:version-key #f) port parent))
(for ([(key type) (in-dict (dict-ref @versions 'header null))])
(send type :encode (dict-ref field-data key) port parent))
(send type encode (dict-ref field-data key) port parent))
(define fields (select-field-set field-data))
(unless (andmap (λ (key) (member key (hash-keys field-data))) (dict-keys fields))
(raise-argument-error 'x:versioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys field-data)))
(for ([(key type) (in-dict fields)])
(send type :encode (hash-ref field-data key) port parent))
(send type encode (hash-ref field-data key) port parent))
(for ([ptr (in-list (hash-ref parent x:pointers-key))])
(match ptr
[(x:ptr type val parent) (send type :encode val port parent)])))
[(x:ptr type val parent) (send type encode val port parent)])))
(define/override (:size [val #f] [parent-arg #f] [include-pointers #t])
(define/override (size [val #f] [parent-arg #f] [include-pointers #t])
(unless val
(raise-argument-error 'x:versioned-struct-size "value" val))
(define parent (mhasheq x:parent-key parent-arg
@ -88,14 +88,14 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(define version-size
(match @type
[(or (? symbol?) (? procedure?)) 0]
[_ (send @type :size (dict-ref val x:version-key) parent)]))
[_ (send @type size (dict-ref val x:version-key) parent)]))
(define header-size
(for/sum ([(key type) (in-dict (dict-ref @versions 'header null))])
(send type :size (and val (dict-ref val key)) parent)))
(send type size (and val (dict-ref val key)) parent)))
(define fields-size
(for/sum ([(key type) (in-dict (select-field-set val))])
(send type :size (and val (dict-ref val key)) parent)))
(send type size (and val (dict-ref val key)) parent)))
(define pointer-size (if include-pointers (dict-ref parent x:pointer-size-key) 0))
(+ version-size header-size fields-size pointer-size))))

Loading…
Cancel
Save