Test -> packing notation.

2 files changed, 18 insertions, 16 deletions

diff --git a/bstruct.scm b/bstruct.scm
index 8efe98b..191f2b5 100644
--- a/bstruct.scm
+++ b/bstruct.scm
@@ -430,6 +430,13 @@
   (let-values (((_ transformer) (syntax-local-binding id)))
     (procedure-property transformer 'bstruct-align)))
 
+(define (identifier-eq? stx sym)
+  (and (identifier? stx) (eq? (syntax->datum stx) sym)))
+(define-syntax-rule (symbolic-match? id)
+  (identifier-eq? #'id 'id))
+(define (identifier-memq? stx syms)
+  (and (identifier? stx) (memq (syntax->datum stx) syms)))
+
 ;; A predicate that can answer the questions:
 ;; 1) Is this *any kind* of bstruct?
 ;; 2) Is this *a specific kind* of bstruct?
@@ -547,9 +554,10 @@
   (lambda (stx)
     (define (flatten-elems stx)
       (append-map (lambda (stx)
-                    (syntax-case stx (->)
+                    (syntax-case stx ()
                       ((-> root-elem sub-elems ...)
-                       (identifier? #'root-elem)
+                       (and (symbolic-match? ->)
+                            (identifier? #'root-elem))
                        (map (lambda (stx)
                               (syntax-case stx ()
                                 (((sub-elem ...) val)
@@ -568,6 +576,7 @@
          #'(begin
              ((<type> setter elem ...) bv i val)
              ...))))))
+
 (define-syntax bstruct-unpack
   (lambda (stx)
     (syntax-case stx ()
@@ -639,13 +648,6 @@
        (bstruct-copy! <type> src dst)
        dst))))
 
-(define (identifier-eq? stx sym)
-  (and (identifier? stx) (eq? (syntax->datum stx) sym)))
-(define-syntax-rule (symbolic-match? id)
-  (identifier-eq? #'id 'id))
-(define (identifier-memq? stx syms)
-  (and (identifier? stx) (memq (syntax->datum stx) syms)))
-
 (define-syntax define-bstruct-descriptor
   (lambda (stx)
     (define (build-bit-field stx)
diff --git a/tests/test-bstruct.scm b/tests/test-bstruct.scm
index 7990ab2..18cb13a 100644
--- a/tests/test-bstruct.scm
+++ b/tests/test-bstruct.scm
@@ -225,8 +225,7 @@
       (let ((bv (f32vector 0 0 0 0)))
         (bstruct-pack! <vertex> bv 0
                        (xy (bstruct-alloc <vec2> (x 1) (y 2)))
-                       ((uv x) 3)
-                       ((uv y) 4))
+                       (-> uv (x 3) (y 4)))
         bv))
     (test-equal (f32vector 1 0 0 0
                            0 1 0 0
@@ -241,11 +240,12 @@
     (test-equal (u8vector 1 2 0 0 3 0 0 0 4 0 0 0)
       (let ((bv (make-bytevector (bstruct-sizeof <event>))))
         (bstruct-pack! <event> bv 0
-                       ((mouse-button type) 1)
-                       ((mouse-button button) 2)
-                       ((mouse-button state) 0)
-                       ((mouse-button x) 3)
-                       ((mouse-button y) 4))
+                       (-> mouse-button
+                           (type 1)
+                           (button 2)
+                           (state 0)
+                           (x 3)
+                           (y 4)))
         bv))
     (test-equal (u8vector 232 7 0 0 123 1 0 0)
       (let ((bv (make-bytevector (bstruct-sizeof <date>))))