summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-11-04 19:34:22 +0100
committerAndy Wingo <wingo@pobox.com>2011-11-07 11:45:15 +0100
commitde41e56492666801078e73860a358e1c63cbc8c2 (patch)
treec05944a138e524d6dbf0ba9b6424b9b9fe0f73fc
parent49689a3f2d60a4e72f14ad85df382de33dadc285 (diff)
downloadguile-de41e56492666801078e73860a358e1c63cbc8c2.tar.gz
hygienically rename macro-introduced bindings, reproducibly
* module/ice-9/psyntax.scm (chi-top-sequence): Detect bindings to identifiers introduced by macros. In that case, in order to preserve hygiene, uniquify the variable's name, but in a way that is reproduceable (i.e., yields the same uniquified name after a recompile).
-rw-r--r--module/ice-9/psyntax.scm22
1 files changed, 20 insertions, 2 deletions
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 7671e357a..7c3024bf8 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -991,6 +991,20 @@
(extend-ribcage! ribcage id
(cons (syntax-object-module id)
(wrap var top-wrap mod)))))
+ (define (macro-introduced-identifier? id)
+ (not (equal? (wrap-marks (syntax-object-wrap id)) '(top))))
+ (define (fresh-derived-name id orig-form)
+ (symbol-append
+ (syntax-object-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))))
(define (parse body r w s m esew mod)
(let lp ((body body) (exps '()))
(if (null? body)
@@ -1007,7 +1021,9 @@
((define-form)
(let* ((id (wrap value w mod))
(label (gen-label))
- (var (syntax-object-expression id)))
+ (var (if (macro-introduced-identifier? id)
+ (fresh-derived-name id x)
+ (syntax-object-expression id))))
(record-definition! id var)
(list
(if (eq? m 'c&e)
@@ -1019,7 +1035,9 @@
((define-syntax-form define-syntax-parameter-form)
(let* ((id (wrap value w mod))
(label (gen-label))
- (var (syntax-object-expression id)))
+ (var (if (macro-introduced-identifier? id)
+ (fresh-derived-name id x)
+ (syntax-object-expression id))))
(record-definition! id var)
(case m
((c)