Make the effect of (defvar foo) local.

* src/eval.c (apply_lambda): Make static.  Remove eval_flag arg.
(Fsetq): Don't check declared_special.
(Fdefun, Fdefmacro): Use Ffunction.
(Fdefvar): Don't set declared_special for (defvar foo).
(FletX): Check locally-special vars.  Only do specbind once.
(Flet): Check locally-special vars.
(Feval): Don't check declared_special.
(funcall_lambda): Check locally-special vars.
* src/lisp.h (apply_lambda): Remove extern declaration.
* src/lread.c (readevalloop): CSE.
* lisp/subr.el (with-lexical-binding): Remove.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 65d422a..5a5b7ef 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2010-12-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * subr.el (with-lexical-binding): Remove.
+
 2010-06-18  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo):

diff --git a/lisp/subr.el b/lisp/subr.el
index c79a69b..99f632f 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -427,11 +427,11 @@ Non-strings in LIST are ignored."
     (setq list (cdr list)))
   list)
 
-(defmacro with-lexical-binding (&rest body)
-  "Execute the statements in BODY using lexical binding."
-  `(let ((internal-interpreter-environment internal-interpreter-environment))
-     (setq internal-interpreter-environment '(t))
-     ,@body))
+;; Remove this since we don't know how to handle it in the byte-compiler yet.
+;; (defmacro with-lexical-binding (&rest body)
+;;   "Execute the statements in BODY using lexical binding."
+;;   `(let ((internal-interpreter-environment '(t)))
+;;      ,@body))
 
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.

diff --git a/src/ChangeLog b/src/ChangeLog
index e1c0e6e..6abdf58 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,17 @@
+2010-12-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       Make the effect of (defvar foo) local.
+       * eval.c (apply_lambda): Make static.  Remove eval_flag arg.
+       (Fsetq): Don't check declared_special.
+       (Fdefun, Fdefmacro): Use Ffunction.
+       (Fdefvar): Don't set declared_special for (defvar foo).
+       (FletX): Check locally-special vars.  Only do specbind once.
+       (Flet): Check locally-special vars.
+       (Feval): Don't check declared_special.
+       (funcall_lambda): Check locally-special vars.
+       * lisp.h (apply_lambda): Remove extern declaration.
+       * lread.c (readevalloop): CSE.
+
 2010-07-23  Andreas Schwab  <schwab@linux-m68k.org>
 
        * eval.c (funcall_funvec): Replace bcopy by memcpy.

diff --git a/src/eval.c b/src/eval.c
index 574c4eb..63ea955 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -81,9 +81,12 @@ Lisp_Object Vrun_hooks;
 Lisp_Object Vautoload_queue;
 
 /* When lexical binding is being used, this is non-nil, and contains an
-   alist of lexically-bound variable, or t, indicating an empty
+   alist of lexically-bound variable, or (t), indicating an empty
    environment.  The lisp name of this variable is
-   `internal-interpreter-lexical-environment'.  */
+   `internal-interpreter-environment'.  Every element of this list
+   can be either a cons (VAR . VAL) specifying a lexical binding,
+   or a single symbol VAR indicating that this variable should use
+   dynamic scoping.  */
 
 Lisp_Object Vinternal_interpreter_environment;
 
@@ -175,6 +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 void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
@@ -505,10 +510,12 @@ usage: (setq [SYM VAL]...)  */)
       val = Feval (Fcar (Fcdr (args_left)));
       sym = Fcar (args_left);
 
-      if (!NILP (Vinternal_interpreter_environment)
+      /* Like for Feval, we do not check declared_special here since
+        it's been done when let-binding.  */
+      if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
          && SYMBOLP (sym)
-         && !XSYMBOL (sym)->declared_special
-         && !NILP (lex_binding = Fassq (sym, Vinternal_interpreter_environment)))
+         && !NILP (lex_binding
+                   = Fassq (sym, Vinternal_interpreter_environment)))
        XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
       else
        Fset (sym, val);        /* SYM is dynamically bound.  */
@@ -667,8 +674,8 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...)  */)
   fn_name = Fcar (args);
   CHECK_SYMBOL (fn_name);
   defn = Fcons (Qlambda, Fcdr (args));
-  if (! NILP (Vinternal_interpreter_environment))
-    defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn));
+  if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization!  */
+    defn = Ffunction (Fcons (defn, Qnil));
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   if (CONSP (XSYMBOL (fn_name)->function)
@@ -742,8 +749,8 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
     tail = Fcons (lambda_list, Fcons (doc, tail));
   
   defn = Fcons (Qlambda, tail);
-  if (! NILP (Vinternal_interpreter_environment))
-    defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn));
+  if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization!  */
+    defn = Ffunction (Fcons (defn, Qnil));
   defn = Fcons (Qmacro, defn);
 
   if (!NILP (Vpurify_flag))
@@ -888,16 +895,23 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
          Fput (sym, Qvariable_documentation, tem);
        }
       LOADHIST_ATTACH (sym);
+
+      if (SYMBOLP (sym))
+       XSYMBOL (sym)->declared_special = 1;
     }
+  else if (!NILP (Vinternal_interpreter_environment)
+          && !XSYMBOL (sym)->declared_special)
+    /* A simple (defvar foo) with lexical scoping does "nothing" except
+       declare that var to be dynamically scoped *locally* (i.e. within
+       the current file or let-block).  */
+    Vinternal_interpreter_environment =
+      Fcons (sym, Vinternal_interpreter_environment);
   else
     /* Simple (defvar <var>) should not count as a definition at all.
        It could get in the way of other definitions, and unloading this
        package could try to make the variable unbound.  */
     ;
-    
-  if (SYMBOLP (sym))
-    XSYMBOL (sym)->declared_special = 1;
-
+      
   return sym;
 }
 
@@ -1038,12 +1052,21 @@ usage: (let* VARLIST BODY...)  */)
          val = Feval (Fcar (Fcdr (elt)));
        }
 
-      if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special)
+      if (!NILP (lexenv) && SYMBOLP (var)
+         && !XSYMBOL (var)->declared_special
+         && NILP (Fmemq (var, Vinternal_interpreter_environment)))
        /* Lexically bind VAR by adding it to the interpreter's binding
           alist.  */
        {
-         lexenv = Fcons (Fcons (var, val), lexenv);
-         specbind (Qinternal_interpreter_environment, lexenv);
+         Lisp_Object newenv
+           = Fcons (Fcons (var, val), Vinternal_interpreter_environment);
+         if (EQ (Vinternal_interpreter_environment, lexenv))
+           /* Save the old lexical environment on the specpdl stack,
+              but only for the first lexical binding, since we'll never
+              need to revert to one of the intermediate ones.  */
+           specbind (Qinternal_interpreter_environment, newenv);
+         else
+           Vinternal_interpreter_environment = newenv;
        }
       else
        specbind (var, val);
@@ -1110,7 +1133,9 @@ usage: (let VARLIST BODY...)  */)
       var = SYMBOLP (elt) ? elt : Fcar (elt);
       tem = temps[argnum++];
 
-      if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special)
+      if (!NILP (lexenv) && SYMBOLP (var)
+         && !XSYMBOL (var)->declared_special
+         && NILP (Fmemq (var, Vinternal_interpreter_environment)))
        /* Lexically bind VAR by adding it to the lexenv alist.  */
        lexenv = Fcons (Fcons (var, tem), lexenv);
       else
@@ -2302,25 +2327,17 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
 
   if (SYMBOLP (form))
     {
-      /* If there's an active lexical environment, and the variable
-        isn't declared special, look up its binding in the lexical
-        environment.  */
-      if (!NILP (Vinternal_interpreter_environment)
-         && !XSYMBOL (form)->declared_special)
-       {
-         Lisp_Object lex_binding
-           = Fassq (form, Vinternal_interpreter_environment);
-
-         /* If we found a lexical binding for FORM, return the value.
-            Otherwise, we just drop through and look for a dynamic
-            binding -- the variable isn't declared special, but there's
-            not much else we can do, and Fsymbol_value will take care
-            of signaling an error if there is no binding at all.  */
-         if (CONSP (lex_binding))
-           return XCDR (lex_binding);
-       }
-      
-      return Fsymbol_value (form);
+      /* Look up its binding in the lexical environment.
+        We do not pay attention to the declared_special flag here, since we
+        already did that when let-binding the variable.  */
+      Lisp_Object lex_binding
+       = !NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
+       ? Fassq (form, Vinternal_interpreter_environment)
+       : Qnil;
+      if (CONSP (lex_binding))
+       return XCDR (lex_binding);
+      else
+       return Fsymbol_value (form);
     }
 
   if (!CONSP (form))
@@ -2485,7 +2502,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
        }
     }
   if (FUNVECP (fun))
-    val = apply_lambda (fun, original_args, 1, Qnil);
+    val = apply_lambda (fun, original_args, Qnil);
   else
     {
       if (EQ (fun, Qunbound))
@@ -2503,7 +2520,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
       if (EQ (funcar, Qmacro))
        val = Feval (apply1 (Fcdr (fun), original_args));
       else if (EQ (funcar, Qlambda))
-       val = apply_lambda (fun, original_args, 1,
+       val = apply_lambda (fun, original_args,
                            /* Only pass down the current lexical environment
                               if FUN is lexically embedded in FORM.  */
                            (CONSP (original_fun)
@@ -2513,7 +2530,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
               && CONSP (XCDR (fun))
               && CONSP (XCDR (XCDR (fun)))
               && EQ (XCAR (XCDR (XCDR (fun))), Qlambda))
-       val = apply_lambda (XCDR (XCDR (fun)), original_args, 1,
+       val = apply_lambda (XCDR (XCDR (fun)), original_args,
                            XCAR (XCDR (fun)));
       else
        xsignal1 (Qinvalid_function, original_fun);
@@ -3208,9 +3225,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
   return val;
 }
 \f
-Lisp_Object
-apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag,
-             Lisp_Object lexenv)
+static Lisp_Object
+apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv)
 {
   Lisp_Object args_left;
   Lisp_Object numargs;
@@ -3230,18 +3246,15 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag,
   for (i = 0; i < XINT (numargs);)
     {
       tem = Fcar (args_left), args_left = Fcdr (args_left);
-      if (eval_flag) tem = Feval (tem);
+      tem = Feval (tem);
       arg_vector[i++] = tem;
       gcpro1.nvars = i;
     }
 
   UNGCPRO;
 
-  if (eval_flag)
-    {
-      backtrace_list->args = arg_vector;
-      backtrace_list->nargs = i;
-    }
+  backtrace_list->args = arg_vector;
+  backtrace_list->nargs = i;
   backtrace_list->evalargs = 0;
   tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv);
 
@@ -3387,8 +3400,11 @@ funcall_lambda (Lisp_Object fun, int nargs,
            val = Qnil;
 
          /* Bind the argument.  */
-         if (!NILP (lexenv)
-             && SYMBOLP (next) && !XSYMBOL (next)->declared_special)
+         if (!NILP (lexenv) && SYMBOLP (next)
+             /* FIXME: there's no good reason to allow dynamic-scoping
+                on function arguments, other than consistency with let.  */
+             && !XSYMBOL (next)->declared_special
+             && NILP (Fmemq (next, Vinternal_interpreter_environment)))
            /* Lexically bind NEXT by adding it to the lexenv alist.  */
            lexenv = Fcons (Fcons (next, val), lexenv);
          else

diff --git a/src/lisp.h b/src/lisp.h
index 36653e9..aafa388 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2985,7 +2985,6 @@ extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Li
 extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
 extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
 EXFUN (Fdo_auto_save, 2);
-extern Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int, Lisp_Object);
 extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
 extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
 extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));

diff --git a/src/lread.c b/src/lread.c
index 83c94b0..d85d146 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -1767,10 +1767,9 @@ readevalloop (Lisp_Object readcharfun,
      the file's header, or via a buffer-local variable), create an empty
      lexical environment, otherwise, turn off lexical binding.  */
   lex_bound = find_symbol_value (Qlexical_binding);
-  if (NILP (lex_bound) || EQ (lex_bound, Qunbound))
-    specbind (Qinternal_interpreter_environment, Qnil);
-  else
-    specbind (Qinternal_interpreter_environment, Fcons (Qt, Qnil));
+  specbind (Qinternal_interpreter_environment,
+           NILP (lex_bound) || EQ (lex_bound, Qunbound)
+           ? Qnil : Fcons (Qt, Qnil));
 
   GCPRO4 (sourcename, readfun, start, end);