resume in subversioned structs

pitfall/restructure/generic.rkt

@@ -16,6 +16,9 @@
   ([hash? (define ref hash-ref)
           (define ref-set! hash-set!)
           (define ref-keys hash-keys)]
+   [dict? (define ref dict-ref)
+          (define ref-set! dict-set!)
+          (define ref-keys dict-keys)]
    [object? (define (ref o i) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i))]) (dynamic-get-field i o)))
             (define (ref-set! o i v) (with-handlers ([exn:fail:object? (λ (exn) (hash-set! (get-field _hash o) i v))]) (dynamic-set-field! i o v)))
             (define (ref-keys o) (append (remove '_hash (field-names o)) (hash-keys (get-field _hash o))))]))

pitfall/restructure/main.rkt

@@ -3,6 +3,7 @@
 (r+p "base.rkt"
      "number.rkt"
      "struct.rkt"
+     "versioned-struct.rkt"
      "string.rkt"
      "array.rkt"
      "lazy-array.rkt"
@@ -14,6 +15,7 @@
 (test-module
  (require "number-test.rkt"
           "struct-test.rkt"
+          "versioned-struct-test.rkt"
           "string-test.rkt"
           "array-test.rkt"
           "lazy-array-test.rkt"

pitfall/restructure/versioned-struct-test.rkt

@@ -30,6 +30,28 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;        name: 'devon 👍'
 ;        age: 21
 ;        gender: 0
+
+(let ([struct (+VersionedStruct uint8
+                                (dictify
+                                 0 (dictify 'name (+StringT uint8 'ascii)
+                                            'age uint8)
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'age uint8
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0000\u0005devon\u0015"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon"
+                                                                 'age 21
+                                                                 'version 0)))
+
+  (let ([stream (+DecodeStream (+Buffer "\u0001\u000adevon 👍\u0015\u0000"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍"
+                                                                 'age 21
+                                                                 'version 1
+                                                                 'gender 0))))
+
+
+
 ;
 ;    it 'should throw for unknown version', ->
 ;      struct = new VersionedStruct uint8,
@@ -44,6 +66,19 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;      stream = new DecodeStream new Buffer '\x05\x05devon\x15'
 ;      should.throw ->
 ;        struct.decode(stream)
+
+
+(let ([struct (+VersionedStruct uint8
+                                (dictify
+                                 0 (dictify 'name (+StringT uint8 'ascii)
+                                            'age uint8)
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'age uint8
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0005\u0005devon\u0015"))])
+    (check-exn exn:fail:contract? (λ () (send struct decode stream)))))
+
 ;
 ;    it 'should support common header block', ->
 ;      struct = new VersionedStruct uint8,
@@ -70,6 +105,29 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;        alive: 1
 ;        name: 'devon 👍'
 ;        gender: 0
+
+
+(let ([struct (+VersionedStruct uint8
+                                (dictify
+                                 'header (dictify 'age uint8
+                                                  'alive uint8)
+                                 0 (dictify 'name (+StringT uint8 'ascii))
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0000\u0015\u0001\u0005devon"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon"
+                                                                 'age 21
+                                                                 'alive 1
+                                                                 'version 0)))
+
+  (let ([stream (+DecodeStream (+Buffer "\u0001\u0015\u0001\u000adevon 👍\u0000"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍"
+                                                                 'age 21
+                                                                 'version 1
+                                                                 'alive 1
+                                                                 'gender 0))))
+
 ;
 ;    it 'should support parent version key', ->
 ;      struct = new VersionedStruct 'version',
@@ -93,6 +151,26 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;        name: 'devon 👍'
 ;        age: 21
 ;        gender: 0
+
+(let ([struct (+VersionedStruct 'version
+                                (dictify
+                                 0 (dictify 'name (+StringT uint8 'ascii)
+                                            'age uint8)
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'age uint8
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0005devon\u0015"))])
+    (check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "devon"
+                                                                                    'age 21
+                                                                                    'version 0)))
+
+  (let ([stream (+DecodeStream (+Buffer "\u000adevon 👍\u0015\u0000" 'utf8))])
+    (check-equal? (send (send struct decode stream (mhash 'version 1)) ht) (mhasheq 'name "devon 👍"
+                                                                                    'age 21
+                                                                                    'version 1
+                                                                                    'gender 0))))
+
 ;
 ;    it 'should support sub versioned structs', ->
 ;      struct = new VersionedStruct uint8,

pitfall/restructure/versioned-struct.rkt

@@ -8,46 +8,48 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 |#
 
 (define-subclass Struct (VersionedStruct type [versions (dictify)])
+  
   (unless ((disjoin integer? procedure? RestructureBase? symbol?) 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  _parseFields process)
   (inherit-field fields)
-  (field [forced-version #f])
+  (field [forced-version #f]
+         [versionGetter void]
+         [versionSetter void])
 
-  (define/public-final (force-version! version)
-    (set! forced-version version))
+  (when (symbol? type) ; instead of string
+    (set-field! versionGetter this (λ (parent) (ref parent type)))
+    (set-field! versionSetter this (λ (parent version) (ref-set! parent type version))))
+
+  (define/override (decode stream [parent #f] [length 0])
+    (define res (_setup stream parent length))
     
-  (define/public (resolve-version [stream #f] [parent #f])
+    (ref-set! res 'version
               (cond
                 [forced-version] ; for testing purposes: pass an explicit version
-      [(integer? type) type]
-      [(symbol? type)
-       ;; find the first Struct in the chain of ancestors
-       ;; with the target key
-       (let loop ([x parent])
-         (cond
-           [(and x (Struct? x) (dict-ref (· x res) type #f))]
-           [(· x parent) => loop]
-           [else #f]))]
-      [(and (procedure? type) (positive? (procedure-arity type))) (type parent)]
-      [(RestructureBase? type) (send type decode stream)]
-      [else (raise-argument-error 'VersionedStruct:resolve-version "way of finding version" type)]))
+                [(symbol? type) (unless parent
+                                  (raise-argument-error 'VersionedStruct:decode "valid parent" parent))
+                                (versionGetter parent)]
+                [else (send type decode stream)]))
+
+    (when (dict-ref versions 'header #f)
+      (_parseFields stream res (ref versions 'header)))
+    
+    (define fields (dict-ref versions (ref res 'version) (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions))))))
 
-  (define/override (decode stream [parent #f] [length 0])
-    (set! res (send this _setup stream parent length))
-    (report res 'versioned-struct-res)
-    (define version (resolve-version stream parent))
-    (hash-set! res 'version version)
-    (define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions))))))
     (cond
       [(VersionedStruct? fields) (send fields decode stream parent)]
       [else
-       (report res 'whatigot)
-       (send this _parseFields stream res fields)
-       (send this process res stream)
+       (_parseFields stream res fields)
+       (process res stream)
        res]))
   
+  (define/public-final (force-version! version)
+    (set! forced-version version))  
+
   (define/override (encode stream input-hash [parent #f])
     (unless (hash? input-hash)
       (raise-argument-error 'Struct:encode "hash" input-hash))
@@ -66,20 +68,35 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
       [else (send fields encode stream input-hash parent)]))
 
   
-  (define/override (size [input-hash (mhash)] [parent #f] [includePointers #t])
-    (when (and (not input-hash) (not forced-version))
+  (define/override (size [val (mhash)] [parent #f] [includePointers #t])
+    (unless (or val forced-version)
       (error 'VersionedStruct-cannot-compute-size))
-    (define version (resolve-version #f parent))
-    (define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:size "valid version key" version))))
-    (cond
-      [(dict? fields)
-       (for/sum ([(key type) (in-dict fields)])
-         (define val (hash-ref input-hash key #f))
-         (define args (if val (list val) empty))
-         (send type size . args))]
-      [else (send fields size input-hash parent includePointers)])))
 
-(test-module
+    (define ctx (mhash 'parent parent
+                       'val val
+                       'pointerSize 0))
+
+    (define size 0)
+    (when (not (string? type))
+      (increment! size (send type size (ref val 'version) ctx)))
+
+    (when (ref versions 'header)
+      (increment! size
+                  (for/sum ([(key type) (in-dict (ref versions 'header))])
+                    (send type size (ref val key) ctx))))
+    
+    (define fields (dict-ref versions (ref val 'version) (λ () (raise-argument-error 'VersionedStruct:encode "valid version key" version))))
+
+    (increment! size
+                (for/sum ([(key type) (in-dict (ref versions 'header))])
+                  (send type size (ref val key) ctx)))
+
+    (when includePointers
+      (increment! size (ref ctx 'pointerSize)))
+
+    size))
+
+#;(test-module
    (require "number.rkt")
    (define (random-pick xs) (list-ref xs (random (length xs))))
    (check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42)))