ctx → parent

xenomorph/xenomorph/redo/array.rkt

@@ -10,7 +10,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 (define (xarray-decode xa [port-arg (current-input-port)] #:parent [parent #f])
   (define port (->input-port port-arg))
   (parameterize ([current-input-port port])
-    (define ctx (if (xint? (xarray-base-len xa))
+    (define new-parent (if (xint? (xarray-base-len xa))
                     (mhasheq 'parent parent
                              '_startOffset (pos port)
                              '_currentOffset 0
@@ -28,10 +28,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
                          [else +inf.0]))
        (for/list ([i (in-naturals)]
                   #:break (or (eof-object? (peek-byte)) (= (pos port) end-pos)))
-         (decode (xarray-base-type xa) #:parent ctx))]
+         (decode (xarray-base-type xa) #:parent new-parent))]
       ;; we have decoded-len, which is treated as count of items
       [else (for/list ([i (in-range decoded-len)])
-              (decode (xarray-base-type xa) #:parent ctx))])))
+              (decode (xarray-base-type xa) #:parent new-parent))])))
 
 (define (xarray-encode xa array [port-arg (current-output-port)] #:parent [parent #f])
   (unless (sequence? array)

xenomorph/xenomorph/redo/bitfield.rkt

@@ -26,7 +26,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
     (encode (xbitfield-type xb) bit-int)
     (unless port-arg (get-output-bytes port))))
 
-(define (xbitfield-size xb [val #f] [ctx #f])
+(define (xbitfield-size xb [val #f] [parent #f])
   (size (xbitfield-type xb)))
 
 (struct xbitfield (type flags) #:transparent

xenomorph/xenomorph/redo/lazy-array.rkt

@@ -32,8 +32,8 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
 (define (xlazy-array-encode xla val [port-arg (current-output-port)] #:parent [parent #f])
   (xarray-encode xla (if (stream? val) (stream->list val) val) port-arg #:parent parent))
 
-(define (xlazy-array-size xla [val #f] [ctx #f])
-  (xarray-size xla (if (stream? val) (stream->list val) val) ctx))
+(define (xlazy-array-size xla [val #f] [parent #f])
+  (xarray-size xla (if (stream? val) (stream->list val) val) parent))
 
 ;; xarray-base holds type and len fields
 (struct xlazy-array xarray-base () #:transparent

xenomorph/xenomorph/redo/pointer.rkt

@@ -9,25 +9,25 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
 |#
 
-(define (find-top-ctx ctx)
+(define (find-top-parent parent)
   (cond
-    [(dict-ref ctx 'parent #f) => find-top-ctx]
-    [else ctx]))
+    [(dict-ref parent 'parent #f) => find-top-parent]
+    [else parent]))
 
-(define (xpointer-decode xp [port-arg (current-input-port)] #:parent [ctx #f])
+(define (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 ctx))
+  (define offset (decode (xpointer-offset-type xp) #:parent parent))
   (cond
     [(and allow-null (= offset (null-value xp))) #f] ; handle null pointers
     [else
      (define relative (+ (case (pointer-style xp)
-                           [(local) (dict-ref ctx '_startOffset)]
+                           [(local) (dict-ref parent '_startOffset)]
                            [(immediate) (- (pos port) (size (xpointer-offset-type xp)))]
-                           [(parent) (dict-ref (dict-ref ctx 'parent) '_startOffset)]
-                           [(global) (or (dict-ref (find-top-ctx ctx) '_startOffset) 0)]
+                           [(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) ctx)))
+                         ((relative-getter-or-0 xp) parent)))
      (define ptr (+ offset relative))
      (cond
        [(xpointer-type xp)
@@ -38,7 +38,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
             [else
              (define orig-pos (pos port))
              (pos port ptr)
-             (set! val (decode (xpointer-type xp) #:parent ctx))
+             (set! val (decode (xpointer-type xp) #:parent parent))
              (pos port orig-pos)
              val]))
         (if (lazy xp)
@@ -52,44 +52,42 @@ 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 [ctx #f])
+(define (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 ctx ; todo: furnish default pointer context? adapt from Struct?
-    (raise-argument-error 'xpointer-encode "valid pointer context" ctx))
+  (unless parent ; todo: furnish default pointer context? adapt from Struct?
+    (raise-argument-error 'xpointer-encode "valid pointer context" parent))
   (parameterize ([current-output-port port])
   (if (not val)
       (encode (xpointer-offset-type xp) (null-value xp) port)
-      (let* ([parent ctx]
-             [ctx (case (pointer-style xp)
-                    [(local immediate) ctx]
-                    [(parent) (dict-ref ctx 'parent)]
-                    [(global) (find-top-ctx ctx)]
+      (let* ([new-parent (case (pointer-style xp)
+                    [(local immediate) parent]
+                    [(parent) (dict-ref parent 'parent)]
+                    [(global) (find-top-parent parent)]
                     [else (error 'unknown-pointer-style)])]
              [relative (+ (case (pointer-style xp)
-                            [(local parent) (dict-ref ctx 'startOffset)]
+                            [(local parent) (dict-ref new-parent 'startOffset)]
                             [(immediate) (+ (pos port) (size (xpointer-offset-type xp) val parent))]
                             [(global) 0])
                           ((relative-getter-or-0 xp) (dict-ref parent 'val #f)))])
-        (encode (xpointer-offset-type xp) (- (dict-ref ctx 'pointerOffset) relative))
+        (encode (xpointer-offset-type xp) (- (dict-ref new-parent 'pointerOffset) relative))
         (let-values ([(type val) (resolve-void-pointer (xpointer-type xp) val)])
-          (dict-set! ctx 'pointers (append (dict-ref ctx 'pointers)
+          (dict-set! new-parent 'pointers (append (dict-ref new-parent 'pointers)
                                            (list (mhasheq 'type type
                                                           'val val
                                                           'parent parent))))
-          (dict-set! ctx 'pointerOffset (+ (dict-ref ctx 'pointerOffset) (size type val parent)))))))
+          (dict-set! new-parent 'pointerOffset (+ (dict-ref new-parent 'pointerOffset) (size type val parent)))))))
   (unless port-arg (get-output-bytes port)))
 
-(define (xpointer-size xp [val #f] [ctx #f])
-  (let*-values ([(parent) ctx]
-                [(ctx) (case (pointer-style xp)
-                         [(local immediate) ctx]
-                         [(parent) (dict-ref ctx 'parent)]
-                         [(global) (find-top-ctx ctx)]
+(define (xpointer-size xp [val #f] [parent #f])
+  (let*-values ([(parent) (case (pointer-style xp)
+                         [(local immediate) parent]
+                         [(parent) (dict-ref parent 'parent)]
+                         [(global) (find-top-parent parent)]
                          [else (error 'unknown-pointer-style)])]
                 [(type val) (resolve-void-pointer (xpointer-type xp) val)])
-    (when (and val ctx)
-      (dict-set! ctx 'pointerSize (and (dict-ref ctx 'pointerSize #f)
-                                       (+ (dict-ref ctx 'pointerSize) (size type val parent)))))
+    (when (and val parent)
+      (dict-set! parent 'pointerSize (and (dict-ref parent 'pointerSize #f)
+                                       (+ (dict-ref parent 'pointerSize) (size type val parent)))))
     (size (xpointer-offset-type xp))))
 
 (struct xpointer (offset-type type options) #:transparent
@@ -105,7 +103,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
 (define (allow-null xp) (or (dict-ref (xpointer-options xp) 'allowNull #f) #t)) 
 (define (null-value xp) (or (dict-ref (xpointer-options xp) 'nullValue #f) 0))
 (define (lazy xp) (dict-ref (xpointer-options xp) 'lazy #f))
-(define (relative-getter-or-0 xp) (or (dict-ref (xpointer-options xp) 'relativeTo #f) (λ (ctx) 0))) ; changed this to a simple lambda
+(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)

xenomorph/xenomorph/redo/struct.rkt

@@ -1,5 +1,5 @@
 #lang debug racket/base
-(require (prefix-in d: racket/dict) racket/list "helper.rkt" "util.rkt" "number.rkt" sugar/unstable/dict)
+(require (prefix-in d: racket/dict) racket/list "helper.rkt" "number.rkt" sugar/unstable/dict)
 (provide (all-defined-out))
 
 #|
@@ -65,16 +65,16 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
       (unless (d:dict? res) (raise-result-error 'xstruct-decode "dict" res))
       res)))
 
-(define (xstruct-size xs [val #f] [parent #f] [include-pointers #t])
-  (define ctx (mhasheq 'parent parent
+(define (xstruct-size xs [val #f] [parent-arg #f] [include-pointers #t])
+  (define parent (mhasheq 'parent parent-arg
                        'val val
                        'pointerSize 0))
   (+ (for/sum ([(key type) (d:in-dict (xstruct-fields xs))]
                #:when (xenomorphic? type))
-       (size type (and val (d:dict-ref val key)) ctx))
-     (if include-pointers (d:dict-ref ctx 'pointerSize) 0)))
+       (size type (and val (d:dict-ref val key)) parent))
+     (if include-pointers (d:dict-ref parent 'pointerSize) 0)))
 
-(define (xstruct-encode xs val-arg [port-arg (current-output-port)] #:parent [parent #f])
+(define (xstruct-encode xs val-arg [port-arg (current-output-port)] #:parent [parent-arg #f])
   (unless (d:dict? val-arg)
     (raise-argument-error 'xstruct-encode "dict" val-arg))
   (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
@@ -88,18 +88,18 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
       (raise-argument-error 'xstruct-encode
                             (format "dict that contains superset of Struct keys: ~a" (d:dict-keys (xstruct-fields xs))) (d:dict-keys val)))
 
-    (define ctx (mhash 'pointers empty
+    (define parent (mhash 'pointers empty
                        'startOffset (pos port)
-                       'parent parent
+                       'parent parent-arg
                        'val val
                        'pointerSize 0))
 
     ; deliberately use `xstruct-size` instead of `size` to use extra arg
-    (d:dict-set! ctx 'pointerOffset (+ (pos port) (xstruct-size xs val ctx #f))) 
+    (d:dict-set! parent 'pointerOffset (+ (pos port) (xstruct-size xs val parent #f))) 
 
     (for ([(key type) (d:in-dict (xstruct-fields xs))])
-      (encode type (d:dict-ref val key) #:parent ctx))
-    (for ([ptr (in-list (d:dict-ref ctx 'pointers))])
+      (encode type (d:dict-ref val key) #:parent parent))
+    (for ([ptr (in-list (d:dict-ref parent 'pointers))])
       (encode (d:dict-ref ptr 'type) (d:dict-ref ptr 'val) #:parent (d:dict-ref ptr 'parent)))
     (unless port-arg (get-output-bytes port))))
 
@@ -110,7 +110,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
    (define encode xstruct-encode)
    (define size xstruct-size)])
 
-(define (+xstruct [fields null] [post-decode (λ (val port ctx) val)] [pre-encode (λ (val port) val)])
+(define (+xstruct [fields null] [post-decode (λ (val port parent) val)] [pre-encode (λ (val port) val)])
   (unless (d:dict? fields)
     (raise-argument-error '+xstruct "dict" fields))
   (xstruct fields post-decode pre-encode))

xenomorph/xenomorph/redo/versioned-struct.rkt

@@ -34,26 +34,26 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
      [else (_parse-fields port res fields)
            res]) port parent))
 
-(define (xversioned-struct-size xvs [val #f] [parent #f] [include-pointers #t])
+(define (xversioned-struct-size xvs [val #f] [parent-arg #f] [include-pointers #t])
   (unless val
     (raise-argument-error 'xversioned-struct-size "value" val))
-  (define ctx (mhash 'parent parent 'val val 'pointerSize 0))
+  (define parent (mhash 'parent parent-arg 'val val 'pointerSize 0))
   (define version-size
     (if (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs))))
-        (size (xversioned-struct-type xvs) (dict-ref val 'version) ctx)
+        (size (xversioned-struct-type xvs) (dict-ref val 'version) parent)
         0))
   (define header-size
     (for/sum ([(key type) (in-dict (or (dict-ref (xversioned-struct-versions xvs) 'header #f) null))])
-      (size type (and val (dict-ref val key)) ctx)))
+      (size type (and val (dict-ref val key)) parent)))
   (define fields-size
     (let ([fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version))
                       (raise-argument-error 'xversioned-struct-size "valid version key" version))])
       (for/sum ([(key type) (in-dict fields)])
-        (size type (and val (dict-ref val key)) ctx))))
-  (define pointer-size (if include-pointers (dict-ref ctx 'pointerSize) 0))
+        (size type (and val (dict-ref val key)) parent))))
+  (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0))
   (+ version-size header-size fields-size pointer-size))
 
-(define (xversioned-struct-encode xvs val-arg [port-arg (current-output-port)] #:parent [parent #f])
+(define (xversioned-struct-encode xvs val-arg [port-arg (current-output-port)] #:parent [parent-arg #f])
   (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
   (parameterize ([current-output-port port])
   (define val ((xversioned-struct-pre-encode xvs) val-arg port))
@@ -61,19 +61,19 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
   (unless (dict? val)
     (raise-argument-error 'xversioned-struct-encode "dict" val))
 
-  (define ctx (mhash 'pointers null
+  (define parent (mhash 'pointers null
                      'startOffset (pos port)
-                     'parent parent
+                     'parent parent-arg
                      'val val
                      'pointerSize 0))
-  (dict-set! ctx 'pointerOffset (+ (pos port) (xversioned-struct-size xvs val ctx #f)))
+  (dict-set! parent 'pointerOffset (+ (pos port) (xversioned-struct-size xvs val parent #f)))
 
   (when (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs))))
     (encode (xversioned-struct-type xvs) (dict-ref val 'version #f)))
 
   (when (dict-ref (xversioned-struct-versions xvs) 'header #f)
     (for ([(key type) (in-dict (dict-ref (xversioned-struct-versions xvs) 'header))])
-      (encode type (dict-ref val key) #:parent ctx)))
+      (encode type (dict-ref val key) #:parent parent)))
 
   (define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version #f))
                      (raise-argument-error 'xversioned-struct-encode "valid version key" version)))
@@ -82,8 +82,8 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
     (raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val)))
 
   (for ([(key type) (in-dict fields)])
-    (encode type (dict-ref val key) #:parent ctx))
-  (for ([ptr (in-list (dict-ref ctx 'pointers))])
+    (encode type (dict-ref val key) #:parent parent))
+  (for ([ptr (in-list (dict-ref parent 'pointers))])
     (encode (dict-ref ptr 'type) (dict-ref ptr 'val) #:parent (dict-ref ptr 'parent)))
   
   (unless port-arg (get-output-bytes port))))
@@ -110,143 +110,3 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
   (define (no-op-post-decode xvs port ctx) xvs)
   (xversioned-struct type versions version-getter version-setter no-op-pre-encode no-op-post-decode))
 
-#|
-(define-subclass Struct (VersionedStruct type [versions (dictify)])
-  
-  (unless (for/or ([proc (list integer? procedure? xenomorph-base%? symbol?)])
-            (proc type))
-    (raise-argument-error 'VersionedStruct "integer, function, symbol, or Restructure object" type))
-  (unless (and (dict? versions) (andmap (λ (val) (or (dict? val) (Struct? val))) (map cdr versions)))
-    (raise-argument-error 'VersionedStruct "dict of dicts or Structs" versions))
-
-  (inherit _setup  _parse-fields post-decode)
-  (inherit-field fields)
-  (field [forced-version #f]
-         [versionGetter void]
-         [versionSetter void])
-
-  (when (or (key? type) (procedure? type))
-    (set-field! versionGetter this (if (procedure? type)
-                                       type
-                                       (λ (parent) (ref parent type))))
-    (set-field! versionSetter this (if (procedure? type)
-                                       type
-                                       (λ (parent version) (ref-set! parent type version)))))
-
-  (define/override (decode stream [parent #f] [length 0])
-    (define res (_setup stream parent length))
-
-    (ref-set! res 'version
-              (cond
-                [forced-version] ; for testing purposes: pass an explicit version
-                [(or (key? type) (procedure? type))
-                 (unless parent
-                   (raise-argument-error 'VersionedStruct:decode "valid parent" parent))
-                 (versionGetter parent)]
-                [else (send type decode stream)]))
-
-    (when (ref versions 'header)
-      (_parse-fields stream res (ref versions 'header)))
-    
-    (define fields (or (ref versions (ref res 'version)) (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions)))))
-
-    
-    (cond
-      [(VersionedStruct? fields) (send fields decode stream parent)]
-      [else
-       (_parse-fields stream res fields)
-       res]))
-  
-  (define/public-final (force-version! version)
-    (set! forced-version version))  
-
-  (define/override (encode stream val [parent #f])
-    (unless (hash? val)
-      (raise-argument-error 'VersionedStruct:encode "hash" val))
-
-    (define ctx (mhash 'pointers empty
-                       'startOffset (pos stream)
-                       'parent parent
-                       'val val
-                       'pointerSize 0))
-
-    (ref-set! ctx 'pointerOffset (+ (pos stream) (size val ctx #f)))
-
-    (when (not (or (key? type) (procedure? type)))
-      (send type encode stream (or forced-version (· val version))))
-
-    (when (ref versions 'header)
-      (for ([(key type) (in-dict (ref versions 'header))])
-           (send type encode stream (ref val key) ctx)))
-
-    (define fields (or (ref versions (or forced-version (· val version))) (raise-argument-error 'VersionedStruct:encode "valid version key" version)))
-
-    (unless (andmap (λ (key) (member key (ref-keys val))) (ref-keys fields))
-      (raise-argument-error 'VersionedStruct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val)))
-
-    (for ([(key type) (in-dict fields)])
-         (send type encode stream (ref val key) ctx))
-
-    (for ([ptr (in-list (ref ctx 'pointers))])
-         (send (ref ptr 'type) encode stream (ref ptr 'val) (ref ptr 'parent))))
-
-  
-  (define/override (size [val #f] [parent #f] [includePointers #t])
-    (unless (or val forced-version)
-      (raise-argument-error 'VersionedStruct:size "value" val))
-
-    (define ctx (mhash 'parent parent
-                       'val val
-                       'pointerSize 0))
-
-    (+ (if (not (or (key? type) (procedure? type)))
-           (send type size (or forced-version (ref val 'version)) ctx)
-           0)
-       
-       (for/sum ([(key type) (in-dict (or (ref versions 'header) empty))])
-                (send type size (and val (ref val key)) ctx))
-
-       (let ([fields (or (ref versions (or forced-version (ref val 'version)))
-                         (raise-argument-error 'VersionedStruct:encode "valid version key" version))])
-         (for/sum ([(key type) (in-dict fields)])
-                  (send type size (and val (ref val key)) ctx)))
-
-       (if includePointers (ref ctx 'pointerSize) 0))))
-
-|#
-
-#;(test-module
-   (require "number.rkt")
-   (define (random-pick xs) (list-ref xs (random (length xs))))
-   (check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42)))
-
-   ;; make random versioned structs and make sure we can round trip
-   #;(for ([i (in-range 1)])
-       (define field-types (for/list ([i (in-range 1)])
-                             (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
-       (define num-versions 20)
-       (define which-struct (random num-versions))
-       (define struct-versions (for/list ([v (in-range num-versions)])
-                                 (cons v (for/list ([num-type (in-list field-types)])
-                                           (cons (gensym) num-type)))))
-       (define vs (+VersionedStruct which-struct struct-versions))
-       (define struct-size (for/sum ([num-type (in-list (map cdr (ref struct-versions which-struct)))])
-                             (send num-type size)))
-       (define bs (apply bytes (for/list ([i (in-range struct-size)])
-                                 (random 256))))
-       (check-equal? (send vs encode #f (send vs decode bs)) bs))
-
-   (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
-   (check-equal? (send s size) 3)
-   (define vs (+VersionedStruct uint8 (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s))))
-   (send vs force-version! 1)
-   (check-equal? (send vs size) 6)
-   #|
-   (define s2 (+Struct (dictify 'a vs)))
-   (check-equal? (send s2 size) 6)
-   (define vs2 (+VersionedStruct (λ (p) 2) (dictify 1 vs 2 vs)))
-   (check-equal? (send vs2 size) 6)
-|#
-   )
-
-