diff options
| -rw-r--r-- | bstruct.scm | 20 | ||||
| -rw-r--r-- | tests/test-bstruct.scm | 14 |
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>)))) |