diff options
Diffstat (limited to 'bstruct.scm')
| -rw-r--r-- | bstruct.scm | 20 |
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) |