From 3ed24ae1fb9bf9aebd5d24b22b15d4ad8674ad5c Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Mon, 15 Jun 2015 02:13:22 +0900
Subject: [PATCH] syntax-rules: hygienic syntax-rules

---
 piclib/picrin/syntax-rules.scm | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/piclib/picrin/syntax-rules.scm b/piclib/picrin/syntax-rules.scm
index ee80f4cc..55076e7c 100644
--- a/piclib/picrin/syntax-rules.scm
+++ b/piclib/picrin/syntax-rules.scm
@@ -151,7 +151,7 @@
               (if (= 0 (cdr it))
                   (cdr (assq pat selectors))
                   (error "unmatched pattern variable level" pat))
-              #`'#,pat)))
+              #`(#,'rename '#,pat))))
        ((many? pat)
         (letrec*
             ((inner-pat
@@ -195,8 +195,18 @@
                   #,(compile-rules (cdr rules))))))
 
     (define (compile rules)
-      #`(lambda #,'it
-          #,(compile-rules rules)))
+      #`(call-with-current-environment
+         (lambda (env)
+           (letrec
+               ((#,'rename (let ((reg (make-register)))
+                             (lambda (x)
+                               (if (undefined? (reg x))
+                                   (let ((id (make-identifier x env)))
+                                     (reg x id)
+                                     id)
+                                   (reg x))))))
+             (lambda #,'it
+               #,(compile-rules rules))))))
 
     (let ((rules (map-keys cdr rules))) ; TODO: check pattern head is a variable
       (compile rules)))