Test -> packing notation.

1 files changed, 11 insertions, 9 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)