diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 7811f7118..374a3c4b3 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1087,18 +1087,36 @@
                                      (wrap var top-wrap mod)))))
           (define (macro-introduced-identifier? id)
             (not (equal? (wrap-marks (syntax-wrap id)) '(top))))
+          (define (ensure-fresh-name var)
+            ;; If a macro introduces a top-level identifier, we attempt
+            ;; to give it a fresh name by appending the hash of the
+            ;; expression in which it appears.  However, this can fail
+            ;; for hash collisions, which is more common that one might
+            ;; think: Guile's hash function stops descending into cdr's
+            ;; at some point.  So, within an expansion unit, fall back
+            ;; to appending a uniquifying integer.
+            (define (ribcage-has-var? var)
+              (let lp ((labels (ribcage-labels ribcage)))
+                (and (pair? labels)
+                     (let ((wrapped (cdar labels)))
+                       (or (eq? (syntax-expression wrapped) var)
+                           (lp (cdr labels)))))))
+            (let lp ((unique var) (n 1))
+              (if (ribcage-has-var? unique)
+                  (let ((tail (string->symbol (number->string n))))
+                    (lp (symbol-append var '- tail) (1+ n)))
+                  unique)))
           (define (fresh-derived-name id orig-form)
-            (symbol-append
-             (syntax-expression id)
-             '-
-             (string->symbol
-              ;; FIXME: `hash' currently stops descending into nested
-              ;; data at some point, so it's less unique than we would
-              ;; like.  Also this encodes hash values into the ABI of
-              ;; compiled modules; a problem?
-              (number->string
-               (hash (syntax->datum orig-form) most-positive-fixnum)
-               16))))
+            (ensure-fresh-name
+             (symbol-append
+              (syntax-expression id)
+              '-
+              (string->symbol
+               ;; FIXME: This encodes hash values into the ABI of
+               ;; compiled modules; a problem?
+               (number->string
+                (hash (syntax->datum orig-form) most-positive-fixnum)
+                16)))))
           (define (parse body r w s m esew mod)
             (let lp ((body body) (exps '()))
               (if (null? body)
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 510e7104d..f0cdc1cbf 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -1,7 +1,7 @@
 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2009, 2010,
-;;;;   2011, 2012, 2013, 2014, 2021 Free Software Foundation, Inc.
+;;;;   2011, 2012, 2013, 2014, 2021, 2024 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1695,6 +1695,18 @@
           ((_ x) (when (eq? x #nil) 42))))
       (foo #nil))))
 
+(with-test-prefix "duplicate top-level introduced definitions"
+  (pass-if-equal '(42 69)
+      (begin
+        (define-syntax-rule (defconst f val)
+          (begin
+            ;; The zeros cause a hash collision.
+            (define t (begin 0 0 0 0 0 0 0 0 0 val))
+            (define (f) t)))
+        (defconst a 42)
+        (defconst b 69)
+        (list (a) (b)))))
+
 ;;; Local Variables:
 ;;; eval: (put 'pass-if-syntax-error 'scheme-indent-function 1)
 ;;; eval: (put 'with-ellipsis 'scheme-indent-function 1)