No duplicate names allowed in type group.

1 files changed, 45 insertions, 32 deletions

diff --git a/bstruct.scm b/bstruct.scm
index 7eda10c..9edb5ce 100644
--- a/bstruct.scm
+++ b/bstruct.scm
@@ -1020,30 +1020,28 @@
                (self
                 (identifier? #'self)
                 #'type-id)))))
-      ((_ id type-id desc . kwargs)
-       (with-syntax ((size (sizeof/syntax #'desc))
-                     (align (alignof/syntax #'desc)))
-         #'(define-syntax id
-             (lambda (stx)
-               #((bstruct? . #t)
-                 (bstruct-opaque? . #f)
-                 (bstruct-size . size)
-                 (bstruct-alignment . align))
-               (let ((type #'desc))
-                 (syntax-case stx ()
-                   (self
-                    (identifier? #'self)
-                    #'type-id)
-                   ;; Private interface for code generation.
-                   ((_ offset . elems)
-                    (symbolic-match? offset)
-                    (expand-offset #'elems #'id type))
-                   ((_ getter . elems)
-                    (symbolic-match? getter)
-                    (expand-getter #'elems #'id type))
-                   ((_ setter . elems)
-                    (symbolic-match? setter)
-                    (expand-setter #'elems #'id type size)))))))))))
+      ((_ id type-id size align desc . kwargs)
+       #'(define-syntax id
+           (lambda (stx)
+             #((bstruct? . #t)
+               (bstruct-opaque? . #f)
+               (bstruct-size . size)
+               (bstruct-alignment . align))
+             (let ((type #'desc))
+               (syntax-case stx ()
+                 (self
+                  (identifier? #'self)
+                  #'type-id)
+                 ;; Private interface for code generation.
+                 ((_ offset . elems)
+                  (symbolic-match? offset)
+                  (expand-offset #'elems #'id type))
+                 ((_ getter . elems)
+                  (symbolic-match? getter)
+                  (expand-getter #'elems #'id type))
+                 ((_ setter . elems)
+                  (symbolic-match? setter)
+                  (expand-setter #'elems #'id type size))))))))))
 
 (define-syntax define-bstruct*
   (lambda (stx)
@@ -1197,22 +1195,36 @@
                            #'(expr ...)))
                      ((type-id ...) (map type-descriptor-id #'(id ...)))
                      (((recur-accessor recur-id) ...) recursive-pointers))
-         #'(begin
-             ;; First, define the type descriptors.
-             (define-bstruct-descriptor type-id id type . kwargs) ...
-             ;; Then tie the knots for recursive pointer types.
-             (set-pointer-type! recur-accessor recur-id) ...
-             ;; Finally, define the wrapper macros.
-             (define-bstruct-macro id type-id type . kwargs) ...))))))
+         (with-syntax ((((size align) ...)
+                        (map (lambda (type)
+                               (list (sizeof/syntax type) (alignof/syntax type)))
+                             #'(type ...))))
+           #'(begin
+               ;; First, define the type descriptors.
+               (define-bstruct-descriptor type-id id type . kwargs) ...
+               ;; Then tie the knots for recursive pointer types.
+               (set-pointer-type! recur-accessor recur-id) ...
+               ;; Finally, define the wrapper macros.
+               (define-bstruct-macro id type-id size align type . kwargs) ...)))))))
 
 (define-syntax define-bstruct
   (lambda (stx)
+    (define (distinct? lst)
+      (let lp ((remaining lst) (seen '()))
+        (match remaining
+          (() #t)
+          ((x . rest)
+           (if (memq x seen)
+               #f
+               (lp rest (cons x seen)))))))
     (syntax-case stx ()
       ;; Type group definition.  Types defined in the same group can
       ;; contain recursive pointer references to each other.
       ((_ (id . args) ...)
        (and (not (null? #'(id ...)))
-            (every identifier? #'(id ...)))
+            (every identifier? #'(id ...))
+            ;; Duplicate ids not allowed in a type group.
+            (distinct? (syntax->datum #'(id ...))))
        ;; Handle the special case of opaque types having empty
        ;; specifications.
        (with-syntax ((((expr . kwargs) ...)
@@ -1224,4 +1236,5 @@
          #'(define-bstruct* (id expr . kwargs) ...)))
       ;; A single type definition is a type group of one.
       ((_ id . args)
+       (identifier? #'id)
        #'(define-bstruct (id . args))))))