From faca7af5916d07a342d0c6076c2ea6a5610a81a9 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 23 Nov 2024 10:39:19 -0500
Subject: Fix opaque types.

---
 bstruct.scm            | 9 ++++++++-
 tests/test-bstruct.scm | 3 +++
 2 files changed, 11 insertions(+), 1 deletion(-)

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>)))
-- 
cgit v1.2.3