From 796d5f9e0a15d42094f4373b97f07ce184c4b7ad Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 20 Sep 2016 17:32:26 -0400
Subject: [PATCH] Get macros to work by adding a rename env

Each macro will use its own use environment to rename macros, but a common environment will be used by all macro expansions (and after the last expansion) to map any renamed free variables back to the expected symbol.
---
 cyclone.scm               |  6 +++---
 scheme/cyclone/macros.sld | 18 +++++++++---------
 scheme/cyclone/util.sld   |  4 +++-
 scheme/eval.sld           |  4 ++--
 4 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/cyclone.scm b/cyclone.scm
index 6cbda0f5..cc23e24b 100644
--- a/cyclone.scm
+++ b/cyclone.scm
@@ -148,9 +148,9 @@
       (trace:info "---------------- after macro expansion:")
       (trace:info input-program) ;pretty-print
 ; TODO:
-      ;(set! input-program (macro:cleanup input-program))
-      ;(trace:info "---------------- after macro expansion cleanup:")
-      ;(trace:info input-program) ;pretty-print
+      (set! input-program (macro:cleanup input-program))
+      (trace:info "---------------- after macro expansion cleanup:")
+      (trace:info input-program) ;pretty-print
 
       ;; Separate global definitions from the rest of the top-level code
       (set! input-program 
diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld
index ce2d59a4..62d60bbe 100644
--- a/scheme/cyclone/macros.sld
+++ b/scheme/cyclone/macros.sld
@@ -73,14 +73,14 @@
               ((Cyc-get-cvar (cadr macro))
                 exp
                 (Cyc-er-rename use-env mac-env)
-                (Cyc-er-compare? use-env)))
+                (Cyc-er-compare? use-env *macro:renamed-variables*)))
             (else
               (eval
                 (list
                   (Cyc-get-cvar (cadr macro))
                   (list 'quote exp)
                   (Cyc-er-rename use-env mac-env)
-                  (Cyc-er-compare? use-env))
+                  (Cyc-er-compare? use-env *macro:renamed-variables*))
                 mac-env))))
 ;        (newline)
 ;        (display "/* ")
@@ -101,13 +101,13 @@
 
     (define (macro:cleanup expr)
       (define (clean expr bv) ;; Bound variables
-(newline)
-(display "/* macro:cleanup->clean, bv =")
-(write bv)
-(newline)
-(write expr)
-(newline)
-(display "*/ ")
+;(newline)
+;(display "/* macro:cleanup->clean, bv =")
+;(write bv)
+;(newline)
+;(write expr)
+;(newline)
+;(display "*/ ")
          (cond 
            ((const? expr)      expr)
            ((null? expr)       expr)
diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld
index 220f4cbe..e043e8ed 100644
--- a/scheme/cyclone/util.sld
+++ b/scheme/cyclone/util.sld
@@ -596,12 +596,14 @@
      (begin . begin) ;; TODO: just a quick-fix, not a long-term solution
     )))
 
-(define (Cyc-er-compare? use-env)
+(define (Cyc-er-compare? use-env renamed-env)
   ;; Keep looking up a symbol until the original non-renamed symbol is found
   (define (find-original-sym sym)
     (let ((val (env:lookup sym use-env #f)))
 ;(Cyc-write `(find-original-sym ,sym ,val) (current-output-port))
 ;(Cyc-display "\n"  (current-output-port))
+      (if (not val)
+          (set! val (env:lookup sym renamed-env #f)))
       (if val
           (find-original-sym val) ;; Keep going
           sym))) ;; There was no rename, so sym is not renamed
diff --git a/scheme/eval.sld b/scheme/eval.sld
index 98ea18be..f0737668 100644
--- a/scheme/eval.sld
+++ b/scheme/eval.sld
@@ -442,7 +442,7 @@
                (analyze (apply macro-op
                               (list (cons (car exp) (operands exp))
                                     (Cyc-er-rename use-env a-env)
-                                    (Cyc-er-compare? use-env))) 
+                                    (Cyc-er-compare? use-env use-env))) 
                         a-env)
                ;; Interpreted macro, build expression and eval
                (let ((expr (cons macro-op 
@@ -450,7 +450,7 @@
                                          (list (cons (car exp) 
                                                      (operands exp))))
                                    (Cyc-er-rename use-env a-env)
-                                   (Cyc-er-compare? use-env)))))
+                                   (Cyc-er-compare? use-env use-env)))))
                  (analyze
                    (eval expr a-env) ;; Expand macro
                    a-env))))))