hurtz

xenomorph/xenomorph/pointer.rkt

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang debug racket/base
 (require "base.rkt"
          "number.rkt"
          racket/dict
@@ -23,6 +23,26 @@ 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 'x:pointer "VoidPointer" val)]))
 
+(define (pointer-encode this val-in port parent)         
+  (cond
+    [val-in
+     (define new-parent (case (get-field pointer-relative-to this)
+                          [(local immediate) parent]
+                          [(parent) (hash-ref parent x:parent-key)]
+                          [(global) (find-top-parent parent)]
+                          [else (error 'unknown-pointer-style)]))
+     (define relative (+ (case (get-field pointer-relative-to this)
+                           [(local parent) (hash-ref new-parent x:start-offset-key)]
+                           [(immediate) (+ (pos port) (send (get-field offset-type this) size val-in parent))]
+                           [(global) 0])))
+     (send (get-field offset-type this) encode (- (hash-ref new-parent x:pointer-offset-key) relative) port)
+     (define-values (type val) (resolve-pointer (get-field type this) 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 (get-field offset-type this) encode (get-field null-value this) port)]))
+
 (define x:pointer%
   (class x:base%
     (super-new)
@@ -58,24 +78,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
     (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
-        [val-in
-         (define new-parent (case @pointer-relative-to
-                              [(local immediate) parent]
-                              [(parent) (hash-ref parent x:parent-key)]
-                              [(global) (find-top-parent parent)]
-                              [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))]
-                               [(global) 0])))
-         (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)]))
+      (pointer-encode this val-in port parent))
 
     (define/augride (size [val-in #f] [parent #f])
       (define new-parent (case @pointer-relative-to
@@ -130,8 +133,8 @@ This allows the pointer to be calculated relative to a property on the parent. I
 
 ;; A pointer whose type is determined at decode time
 (define x:void-pointer% (class x:base%
-                         (super-new)
-                         (init-field type value)))
+                          (super-new)
+                          (init-field type value)))
 (define (x:void-pointer . args) (apply make-object x:void-pointer% args))
 (define (xvoid-pointer? x) (is-a? x x:void-pointer%))
 (define (xvoid-pointer-type x) (get-field type x))

xenomorph/xenomorph/versioned-struct.rkt

@@ -57,7 +57,6 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
         [_ (parse-fields port res field-object)]))
 
     (define/override (pre-encode val)
-      #R (dict-keys val)
       (cond
         [(and (not (dict-has-key? val x:version-key)) (dict-has-key? val 'version))
          (dict-set val x:version-key (dict-ref val 'version))]
@@ -78,11 +77,11 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
         (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)))
+      (unless (andmap (λ (key) (member key (dict-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)) (dict-keys field-data)))
       (for ([(key type) (in-dict fields)])
-        (send type encode (hash-ref field-data key) port parent))
-      (for ([ptr (in-list (hash-ref parent x:pointers-key))])
+        (send type encode (dict-ref field-data key) port parent))
+      (for ([ptr (in-list (dict-ref parent x:pointers-key))])
         (match ptr
           [(x:ptr type val parent) (send type encode val port parent)])))