From c5271f05fe74920971e0fc65fc462405c6f0ad43 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 27 Nov 2017 18:52:13 -0500
Subject: [PATCH] Relocating code

---
 scheme/cyclone/macros.sld | 140 -------------------------------------
 scheme/eval.sld           | 142 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 142 insertions(+), 140 deletions(-)

diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld
index 0015636d..c09751ba 100644
--- a/scheme/cyclone/macros.sld
+++ b/scheme/cyclone/macros.sld
@@ -13,148 +13,8 @@
           (scheme cyclone util)
   )
   (export
-    macro:macro?
-    macro:expand
-    macro:add!
-    macro:cleanup
-    macro:load-env!
-    macro:get-env
-    macro:get-defined-macros
   )
   (inline
     macro:macro?)
   (begin
-    ;; top-level macro environment
-    (define *macro:env* '())
-
-    ;; A list of all macros defined by the program/library being compiled
-    (define *macro:defined-macros* '())
-
-    (define (macro:add! name body)
-      (set! *macro:defined-macros* 
-        (cons (cons name body) *macro:defined-macros*))
-      #t)
-
-    (define (macro:load-env! defined-macros base-env)
-      (set! *macro:env* (env:extend-environment
-                          (map car defined-macros)
-                          (map (lambda (v)
-                                 (list 'macro (cdr v)))
-                               defined-macros)
-                          base-env)))
-
-    (define (macro:get-env) *macro:env*)
-
-    (define (macro:get-defined-macros) *macro:defined-macros*)
-
-    ;; Macro section
-    (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros))
-
-    (define (macro:expand exp macro mac-env rename-env)
-      (let* ((use-env (env:extend-environment '() '() '()))
-             (compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro)))
-                                  (procedure? (cadr macro))))
-             (result #f))
-        ;(newline)
-        ;(display "/* ")
-        ;(display (list 'macro:expand exp macro compiled-macro?))
-        ;(display "*/ ")
-
-          ;; Invoke ER macro
-        (set! result
-          (cond
-            ((not macro)
-              (error "macro not found" exp))
-            (compiled-macro?
-              ((Cyc-get-cvar (cadr macro))
-                exp
-                (Cyc-er-rename use-env mac-env)
-                (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-compare? use-env rename-env))
-                mac-env))))
-;        (newline)
-;        (display "/* ")
-;        (display (list 'macro:expand exp macro compiled-macro?))
-;        (newline)
-;        (display (list result))
-;        (display "*/ ")
-          (macro:add-renamed-vars! use-env rename-env)
-          result))
-
-    (define (macro:add-renamed-vars! env renamed-env)
-      (let ((frame (env:first-frame renamed-env)))
-        (for-each
-          (lambda (var val)
-            (env:add-binding-to-frame! var val frame))
-          (env:all-variables env)
-          (env:all-values env))))
-
-    (define (macro:cleanup expr rename-env)
-      (define (clean expr bv) ;; Bound variables
-;(newline)
-;(display "/* macro:cleanup->clean, bv =")
-;(write bv)
-;(newline)
-;(write expr)
-;(newline)
-;(display "*/ ")
-         (cond 
-           ((const? expr)      expr)
-           ((null? expr)       expr)
-           ((quote? expr)      
-            (let ((atom (cadr expr)))
-              ;; Clean up any renamed symbols that are quoted
-              ;; TODO: good enough for quoted pairs or do
-              ;;       we need to traverse those, too?
-              (if (ref? atom)
-                 `(quote ,(clean atom bv))
-                 expr)))
-           ((define-c? expr)   expr)
-           ((ref? expr)        
-            ;; if symbol has been renamed and is not a bound variable,
-            ;; undo the rename
-            (let ((val (env:lookup expr rename-env #f)))
-              (if (and val (not (member expr bv)))
-                  (clean val bv)
-                  expr)))
-           ((if-syntax? expr)
-            `(if ,(clean (if->condition expr) bv)
-                 ,(clean (if->then expr) bv)
-                 ,(if (if-else? expr)
-                      (clean (if->else expr) bv)
-                      #f)))
-           ((lambda? expr)
-            `(lambda ,(lambda->formals expr)
-               ,@(map (lambda (e) 
-                        (clean e (append 
-                                   (lambda-formals->list expr) 
-                                   bv)))
-                      (lambda->exp expr))))
-           ;; At this point defines cannot be in lambda form. 
-           ;; EG: (define (f x) ...)
-           ((define? expr)
-            (let ((bv* (cons (define->var expr) bv)))
-              `(define ,(define->var expr)
-                       ,@(map
-                          (lambda (e) (clean e bv*)) 
-                          (define->exp expr)))))
-           ;; For now, assume set is not introducing a new binding
-           ((set!? expr)
-            `(set! ,(clean (set!->var expr) bv)
-                   ,(clean (set!->exp expr) bv)))
-           ((app? expr) 
-            (map (lambda (e) (clean e bv)) 
-                 expr))
-           (else
-            (error "macro cleanup unexpected expression: " expr))))
-      (clean expr '()))
-      
-    ; TODO: get macro name, transformer
-    ; TODO: let-syntax forms
   ))
diff --git a/scheme/eval.sld b/scheme/eval.sld
index 78bbe3c8..d5421f3b 100644
--- a/scheme/eval.sld
+++ b/scheme/eval.sld
@@ -25,6 +25,13 @@
     %import
     imported?
     %set-import-dirs!
+    macro:macro?
+    macro:expand
+    macro:add!
+    macro:cleanup
+    macro:load-env!
+    macro:get-env
+    macro:get-defined-macros
   )
   (inline
     primitive-implementation
@@ -43,6 +50,7 @@
     assignment-value
     assignment-variable
     variable?
+    macro:macro?
   )
   (begin
 
@@ -663,4 +671,138 @@
   " Cyc_check_str(data, name);
     return_closcall1(data, k, is_library_loaded(string_str(name))); ")
 
+;; Macro section
+    ;; top-level macro environment
+    (define *macro:env* '())
+
+    ;; A list of all macros defined by the program/library being compiled
+    (define *macro:defined-macros* '())
+
+    (define (macro:add! name body)
+      (set! *macro:defined-macros* 
+        (cons (cons name body) *macro:defined-macros*))
+      #t)
+
+    (define (macro:load-env! defined-macros base-env)
+      (set! *macro:env* (env:extend-environment
+                          (map car defined-macros)
+                          (map (lambda (v)
+                                 (list 'macro (cdr v)))
+                               defined-macros)
+                          base-env)))
+
+    (define (macro:get-env) *macro:env*)
+
+    (define (macro:get-defined-macros) *macro:defined-macros*)
+
+    ;; Macro section
+    (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros))
+
+    (define (macro:expand exp macro mac-env rename-env)
+      (let* ((use-env (env:extend-environment '() '() '()))
+             (compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro)))
+                                  (procedure? (cadr macro))))
+             (result #f))
+        ;(newline)
+        ;(display "/* ")
+        ;(display (list 'macro:expand exp macro compiled-macro?))
+        ;(display "*/ ")
+
+          ;; Invoke ER macro
+        (set! result
+          (cond
+            ((not macro)
+              (error "macro not found" exp))
+            (compiled-macro?
+              ((Cyc-get-cvar (cadr macro))
+                exp
+                (Cyc-er-rename use-env mac-env)
+                (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-compare? use-env rename-env))
+                mac-env))))
+;        (newline)
+;        (display "/* ")
+;        (display (list 'macro:expand exp macro compiled-macro?))
+;        (newline)
+;        (display (list result))
+;        (display "*/ ")
+          (macro:add-renamed-vars! use-env rename-env)
+          result))
+
+    (define (macro:add-renamed-vars! env renamed-env)
+      (let ((frame (env:first-frame renamed-env)))
+        (for-each
+          (lambda (var val)
+            (env:add-binding-to-frame! var val frame))
+          (env:all-variables env)
+          (env:all-values env))))
+
+    (define (macro:cleanup expr rename-env)
+      (define (clean expr bv) ;; Bound variables
+;(newline)
+;(display "/* macro:cleanup->clean, bv =")
+;(write bv)
+;(newline)
+;(write expr)
+;(newline)
+;(display "*/ ")
+         (cond 
+           ((const? expr)      expr)
+           ((null? expr)       expr)
+           ((quote? expr)      
+            (let ((atom (cadr expr)))
+              ;; Clean up any renamed symbols that are quoted
+              ;; TODO: good enough for quoted pairs or do
+              ;;       we need to traverse those, too?
+              (if (ref? atom)
+                 `(quote ,(clean atom bv))
+                 expr)))
+           ((define-c? expr)   expr)
+           ((ref? expr)        
+            ;; if symbol has been renamed and is not a bound variable,
+            ;; undo the rename
+            (let ((val (env:lookup expr rename-env #f)))
+              (if (and val (not (member expr bv)))
+                  (clean val bv)
+                  expr)))
+           ((if-syntax? expr)
+            `(if ,(clean (if->condition expr) bv)
+                 ,(clean (if->then expr) bv)
+                 ,(if (if-else? expr)
+                      (clean (if->else expr) bv)
+                      #f)))
+           ((lambda? expr)
+            `(lambda ,(lambda->formals expr)
+               ,@(map (lambda (e) 
+                        (clean e (append 
+                                   (lambda-formals->list expr) 
+                                   bv)))
+                      (lambda->exp expr))))
+           ;; At this point defines cannot be in lambda form. 
+           ;; EG: (define (f x) ...)
+           ((define? expr)
+            (let ((bv* (cons (define->var expr) bv)))
+              `(define ,(define->var expr)
+                       ,@(map
+                          (lambda (e) (clean e bv*)) 
+                          (define->exp expr)))))
+           ;; For now, assume set is not introducing a new binding
+           ((set!? expr)
+            `(set! ,(clean (set!->var expr) bv)
+                   ,(clean (set!->exp expr) bv)))
+           ((app? expr) 
+            (map (lambda (e) (clean e bv)) 
+                 expr))
+           (else
+            (error "macro cleanup unexpected expression: " expr))))
+      (clean expr '()))
+      
+    ; TODO: get macro name, transformer
+    ; TODO: let-syntax forms
   ))