support kw args

xenomorph/xenomorph/redo/array.rkt

@@ -80,7 +80,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
    (define encode xarray-encode)
    (define size xarray-size)])
 
-(define (+xarray type [len #f] [length-type 'count])
+(define (+xarray [type-arg #f] [len-arg #f] [length-type-arg 'count]
+                 #:type [type-kwarg #f] #:length [len-kwarg #f] #:count-bytes [count-bytes? #f])
+  (define type (or type-arg type-kwarg))
+  (define len (or len-arg len-kwarg))
+  (define length-type (if count-bytes? 'bytes length-type-arg))
   (unless (xenomorphic? type)
     (raise-argument-error '+xarray "xenomorphic type" type))
   (unless (length-resolvable? len)

xenomorph/xenomorph/redo/bitfield.rkt

@@ -35,7 +35,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
    (define encode xbitfield-encode)
    (define size xbitfield-size)])
 
-(define (+xbitfield type [flags null])
+(define (+xbitfield [type-arg #f] [flag-arg #f]
+                    #:type [type-kwarg #f] #:flags [flag-kwarg #f])
+  (define type (or type-arg type-kwarg))
+  (define flags (or flag-arg flag-kwarg null))
   (unless (andmap (λ (f) (or (symbol? f) (not f))) flags)
     (raise-argument-error '+xbitfield "list of symbols" flags))
   (xbitfield type flags))

xenomorph/xenomorph/redo/lazy-array.rkt

@@ -43,7 +43,10 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
    (define encode xlazy-array-encode)
    (define size xlazy-array-size)])
 
-(define (+xlazy-array type [len #f])
+(define (+xlazy-array [type-arg #f] [len-arg #f]
+                      #:type [type-kwarg #f] #:length [len-kwarg #f])
+  (define type (or type-arg type-kwarg))
+  (define len (or len-arg len-kwarg))
   (unless (xenomorphic? type)
     (raise-argument-error '+xarray "xenomorphic type" type))
   (unless (length-resolvable? len)

xenomorph/xenomorph/redo/pointer.rkt

@@ -1,5 +1,6 @@
 #lang debug racket/base
 (require "helper.rkt"
+         "number.rkt"
          racket/dict
          racket/promise
          sugar/unstable/dict)
@@ -18,34 +19,34 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
 (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))
-  (cond
-    [(and allow-null (= offset (null-value xp))) #f] ; handle null pointers
-    [else
-     (define relative (+ (case (pointer-style xp)
-                           [(local) (dict-ref parent '_startOffset)]
-                           [(immediate) (- (pos port) (size (xpointer-offset-type xp)))]
-                           [(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) parent)))
-     (define ptr (+ offset relative))
-     (cond
-       [(xpointer-type xp)
-        (define val (void))
-        (define (decode-value)
-          (cond
-            [(not (void? val)) val]
-            [else
-             (define orig-pos (pos port))
-             (pos port ptr)
-             (set! val (decode (xpointer-type xp) #:parent parent))
-             (pos port orig-pos)
-             val]))
-        (if (pointer-lazy? xp)
-            (delay (decode-value))
-            (decode-value))]
-       [else ptr])])))
+    (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 parent '_startOffset)]
+                             [(immediate) (- (pos port) (size (xpointer-offset-type xp)))]
+                             [(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) parent)))
+       (define ptr (+ offset relative))
+       (cond
+         [(xpointer-type xp)
+          (define val (void))
+          (define (decode-value)
+            (cond
+              [(not (void? val)) val]
+              [else
+               (define orig-pos (pos port))
+               (pos port ptr)
+               (set! val (decode (xpointer-type xp) #:parent parent))
+               (pos port orig-pos)
+               val]))
+          (if (pointer-lazy? xp)
+              (delay (decode-value))
+              (decode-value))]
+         [else ptr])])))
 
 (define (resolve-void-pointer type val)
   (cond
@@ -58,37 +59,37 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
   (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* ([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 new-parent 'startOffset)]
-                            [(immediate) (+ (pos port) (size (xpointer-offset-type xp) val #:parent parent))]
-                            [(global) 0])
-                          ((relative-getter-or-0 xp) (dict-ref parent 'val #f)))])
-        (encode (xpointer-offset-type xp) (- (dict-ref new-parent 'pointerOffset) relative))
-        (let-values ([(type val) (resolve-void-pointer (xpointer-type xp) val)])
-          (dict-set! new-parent 'pointers (append (dict-ref new-parent 'pointers)
-                                           (list (mhasheq 'type type
-                                                          'val val
-                                                          'parent parent))))
-          (dict-set! new-parent 'pointerOffset (+ (dict-ref new-parent 'pointerOffset) (size type val #:parent  parent)))))))
+    (if (not val)
+        (encode (xpointer-offset-type xp) (null-value xp) port)
+        (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 new-parent 'startOffset)]
+                              [(immediate) (+ (pos port) (size (xpointer-offset-type xp) val #:parent parent))]
+                              [(global) 0])
+                            ((relative-getter-or-0 xp) (dict-ref parent 'val #f)))])
+          (encode (xpointer-offset-type xp) (- (dict-ref new-parent 'pointerOffset) relative))
+          (let-values ([(type val) (resolve-void-pointer (xpointer-type xp) val)])
+            (dict-set! new-parent 'pointers (append (dict-ref new-parent 'pointers)
+                                                    (list (mhasheq 'type type
+                                                                   'val val
+                                                                   'parent parent))))
+            (dict-set! new-parent 'pointerOffset (+ (dict-ref new-parent 'pointerOffset) (size type val #:parent  parent)))))))
   (unless port-arg (get-output-bytes port)))
 
 (define (xpointer-size xp [val #f] #:parent [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)])]
+                            [(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 parent)
       (dict-set! parent 'pointerSize (and (dict-ref parent 'pointerSize #f)
-                                       (+ (dict-ref parent 'pointerSize) (size type val #:parent parent)))))
+                                          (+ (dict-ref parent 'pointerSize) (size type val #:parent parent)))))
     (size (xpointer-offset-type xp))))
 
 (struct xpointer xbase (offset-type type options) #:transparent
@@ -97,13 +98,30 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
    (define encode xpointer-encode)
    (define size xpointer-size)])
 
-(define (+xpointer offset-type type-in [options (mhasheq)])
-  (xpointer offset-type (and (not (eq? type-in 'void)) type-in) options))
+(define (+xpointer [offset-arg #f] [type-arg #f]
+                   #:offset-type [offset-kwarg #f]
+                   #:type [type-kwarg #f]
+                   #:style [style 'local]
+                   #:relative-to [relative-to #f]
+                   #:lazy [lazy? #f]
+                   #:allow-null [allow-null? #t]
+                   #:null [null-value 0])
+  (define valid-pointer-styles '(local immediate parent global))
+  (unless (memq style valid-pointer-styles)
+    (raise-argument-error '+xpointer (format "~v" valid-pointer-styles) style))
+  (define options (mhasheq 'style style
+                           'relativeTo relative-to
+                           'lazy lazy?
+                           'allowNull allow-null?
+                           'nullValue null-value))
+  (define offset-type (or offset-arg offset-kwarg uint8))
+  (define type-in (or type-arg type-kwarg uint8))
+  (xpointer offset-type (case type-in [(void) #f][else type-in]) options))
 
-(define (pointer-style xp) (or (dict-ref (xpointer-options xp) 'type #f) 'local))
-(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 (pointer-lazy? xp) (dict-ref (xpointer-options xp) 'lazy #f))
+(define (pointer-style xp) (dict-ref (xpointer-options xp) 'style))
+(define (allow-null xp) (dict-ref (xpointer-options xp) 'allowNull)) 
+(define (null-value xp) (dict-ref (xpointer-options xp) 'nullValue))
+(define (pointer-lazy? xp) (dict-ref (xpointer-options xp) 'lazy))
 (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

xenomorph/xenomorph/redo/string.rkt

@@ -87,7 +87,10 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
    (define size xstring-size)])
 
 (define supported-encodings '(ascii utf8))
-(define (+xstring [len #f] [encoding 'ascii])
+(define (+xstring [len-arg #f] [enc-arg #f]
+                  #:length [len-kwarg #f] #:encoding [enc-kwarg #f])
+  (define len (or len-arg len-kwarg))
+  (define encoding (or enc-arg enc-kwarg 'ascii))
   (unless (length-resolvable? len)
     (raise-argument-error '+xarray "length-resolvable?" len))
   (unless (or (procedure? encoding) (memq encoding supported-encodings))
@@ -110,7 +113,10 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
    (define encode xsymbol-encode)
    (define size xstring-size)])
 
-(define (+xsymbol [len #f] [encoding 'ascii])
+(define (+xsymbol [len-arg #f] [enc-arg #f]
+                  #:length [len-kwarg #f] #:encoding [enc-kwarg #f])
+  (define len (or len-arg len-kwarg))
+  (define encoding (or enc-arg enc-kwarg 'ascii))
   (xsymbol len encoding))
 
 (module+ test

xenomorph/xenomorph/redo/struct.rkt

@@ -1,6 +1,7 @@
 #lang debug racket/base
 (require (prefix-in d: racket/dict)
          racket/promise
+         racket/sequence
          racket/list
          "helper.rkt"
          "number.rkt"
@@ -116,7 +117,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
    (define encode xstruct-encode)
    (define size xstruct-size)])
 
-(define (+xstruct [fields null])
+(define (+xstruct . dicts)
+  (define args (flatten dicts))
+  (unless (even? (length args))
+    (raise-argument-error '+xstruct "equal keys and values" dicts))
+  (define fields (for/list ([kv (in-slice 2 args)])
+                   (unless (symbol? (car kv))
+                     (raise-argument-error '+xstruct "symbol" (car kv)))
+                   (apply cons kv)))
   (unless (d:dict? fields)
     (raise-argument-error '+xstruct "dict" fields))
   (xstruct fields))

xenomorph/xenomorph/redo/test/array-test.rkt

@@ -102,4 +102,5 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
 
 (test-case 
    "add pointers after array if length is encoded at start"
-   (check-equal? (encode (+xarray (+xpointer uint8 uint8) uint8) '(1 2 3 4) #f) (bytes 4 5 6 7 8 1 2 3 4)))
+   (check-equal? (encode (+xarray (+xpointer #:offset-type uint8
+                                             #:type uint8) uint8) '(1 2 3 4) #f) (bytes 4 5 6 7 8 1 2 3 4)))

xenomorph/xenomorph/redo/test/pointer-test.rkt

@@ -16,37 +16,37 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
 (test-case
  "decode should handle null pointers"
  (parameterize ([current-input-port (open-input-bytes (bytes 0))])
-   (check-false (decode (+xpointer uint8 uint8) #:parent (mhash '_startOffset 50)))))
+   (check-false (decode (+xpointer) #:parent (mhash '_startOffset 50)))))
 
 (test-case
  "decode should use local offsets from start of parent by default"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
-   (check-equal? (decode (+xpointer uint8 uint8) #:parent (mhash '_startOffset 0)) 53)))
+   (check-equal? (decode (+xpointer) #:parent (mhash '_startOffset 0)) 53)))
 
 (test-case
  "decode should support immediate offsets"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
-   (check-equal? (decode (+xpointer uint8 uint8 (mhash 'type 'immediate))) 53)))
+   (check-equal? (decode (+xpointer #:style 'immediate)) 53)))
 
 (test-case
  "decode should support offsets relative to the parent"
  (parameterize ([current-input-port (open-input-bytes (bytes 0 0 1 53))])
    (pos (current-input-port) 2)
-   (check-equal? (decode (+xpointer uint8 uint8 (mhash 'type 'parent))
+   (check-equal? (decode (+xpointer #:style 'parent)
                          #:parent (mhash 'parent (mhash '_startOffset 2))) 53)))
 
 (test-case
  "decode should support global offsets"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 4 0 0 0 53))])
    (pos (current-input-port) 2)
-   (check-equal? (decode (+xpointer uint8 uint8 (mhash 'type 'global))
+   (check-equal? (decode (+xpointer #:style 'global)
                          #:parent (mhash 'parent (mhash 'parent (mhash '_startOffset 2))))
                  53)))
 
 (test-case
  "decode should support offsets relative to a property on the parent"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 0 0 0 0 53))])
-   (check-equal? (decode (+xpointer uint8 uint8 (mhash 'relativeTo (λ (parent) (dict-ref (dict-ref parent 'parent) 'ptr))))
+   (check-equal? (decode (+xpointer #:relative-to (λ (parent) (dict-ref (dict-ref parent 'parent) 'ptr)))
                          #:parent (mhash '_startOffset 0 'parent (mhash 'ptr 4)))
                  53)))
 
@@ -59,32 +59,32 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
 (test-case
  "decode should support decoding pointers lazily"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
-   (define res (decode (+xstruct (dictify 'ptr (+xpointer uint8 uint8 (mhasheq 'lazy #t))))))
+   (define res (decode (+xstruct (dictify 'ptr (+xpointer #:lazy #t)))))
    (check-true (promise? (dict-ref (struct-dict-res-_kv res) 'ptr)))
    (check-equal? (dict-ref res 'ptr) 53)))
 
 (test-case
  "size"
  (let ([parent (mhash 'pointerSize 0)])
-   (check-equal? (size (+xpointer uint8 uint8) 10 #:parent parent) 1)
+   (check-equal? (size (+xpointer) 10 #:parent parent) 1)
    (check-equal? (dict-ref parent 'pointerSize) 1)))
 
 (test-case
  "size should add to immediate pointerSize"
  (let ([parent (mhash 'pointerSize 0)])
-   (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'immediate)) 10 #:parent parent) 1)
+   (check-equal? (size (+xpointer #:style 'immediate) 10 #:parent parent) 1)
    (check-equal? (dict-ref parent 'pointerSize) 1)))
 
 (test-case
  "size should add to parent pointerSize"
  (let ([parent (mhash 'parent (mhash 'pointerSize 0))])
-   (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'parent)) 10 #:parent parent) 1)
+   (check-equal? (size (+xpointer #:style 'parent) 10 #:parent parent) 1)
    (check-equal? (dict-ref (dict-ref parent 'parent) 'pointerSize) 1)))
 
 (test-case
  "size should add to global pointerSize"
  (let ([parent (mhash 'parent (mhash 'parent (mhash 'parent (mhash 'pointerSize 0))))])
-   (check-equal? (size (+xpointer uint8 uint8 (mhash 'type 'global)) 10 #:parent parent) 1)
+   (check-equal? (size (+xpointer #:style 'global) 10 #:parent parent) 1)
    (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointerSize) 1)))
 
 (test-case
@@ -100,7 +100,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
 
 (test-case
  "size should return a fixed size without a value"
- (check-equal? (size (+xpointer uint8 uint8)) 1))
+ (check-equal? (size (+xpointer)) 1))
 
 (test-case
  "encode should handle null pointers"
@@ -109,7 +109,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
                       'startOffset 0
                       'pointerOffset 0
                       'pointers null))
-   (encode (+xpointer uint8 uint8) #f #:parent parent)
+   (encode (+xpointer) #f #:parent parent)
    (check-equal? (dict-ref parent 'pointerSize) 0)
    (check-equal? (dump (current-output-port)) (bytes 0))))
 
@@ -120,7 +120,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
                       'startOffset 0
                       'pointerOffset 1
                       'pointers null))
-   (encode (+xpointer uint8 uint8) 10 #:parent parent)
+   (encode (+xpointer) 10 #:parent parent)
    (check-equal? (dict-ref parent 'pointerOffset) 2)
    (check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8
                                                          'val 10
@@ -134,7 +134,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
                       'startOffset 0
                       'pointerOffset 1
                       'pointers null))
-   (encode (+xpointer uint8 uint8 (mhash 'type 'immediate)) 10 #:parent parent)
+   (encode (+xpointer #:style 'immediate) 10 #:parent parent)
    (check-equal? (dict-ref parent 'pointerOffset) 2)
    (check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8
                                                          'val 10
@@ -148,7 +148,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
                                      'startOffset 3
                                      'pointerOffset 5
                                      'pointers null)))
-   (encode (+xpointer uint8 uint8 (mhash 'type 'parent)) 10 #:parent parent)
+   (encode (+xpointer #:style 'parent) 10 #:parent parent)
    (check-equal? (dict-ref (dict-ref parent 'parent) 'pointerOffset) 6)
    (check-equal? (dict-ref (dict-ref parent 'parent) 'pointers) (list (mhasheq 'type uint8
                                                                             'val 10
@@ -164,7 +164,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
                                                    'startOffset 3
                                                    'pointerOffset 5
                                                    'pointers null)))))
-   (encode (+xpointer uint8 uint8 (mhash 'type 'global)) 10 #:parent parent)
+   (encode (+xpointer #:style 'global) 10 #:parent parent)
    (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointerOffset) 6)
    (check-equal? (dict-ref (dict-ref (dict-ref (dict-ref parent 'parent) 'parent) 'parent) 'pointers)
                  (list (mhasheq 'type uint8
@@ -180,7 +180,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
                       'pointerOffset 10
                       'pointers null
                       'val (mhash 'ptr 4)))
-   (encode (+xpointer uint8 uint8 (mhash 'relativeTo (λ (parent) (dict-ref parent 'ptr)))) 10 #:parent parent)
+   (encode (+xpointer #:relative-to (λ (parent) (dict-ref parent 'ptr))) 10 #:parent parent)
    (check-equal? (dict-ref parent 'pointerOffset) 11)
    (check-equal? (dict-ref parent 'pointers) (list (mhasheq 'type uint8
                                                          'val 10

xenomorph/xenomorph/redo/test/struct-test.rkt

@@ -16,15 +16,15 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
  "decode into an object"
  (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
    (check-equal?
-    (dump (decode (+xstruct (dictify 'name (+xstring uint8)
-                                     'age uint8))))
+    (dump (decode (+xstruct 'name (+xstring #:length uint8)
+                            'age uint8)))
     '((name . "roxyb") (age . 21)))))
 
 (test-case
  "decode with process hook"
  (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
-   (define struct (+xstruct (dictify 'name (+xstring uint8)
-                                     'age uint8)))
+   (define struct (+xstruct 'name (+xstring #:length uint8)
+                            'age uint8))
    (set-post-decode! struct (λ (o . _) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o))
    (check-equal? (dump (decode struct))
                  '((name . "roxyb") (canDrink . #t) (age . 32)))))
@@ -32,58 +32,56 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 (test-case
  "decode supports function keys"
  (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
-   (define struct (+xstruct (dictify 'name (+xstring uint8)
-                                     'age uint8
-                                     'canDrink (λ (o) (>= (dict-ref o 'age) 21)))))
+   (define struct (+xstruct 'name (+xstring #:length uint8)
+                            'age uint8
+                            'canDrink (λ (o) (>= (dict-ref o 'age) 21))))
    (check-equal? (dump (decode struct))
                  '((name . "roxyb") (canDrink . #t) (age . 32)))))
 
 (test-case
  "compute the correct size"
- (check-equal? (size (+xstruct (dictify
-                                'name (+xstring uint8)
-                                'age uint8))
+ (check-equal? (size (+xstruct 'name (+xstring #:length uint8)
+                               'age uint8)
                      (hasheq 'name "roxyb" 'age 32)) 7))
 
 (test-case
-   "compute the correct size with pointers"
-   (check-equal? (size (+xstruct (dictify
-                                  'name (+xstring uint8)
-                                  'age uint8
-                                  'ptr (+xpointer uint8 (+xstring uint8))))
-                       (mhash 'name "roxyb" 'age 21 'ptr "hello")) 14))
+ "compute the correct size with pointers"
+ (check-equal? (size (+xstruct 'name (+xstring #:length uint8)
+                               'age uint8
+                               'ptr (+xpointer #:type (+xstring #:length uint8)))
+                     (mhash 'name "roxyb" 'age 21 'ptr "hello")) 14))
 
 (test-case
  "get the correct size when no value is given"
- (check-equal? (size (+xstruct (dictify 'name (+xstring 4) 'age uint8))) 5))
+ (check-equal? (size (+xstruct 'name (+xstring 4) 'age uint8)) 5))
 
 (test-case
  "throw when getting non-fixed length size and no value is given"
- (check-exn exn:fail:contract? (λ () (size (+xstruct (dictify 'name (+xstring uint8)
-                                                              'age uint8))))))
+ (check-exn exn:fail:contract? (λ () (size (+xstruct 'name (+xstring #:length uint8)
+                                                     'age uint8)))))
 
 (test-case
  "encode objects to buffers"
  (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
-   (check-equal? (dump (decode (+xstruct (dictify 'name (+xstring uint8)
-                                                  'age uint8))))
+   (check-equal? (dump (decode (+xstruct 'name (+xstring #:length uint8)
+                                         'age uint8)))
                  '((name . "roxyb") (age . 21)))))
 
 (test-case
  "support pre-encode hook"
  (parameterize ([current-output-port (open-output-bytes)])
-   (define struct (+xstruct (dictify 'nameLength uint8
-                                     'name (+xstring 'nameLength)
-                                     'age uint8)))
+   (define struct (+xstruct 'nameLength uint8
+                            'name (+xstring 'nameLength)
+                            'age uint8))
    (set-pre-encode! struct (λ (val) (dict-set! val 'nameLength (string-length (dict-ref val 'name))) val))
    (encode struct (mhasheq 'name "roxyb" 'age 21))
    (check-equal? (dump (current-output-port)) #"\x05roxyb\x15")))
 
 (test-case
-   "encode pointer data after structure"
-   (parameterize ([current-output-port (open-output-bytes)])
-     (define struct (+xstruct (dictify 'name (+xstring uint8)
-                                       'age uint8
-                                       'ptr (+xpointer uint8 (+xstring uint8)))))
-     (encode struct (hasheq 'name "roxyb" 'age 21 'ptr "hello"))
-     (check-equal? (dump (current-output-port)) #"\x05roxyb\x15\x08\x05hello")))
+ "encode pointer data after structure"
+ (parameterize ([current-output-port (open-output-bytes)])
+   (define struct (+xstruct 'name (+xstring #:length uint8)
+                            'age uint8
+                            'ptr (+xpointer #:type (+xstring #:length uint8))))
+   (encode struct (hasheq 'name "roxyb" 'age 21 'ptr "hello"))
+   (check-equal? (dump (current-output-port)) #"\x05roxyb\x15\x08\x05hello")))

xenomorph/xenomorph/redo/test/versioned-struct-test.rkt

@@ -17,9 +17,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "decode should get version from number type"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
    (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
@@ -31,9 +31,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "decode should throw for unknown version"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
    (parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")])
@@ -45,8 +45,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
                                     (dictify
                                      'header (dictify 'age uint8
                                                       'alive uint8)
-                                     0 (dictify 'name (+xstring uint8 'ascii))
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'gender uint8)))])
    (parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")])
      (check-equal? (dump (decode vstruct)) '((version . 0) (name . "roxyb") (age . 21) (alive . 1))))
@@ -61,9 +61,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "decode should support parent version key"
  (let ([vstruct (+xversioned-struct 'version
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
    (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
@@ -77,7 +77,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "decode should support sub versioned structs"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
                                      1 (+xversioned-struct uint8
                                                            (dictify
@@ -98,9 +98,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "decode should support process hook"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
    (set-post-decode! vstruct (λ (val) (dict-set! val 'processed "true") val))
@@ -112,9 +112,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "size should compute the correct size"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
    (check-equal? (size vstruct (mhasheq 'name "roxyb"
@@ -129,9 +129,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "size should throw for unknown version"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
    (check-exn exn:fail:contract? (λ () (size vstruct (mhasheq 'name "roxyb"
@@ -144,8 +144,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
                                    (dictify
                                     'header (dictify 'age uint8
                                                      'alive uint8)
-                                    0 (dictify 'name (+xstring uint8 'ascii))
-                                    1 (dictify 'name (+xstring uint8 'utf8)
+                                    0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
+                                    1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                'gender uint8)))])
    (check-equal? (size struct (mhasheq 'name "roxyb"
                                        'age 21
@@ -161,11 +161,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "size should compute the correct size with pointers"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
-                                                'ptr (+xpointer uint8 (+xstring uint8)))))])
+                                                'ptr (+xpointer #:offset-type uint8
+                                                                #:type (+xstring uint8)))))])
    (check-equal? (size vstruct (mhasheq 'name "roxyb"
                                         'age 21
                                         'version 1
@@ -175,9 +176,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "size should throw if no value is given"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
    (check-exn exn:fail:contract? (λ () (size vstruct)))))
@@ -186,9 +187,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "encode should encode objects to buffers"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))]
        [op (open-output-bytes)])
@@ -205,9 +206,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "encode should throw for unknown version"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))]
        [op (open-output-bytes)])
@@ -221,8 +222,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
                                     (dictify
                                      'header (dictify 'age uint8
                                                       'alive uint8)
-                                     0 (dictify 'name (+xstring uint8 'ascii))
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii))
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'gender uint8)))]
        [op (open-output-bytes)])
    (encode vstruct (mhasheq 'name "roxyb"
@@ -240,11 +241,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "encode should encode pointer data after structure"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify 
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
-                                                'ptr (+xpointer uint8 (+xstring uint8)))))]
+                                                'ptr (+xpointer #:offset-type uint8
+                                                                #:type (+xstring uint8)))))]
        [op (open-output-bytes)])
    (encode vstruct (mhasheq 'version 1
                             'name "roxyb"
@@ -257,9 +259,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
  "encode should support preEncode hook"
  (let ([vstruct (+xversioned-struct uint8
                                     (dictify
-                                     0 (dictify 'name (+xstring uint8 'ascii)
+                                     0 (dictify 'name (+xstring #:length uint8 #:encoding 'ascii)
                                                 'age uint8)
-                                     1 (dictify 'name (+xstring uint8 'utf8)
+                                     1 (dictify 'name (+xstring #:length uint8 #:encoding 'utf8)
                                                 'age uint8
                                                 'gender uint8)))]
        [stream (open-output-bytes)])