From 435fefe6d0f20f0ada576637a1d99def54a41ef9 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Wed, 17 Jan 2018 17:50:45 -0500
Subject: [PATCH] WIP

---
 scheme/cyclone/util.sld | 13 ++++++++-----
 scheme/eval.sld         | 22 +++++++++++-----------
 2 files changed, 19 insertions(+), 16 deletions(-)

diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld
index 984d3ceb..45ebbc12 100644
--- a/scheme/cyclone/util.sld
+++ b/scheme/cyclone/util.sld
@@ -614,14 +614,16 @@
 
 ;;; Explicit renaming macros
 
-(define (Cyc-er-rename use-env mac-env)
+(define (Cyc-er-rename use-env mac-env binding-lis)
   ((lambda (renames)
      (lambda (identifier)
 ;(Cyc-write `(ER rename ,identifier) (current-output-port))
 ;(Cyc-display "\n"  (current-output-port))
-       ((lambda (cell)
-          (if cell
-              (cdr cell)
+       ((lambda (binding-cell cell)
+          (cond
+           (binding-cell (cdr binding-cell))
+           (cell (cdr cell))
+           (else
               ((lambda (name)
                  (set! renames (cons (cons identifier name) renames))
                  name)
@@ -654,7 +656,8 @@
                ; forms other than symbols, if that is done.
                ;
                ;(make-syntactic-closure mac-env '() identifier)
-              )))
+              ))))
+        (assq identifier binding-lis)
         (assq identifier renames))
        ))
    ;; TODO: For now, do not allow renaming of special form symbols to 
diff --git a/scheme/eval.sld b/scheme/eval.sld
index 3c689ffe..fa4c8f41 100644
--- a/scheme/eval.sld
+++ b/scheme/eval.sld
@@ -563,7 +563,7 @@
                ;; Compiled macro, call directly
                (analyze (apply macro-op
                               (list (cons (car exp) (operands exp))
-                                    (Cyc-er-rename use-env a-env)
+                                    (Cyc-er-rename use-env a-env '())
                                     (Cyc-er-compare? use-env use-env))) 
                         a-env)
                ;; Interpreted macro, build expression and eval
@@ -571,7 +571,7 @@
                              (list (cons 'quote 
                                          (list (cons (car exp) 
                                                      (operands exp))))
-                                   (Cyc-er-rename use-env a-env)
+                                   (Cyc-er-rename use-env a-env '())
                                    (Cyc-er-compare? use-env use-env)))))
                  (analyze
                    (eval expr a-env) ;; Expand macro
@@ -746,7 +746,7 @@
     ;; Macro section
     (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros))
 
-    (define (macro:expand exp macro mac-env rename-env)
+    (define (macro:expand exp macro mac-env rename-env local-renamed)
       (let* ((use-env (env:extend-environment '() '() '()))
              (compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro)))
                                   (procedure? (cadr macro))))
@@ -764,14 +764,14 @@
             (compiled-macro?
               ((Cyc-get-cvar (cadr macro))
                 exp
-                (Cyc-er-rename use-env mac-env)
+                (Cyc-er-rename use-env mac-env local-renamed)
                 (Cyc-er-compare? use-env rename-env)))
             (else
               (eval
                 (list
                   (Cyc-get-cvar (cadr macro))
                   (list 'quote exp)
-                  (Cyc-er-rename use-env mac-env)
+                  (Cyc-er-rename use-env mac-env local-renamed)
                   (Cyc-er-compare? use-env rename-env))
                 mac-env))))
 ;        (newline)
@@ -905,9 +905,9 @@
               (map
                (lambda (a)
                 (let ((a/r (cons a (gensym a))))
-      I think we want to pass these a-lookup bindings to Cyc-er-rename and
-      use them to rename any locals. ideally want this stored with macro def
-      for define-syntax. I think we get it for free with let*-syntax
+;      I think we want to pass these a-lookup bindings to Cyc-er-rename and
+;      use them to rename any locals. ideally want this stored with macro def
+;      for define-syntax. I think we get it for free with let*-syntax
                   ;; TODO: define needed?
                   ;(env:define-variable! (cdr a/r) (car a/r) rename-env)
                   a/r))
@@ -1050,13 +1050,13 @@
           (cond
            ((tagged-list? 'macro val)
             (_expand ; Could expand into another macro
-              (macro:expand exp val env rename-env)
+              (macro:expand exp val env rename-env local-renamed)
               env 
               rename-env 
               local-env local-renamed))
            ((Cyc-macro? val)
             (_expand ; Could expand into another macro
-              (macro:expand exp (list 'macro val) env rename-env)
+              (macro:expand exp (list 'macro val) env rename-env local-renamed)
               env 
               rename-env 
               local-env local-renamed))
@@ -1181,7 +1181,7 @@
             (if (tagged-list? 'macro val)
               ;; Expand macro here so we can catch begins in the expanded code,
               ;; including nested begins
-              (let ((expanded (macro:expand this-exp val env rename-env)))
+              (let ((expanded (macro:expand this-exp val env rename-env local-renamed)))
 ;(log `(DONE WITH macro:expand))
                 (_expand-body
                   result