mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Ensure macro-introduced top-level identifiers are unique

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2024-01-29 10:35:59 +01:00
parent 455ee49f55
commit 1349c41a60
2 changed files with 42 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

26
module/ice-9/psyntax.scm
View file

@ -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)
(ensure-fresh-name
(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
;; FIXME: This encodes hash values into the ABI of
;; compiled modules; a problem?
(number->string
(hash (syntax->datum orig-form) most-positive-fixnum)
16))))
16)))))
(define (parse body r w s m esew mod)
(let lp ((body body) (exps '()))
(if (null? body)

14
test-suite/tests/syntax.test
View file

@ -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)