Try and be more careful about propagation of lexical environment.

* src/eval.c (apply_lambda, funcall_lambda): Remove lexenv arg.
(Feval): Always eval in the empty environment.
(eval_sub): New function.  Use it for all calls to Feval that should
evaluate in the lexical environment of the caller.
Pass `closure's as is to apply_lambda.
(Ffuncall): Pass `closure's as is to funcall_lambda.
(funcall_lambda): Extract lexenv for `closure's, when applicable.
Also use lexical scoping for the &rest argument, if applicable.
* src/lisp.h (eval_sub): Declare.
* src/lread.c (readevalloop): Remove `evalfun' argument.
* src/print.c (Fwith_output_to_temp_buffer):
* src/data.c (Fsetq_default): Use eval_sub.
* lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push.

1 files changed, 67 insertions, 66 deletions

diff --git a/src/eval.c b/src/eval.c
index 74dd7e63aa1..485ba00c1e4 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -178,10 +178,8 @@ int handling_signal;
 
 Lisp_Object Vmacro_declaration_function;
 
-static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args,
-				 Lisp_Object lexenv);
-static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *,
-				   Lisp_Object);
+static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
+static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *);
 static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
 
 void
@@ -308,7 +306,7 @@ usage: (or CONDITIONS...)  */)
 
   while (CONSP (args))
     {
-      val = Feval (XCAR (args));
+      val = eval_sub (XCAR (args));
       if (!NILP (val))
 	break;
       args = XCDR (args);
@@ -332,7 +330,7 @@ usage: (and CONDITIONS...)  */)
 
   while (CONSP (args))
     {
-      val = Feval (XCAR (args));
+      val = eval_sub (XCAR (args));
       if (NILP (val))
 	break;
       args = XCDR (args);
@@ -354,11 +352,11 @@ usage: (if COND THEN ELSE...)  */)
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  cond = Feval (Fcar (args));
+  cond = eval_sub (Fcar (args));
   UNGCPRO;
 
   if (!NILP (cond))
-    return Feval (Fcar (Fcdr (args)));
+    return eval_sub (Fcar (Fcdr (args)));
   return Fprogn (Fcdr (Fcdr (args)));
 }
 
@@ -382,7 +380,7 @@ usage: (cond CLAUSES...)  */)
   while (!NILP (args))
     {
       clause = Fcar (args);
-      val = Feval (Fcar (clause));
+      val = eval_sub (Fcar (clause));
       if (!NILP (val))
 	{
 	  if (!EQ (XCDR (clause), Qnil))
@@ -408,7 +406,7 @@ usage: (progn BODY...)  */)
 
   while (CONSP (args))
     {
-      val = Feval (XCAR (args));
+      val = eval_sub (XCAR (args));
       args = XCDR (args);
     }
 
@@ -438,9 +436,9 @@ usage: (prog1 FIRST BODY...)  */)
   do
     {
       if (!(argnum++))
-	val = Feval (Fcar (args_left));
+	val = eval_sub (Fcar (args_left));
       else
-	Feval (Fcar (args_left));
+	eval_sub (Fcar (args_left));
       args_left = Fcdr (args_left);
     }
   while (!NILP(args_left));
@@ -473,9 +471,9 @@ usage: (prog2 FORM1 FORM2 BODY...)  */)
   do
     {
       if (!(argnum++))
-	val = Feval (Fcar (args_left));
+	val = eval_sub (Fcar (args_left));
       else
-	Feval (Fcar (args_left));
+	eval_sub (Fcar (args_left));
       args_left = Fcdr (args_left);
     }
   while (!NILP (args_left));
@@ -507,10 +505,10 @@ usage: (setq [SYM VAL]...)  */)
 
   do
     {
-      val = Feval (Fcar (Fcdr (args_left)));
+      val = eval_sub (Fcar (Fcdr (args_left)));
       sym = Fcar (args_left);
 
-      /* Like for Feval, we do not check declared_special here since
+      /* Like for eval_sub, we do not check declared_special here since
 	 it's been done when let-binding.  */
       if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
 	  && SYMBOLP (sym)
@@ -870,7 +868,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
 	}
 
       if (NILP (tem))
-	Fset_default (sym, Feval (Fcar (tail)));
+	Fset_default (sym, eval_sub (Fcar (tail)));
       else
 	{ /* Check if there is really a global binding rather than just a let
 	     binding that shadows the global unboundness of the var.  */
@@ -935,7 +933,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
   if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
     error ("Too many arguments");
 
-  tem = Feval (Fcar (Fcdr (args)));
+  tem = eval_sub (Fcar (Fcdr (args)));
   if (!NILP (Vpurify_flag))
     tem = Fpurecopy (tem);
   Fset_default (sym, tem);
@@ -1049,7 +1047,7 @@ usage: (let* VARLIST BODY...)  */)
       else
 	{
 	  var = Fcar (elt);
-	  val = Feval (Fcar (Fcdr (elt)));
+	  val = eval_sub (Fcar (Fcdr (elt)));
 	}
 
       if (!NILP (lexenv) && SYMBOLP (var)
@@ -1117,7 +1115,7 @@ usage: (let VARLIST BODY...)  */)
       else if (! NILP (Fcdr (Fcdr (elt))))
 	signal_error ("`let' bindings can have only one value-form", elt);
       else
-	temps [argnum++] = Feval (Fcar (Fcdr (elt)));
+	temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
       gcpro2.nvars = argnum;
     }
   UNGCPRO;
@@ -1166,7 +1164,7 @@ usage: (while TEST BODY...)  */)
 
   test = Fcar (args);
   body = Fcdr (args);
-  while (!NILP (Feval (test)))
+  while (!NILP (eval_sub (test)))
     {
       QUIT;
       Fprogn (body);
@@ -1268,7 +1266,7 @@ usage: (catch TAG BODY...)  */)
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  tag = Feval (Fcar (args));
+  tag = eval_sub (Fcar (args));
   UNGCPRO;
   return internal_catch (tag, Fprogn, Fcdr (args));
 }
@@ -1401,7 +1399,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
   int count = SPECPDL_INDEX ();
 
   record_unwind_protect (Fprogn, Fcdr (args));
-  val = Feval (Fcar (args));
+  val = eval_sub (Fcar (args));
   return unbind_to (count, val);
 }
 
@@ -1502,7 +1500,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
   h.tag = &c;
   handlerlist = &h;
 
-  val = Feval (bodyform);
+  val = eval_sub (bodyform);
   catchlist = c.next;
   handlerlist = h.next;
   return val;
@@ -2317,6 +2315,16 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
        doc: /* Evaluate FORM and return its value.  */)
   (Lisp_Object form)
 {
+  int count = SPECPDL_INDEX ();
+  specbind (Qinternal_interpreter_environment, Qnil);
+  return unbind_to (count, eval_sub (form));
+}
+
+/* Eval a sub-expression of the current expression (i.e. in the same
+   lexical scope).  */
+Lisp_Object
+eval_sub (Lisp_Object form)
+{
   Lisp_Object fun, val, original_fun, original_args;
   Lisp_Object funcar;
   struct backtrace backtrace;
@@ -2424,7 +2432,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
 
 	  while (!NILP (args_left))
 	    {
-	      vals[argnum++] = Feval (Fcar (args_left));
+	      vals[argnum++] = eval_sub (Fcar (args_left));
 	      args_left = Fcdr (args_left);
 	      gcpro3.nvars = argnum;
 	    }
@@ -2445,7 +2453,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
       maxargs = XSUBR (fun)->max_args;
       for (i = 0; i < maxargs; args_left = Fcdr (args_left))
 	{
-	  argvals[i] = Feval (Fcar (args_left));
+	  argvals[i] = eval_sub (Fcar (args_left));
 	  gcpro3.nvars = ++i;
 	}
 
@@ -2502,7 +2510,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
 	}
     }
   if (FUNVECP (fun))
-    val = apply_lambda (fun, original_args, Qnil);
+    val = apply_lambda (fun, original_args);
   else
     {
       if (EQ (fun, Qunbound))
@@ -2518,20 +2526,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
 	  goto retry;
 	}
       if (EQ (funcar, Qmacro))
-	val = Feval (apply1 (Fcdr (fun), original_args));
-      else if (EQ (funcar, Qlambda))
-	val = apply_lambda (fun, original_args,
-			    /* Only pass down the current lexical environment
-			       if FUN is lexically embedded in FORM.  */
-			    (CONSP (original_fun)
-			     ? Vinternal_interpreter_environment
-			     : Qnil));
-      else if (EQ (funcar, Qclosure)
-	       && CONSP (XCDR (fun))
-	       && CONSP (XCDR (XCDR (fun)))
-	       && EQ (XCAR (XCDR (XCDR (fun))), Qlambda))
-	val = apply_lambda (XCDR (XCDR (fun)), original_args,
-			    XCAR (XCDR (fun)));
+	val = eval_sub (apply1 (Fcdr (fun), original_args));
+      else if (EQ (funcar, Qlambda)
+	       || EQ (funcar, Qclosure))
+	val = apply_lambda (fun, original_args);
       else
 	xsignal1 (Qinvalid_function, original_fun);
     }
@@ -3189,7 +3187,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
     }
 
   if (FUNVECP (fun))
-    val = funcall_lambda (fun, numargs, args + 1, Qnil);
+    val = funcall_lambda (fun, numargs, args + 1);
   else
     {
       if (EQ (fun, Qunbound))
@@ -3199,14 +3197,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
       funcar = XCAR (fun);
       if (!SYMBOLP (funcar))
 	xsignal1 (Qinvalid_function, original_fun);
-      if (EQ (funcar, Qlambda))
-	val = funcall_lambda (fun, numargs, args + 1, Qnil);
-      else if (EQ (funcar, Qclosure)
-	       && CONSP (XCDR (fun))
-	       && CONSP (XCDR (XCDR (fun)))
-	       && EQ (XCAR (XCDR (XCDR (fun))), Qlambda))
-	val = funcall_lambda (XCDR (XCDR (fun)), numargs, args + 1,
-			      XCAR (XCDR (fun)));
+      if (EQ (funcar, Qlambda)
+	  || EQ (funcar, Qclosure))
+	val = funcall_lambda (fun, numargs, args + 1);
       else if (EQ (funcar, Qautoload))
 	{
 	  do_autoload (fun, original_fun);
@@ -3226,7 +3219,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 }
 
 static Lisp_Object
-apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv)
+apply_lambda (Lisp_Object fun, Lisp_Object args)
 {
   Lisp_Object args_left;
   Lisp_Object numargs;
@@ -3246,7 +3239,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv)
   for (i = 0; i < XINT (numargs);)
     {
       tem = Fcar (args_left), args_left = Fcdr (args_left);
-      tem = Feval (tem);
+      tem = eval_sub (tem);
       arg_vector[i++] = tem;
       gcpro1.nvars = i;
     }
@@ -3256,7 +3249,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv)
   backtrace_list->args = arg_vector;
   backtrace_list->nargs = i;
   backtrace_list->evalargs = 0;
-  tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv);
+  tem = funcall_lambda (fun, XINT (numargs), arg_vector);
 
   /* Do the debug-on-exit now, while arg_vector still exists.  */
   if (backtrace_list->debug_on_exit)
@@ -3321,10 +3314,9 @@ funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args)
 
 static Lisp_Object
 funcall_lambda (Lisp_Object fun, int nargs,
-		register Lisp_Object *arg_vector,
-		Lisp_Object lexenv)
+		register Lisp_Object *arg_vector)
 {
-  Lisp_Object val, syms_left, next;
+  Lisp_Object val, syms_left, next, lexenv;
   int count = SPECPDL_INDEX ();
   int i, optional, rest;
 
@@ -3358,6 +3350,14 @@ funcall_lambda (Lisp_Object fun, int nargs,
 
   if (CONSP (fun))
     {
+      if (EQ (XCAR (fun), Qclosure))
+	{
+	  fun = XCDR (fun);	/* Drop `closure'.  */
+	  lexenv = XCAR (fun);
+	  fun = XCDR (fun);	/* Drop the lexical environment.  */
+	}
+      else
+	lexenv = Qnil;
       syms_left = XCDR (fun);
       if (CONSP (syms_left))
 	syms_left = XCAR (syms_left);
@@ -3365,7 +3365,10 @@ funcall_lambda (Lisp_Object fun, int nargs,
 	xsignal1 (Qinvalid_function, fun);
     }
   else if (COMPILEDP (fun))
-    syms_left = AREF (fun, COMPILED_ARGLIST);
+    {
+      syms_left = AREF (fun, COMPILED_ARGLIST);
+      lexenv = Qnil;
+    }
   else
     abort ();
 
@@ -3382,23 +3385,21 @@ funcall_lambda (Lisp_Object fun, int nargs,
 	rest = 1;
       else if (EQ (next, Qand_optional))
 	optional = 1;
-      else if (rest)
-	{
-	  specbind (next, Flist (nargs - i, &arg_vector[i]));
-	  i = nargs;
-	}
       else
 	{
 	  Lisp_Object val;
-
-	  /* Get the argument's actual value.  */
-	  if (i < nargs)
+	  if (rest)
+	    {
+	      val = Flist (nargs - i, &arg_vector[i]);
+	      i = nargs;
+	    }
+	  else if (i < nargs)
 	    val = arg_vector[i++];
 	  else if (!optional)
 	    xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
 	  else
 	    val = Qnil;
-
+	    
 	  /* Bind the argument.  */
 	  if (!NILP (lexenv) && SYMBOLP (next)
 	      /* FIXME: there's no good reason to allow dynamic-scoping