diff --git a/src/CHANGELOG b/src/CHANGELOG index 313bb9813..e014619cb 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -241,6 +241,16 @@ ECL 0.9i code for multiple value calls and other structures such as unwind-protect forms. + - The functions created by MACROLET must be compiled taking into account other + enclosing MACROLET and SYMBOL-MACRO definitions. This allows one to write + something like + (defun a () + (symbol-macro ((x 1)) + (macrolet ((m () x)) + (m)))) + (a) => 1 + This has been achieved by merging the C and bytecodes compiler environments. + * Documentation: - The HTML manuals now use CSS for a more appealing look. diff --git a/src/c/compiler.d b/src/c/compiler.d index d0c20f2d8..7f218bbc1 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -416,14 +416,17 @@ c_new_env(struct cl_compiler_env *new_c_env, cl_object env) ENV->coalesce = TRUE; ENV->macros = Cnil; ENV->lexical_level = 0; + ENV->constants = Cnil; if (Null(env)) { - ENV->constants = Cnil; + ENV->macros = Cnil; ENV->variables = Cnil; } else { ENV->variables = CAR(env); ENV->macros = CDR(env); for (env = ENV->variables; !Null(env); env = CDR(env)) { cl_object record = CAR(env); + if (ATOM(record)) + continue; if (SYMBOLP(CAR(record)) && CADR(record) != @'si::symbol-macro') { continue; } else { @@ -438,11 +441,13 @@ static cl_object c_tag_ref(cl_object the_tag, cl_object the_type) { cl_fixnum n = 0; - cl_object l; + cl_object l, record, type, name; for (l = ENV->variables; CONSP(l); l = CDR(l)) { - cl_object record = CAR(l); - cl_object type = CAR(record); - cl_object name = CADR(record); + record = CAR(l); + if (ATOM(record)) + continue; + type = CAR(record); + name = CADR(record); if (type == @':tag') { if (type == the_type && !Null(assql(the_tag, name))) return CONS(MAKE_FIXNUM(n), @@ -466,11 +471,13 @@ static cl_fixnum c_var_ref(cl_object var, int allow_symbol_macro, bool ensure_defined) { cl_fixnum n = 0; - cl_object l; + cl_object l, record, special, name; for (l = ENV->variables; CONSP(l); l = CDR(l)) { - cl_object record = CAR(l); - cl_object name = CAR(record); - cl_object special = CADR(record); + record = CAR(l); + if (ATOM(record)) + continue; + name = CAR(record); + special = CADR(record); if (name == @':block' || name == @':tag' || name == @':function') n++; else if (name != var) { diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp index a0675da2b..334006def 100644 --- a/src/cmp/cmpenv.lsp +++ b/src/cmp/cmpenv.lsp @@ -461,7 +461,7 @@ (defun cmp-env-register-symbol-macro (name form &optional (env *cmp-env*)) (push (list name 'si::symbol-macro #'(lambda (whole env) form)) - (cmp-env-functions env))) + (cmp-env-variables env))) (defun cmp-env-register-block (blk &optional (env *cmp-env*)) (push (list :block (blk-name blk) blk) diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp index fe3c31da3..5011a0a74 100644 --- a/src/cmp/cmpflet.lsp +++ b/src/cmp/cmpflet.lsp @@ -196,13 +196,15 @@ (defun c1macrolet (args) (check-args-number 'MACROLET args 1) - (let ((*cmp-env* (cmp-env-copy))) + (let ((old-cmp-env *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))) "The macro definition ~s is illegal." def) - (cmp-env-register-macro name - (si::eval-with-env (sys::expand-defmacro name (second def) (cddr def)))))) + (let* ((form (si::expand-defmacro name (second def) (cddr def))) + (fun (si::eval-with-env form old-cmp-env nil t))) + (cmp-env-register-macro name fun)))) (c1locally (cdr args)))) (defun c1symbol-macrolet (args) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index bcee1cfa2..28e6cb67d 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -139,14 +139,14 @@ ~%;;; You are recommended to compile again.~%" form)))) -(defun cmp-macroexpand (form &optional (env (cons nil (cdr *cmp-env*)))) +(defun cmp-macroexpand (form &optional (env *cmp-env*)) (with-cmp-protection (macroexpand form env) (let ((*print-case* :upcase)) (print-current-form) (format t "~&;;; The macro form ~S was not expanded successfully.~ ~%;;; You are recommended to compile again.~%" form)))) -(defun cmp-expand-macro (fd form &optional (env (cons nil (cdr *cmp-env*)))) +(defun cmp-expand-macro (fd form &optional (env *cmp-env*)) (with-cmp-protection (let ((new-form (funcall *macroexpand-hook* fd form env))) (values new-form (not (eql new-form form))))