diff options
author | Andy Wingo <wingo@pobox.com> | 2011-11-04 19:34:22 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-11-07 11:45:15 +0100 |
commit | de41e56492666801078e73860a358e1c63cbc8c2 (patch) | |
tree | c05944a138e524d6dbf0ba9b6424b9b9fe0f73fc | |
parent | 49689a3f2d60a4e72f14ad85df382de33dadc285 (diff) | |
download | guile-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.scm | 22 |
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) |