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

40
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)
(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)