From a2fdf244f7cc4974c664a8a17ab4a43a2efe5347 Mon Sep 17 00:00:00 2001
From: jgarcia <jgarcia>
Date: Sat, 17 Jun 2006 16:01:04 +0000
Subject: [PATCH] Make MACROLET a bit safer -- a least in the C compiler.

---
 src/CHANGELOG       |  3 +++
 src/c/compiler.d    |  2 ++
 src/cmp/cmpenv.lsp  | 38 +++++++++++++++++++++++++++++++++++++-
 src/cmp/cmpflet.lsp |  8 ++++++--
 4 files changed, 48 insertions(+), 3 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index e014619cb..92f7bfa44 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -250,6 +250,9 @@ ECL 0.9i
 	      (m))))
 	(a) => 1
    This has been achieved by merging the C and bytecodes compiler environments.
+   We have tried to implement this questionable feaure in the safest way, so
+   that references to local variables and functions cause an error at least in
+   compiled forms.
 
 * Documentation:
 
diff --git a/src/c/compiler.d b/src/c/compiler.d
index 7f218bbc1..2e93511b5 100644
--- a/src/c/compiler.d
+++ b/src/c/compiler.d
@@ -308,6 +308,8 @@ asm_op2c(register int code, register cl_object o) {
 }
 
 /*
+ * Note: the following should match the definitions in cmpenv.lsp
+ *
  * The compiler environment consists of two lists, one stored in
  * env->variables, the other one stored in env->macros.
  *
diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp
index 334006def..a5595889e 100644
--- a/src/cmp/cmpenv.lsp
+++ b/src/cmp/cmpenv.lsp
@@ -546,4 +546,40 @@
   (loop for i in (ldiff (cmp-env-variables *cmp-env*)
 			(cmp-env-variables old-env))
 	when (and (consp i) (var-p (fourth i)))
-	collect (fourth i)))
\ No newline at end of file
+	collect (fourth i)))
+
+(defun cmp-env-for-bytecodes (old-env)
+  "Produce an environment which is safe to pass to the bytecodes
+compiler. We remove all blocks and tags and ensure that
+references to local variables will cause an error. This
+environment can be used to bytecompile the functions in MACROLET
+or SYMBOL-MACRO forms, and also to evaluate other forms."
+  (labels
+      ((local-var-error-function (name)
+	  #'(lambda (whole env)
+	      (error
+"In a MACROLET function you tried to access a local variable, ~A~%
+from the function in which it appears." name)))
+       (filter-var-definition (i)
+	 (unless (atom i)
+	   (let ((name (first i)))
+	     (unless (keywordp name)
+	       (case (second i)
+		 (si::symbol-macro i)
+		 (:special i)
+		 (t (list name 'si::symbol-macro (local-var-error-function name))))))))
+       (local-fun-error-function (name)
+	  #'(lambda (whole env)
+	      (error
+"In a MACROLET function you tried to access a local function, ~A~%
+from the function in which it appears." name)))
+       (filter-fun-definition (i)
+	 (unless (atom i)
+	   (if (eq (second i 'SI::MACRO))
+	       i
+	       (list (first i) 'SI:MACRO (local-fun-error-function (first i)))))))
+    (cons (loop for i in (car old-env)
+		with x
+		when (setf x (filter-var-definition i))
+		collect x)
+	  (cdr old-env))))
diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp
index 5011a0a74..0d309a2f8 100644
--- a/src/cmp/cmpflet.lsp
+++ b/src/cmp/cmpflet.lsp
@@ -196,8 +196,12 @@
 
 (defun c1macrolet (args)
   (check-args-number 'MACROLET args 1)
-  (let ((old-cmp-env *cmp-env*)
-	(*cmp-env* (cmp-env-copy)))	
+  ;; We have to compile each function in the MACROLET and install them
+  ;; in our enviroment as macros. Note that when compiling these forms
+  ;; we have to do it using an environment that contains all enclosing
+  ;; symbol-macro and macrolet forms! Hence the CMP-ENV-FOR-BYTECODES.
+  (let ((old-cmp-env (cmp-env-for-bytecodes *cmp-env*))
+	(*cmp-env* (cmp-env-copy)))
     (dolist (def (car args))
       (let ((name (first def)))
 	(cmpck (or (endp def) (not (symbolp name)) (endp (cdr def)))