Make MACROLET a bit safer -- a least in the C compiler.

This commit is contained in:
jgarcia 2006-06-17 16:01:04 +00:00
parent fd3aeae14a
commit a2fdf244f7
4 changed files with 48 additions and 3 deletions

View file

@ -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:

View file

@ -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.
*

View file

@ -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)))
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))))

View file

@ -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)))