diff options
| author | David Thompson <dthompson2@worcester.edu> | 2024-11-23 10:39:19 -0500 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2024-11-23 10:42:28 -0500 |
| commit | faca7af5916d07a342d0c6076c2ea6a5610a81a9 (patch) | |
| tree | b65ab7ce4e872125ee7b04797daa7093c77b8903 | |
| parent | 8aff7a348967bafa5deeea10916d72370888a7d5 (diff) | |
Fix opaque types.
| -rw-r--r-- | bstruct.scm | 9 | ||||
| -rw-r--r-- | tests/test-bstruct.scm | 3 |
2 files changed, 11 insertions, 1 deletions
diff --git a/bstruct.scm b/bstruct.scm index df5163a..8efe98b 100644 --- a/bstruct.scm +++ b/bstruct.scm @@ -693,6 +693,10 @@ (symbolic-match? pointer) #`(make-pointer size align #,(build-type #'desc))))) (syntax-case stx () + ;; Opaque types have no descriptor. + ((_ id name (opaque)) + (symbolic-match? opaque) + #'(define id #f)) ((_ id name layout . kwargs) (with-syntax ((type (build-type #'layout))) #`(define id (make-bstruct-descriptor 'name type . kwargs))))))) @@ -1176,6 +1180,9 @@ (type-id (bstruct-descriptor-identifier? #'type-id) #'type-id) + ((opaque) + (symbolic-match? opaque) + expr) (primitive (identifier-memq? #'primitive primitives) (let ((type (syntax->datum #'primitive))) @@ -1357,7 +1364,7 @@ (with-syntax ((((expr . kwargs) ...) (map (lambda (stx) (syntax-case stx () - (() #'(opaque)) + (() #'((opaque))) (_ stx))) #'(args ...)))) #'(define-bstruct* (id expr . kwargs) ...))) diff --git a/tests/test-bstruct.scm b/tests/test-bstruct.scm index c0e3aaa..7990ab2 100644 --- a/tests/test-bstruct.scm +++ b/tests/test-bstruct.scm @@ -66,6 +66,9 @@ (c u64) (d u32))) +;; For testing opaque types. +(define-bstruct <opaque>) + (test-suite "bstruct" (test-group "bstruct?" (test-assert (bstruct? (bstruct-alloc <vec2>))) |