wingo pushed a commit to branch main
in repository guile.
commit 1349c41a601d4bda3f27be29b7359a32830b736c
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Mon Jan 29 10:35:59 2024 +0100
Ensure macro-introduced top-level identifiers are unique
* module/ice-9/psyntax.scm (expand-top-sequence): When making a fresh
name for an introduced identifier, the hash isn't enough: it's quite
possible for normal programs to have colliding hash values, because
Guile's hash functions on pairs doesn't traverse the whole tree.
Therefore, append a uniquifying counter if the introduced name is
already defined in the current expansion unit.
* test-suite/tests/syntax.test ("duplicate top-level introduced
definitions"): Add test.
---
module/ice-9/psyntax.scm | 40 +++++++++++++++++++++++++++++-----------
test-suite/tests/syntax.test | 14 +++++++++++++-
2 files changed, 42 insertions(+), 12 deletions(-)
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)
