Various compiler bug-fixes. MPC seems to run correctly now.

* lisp/files.el (lexical-binding): Add a safe-local-variable property.

* lisp/emacs-lisp/byte-opt.el (byte-inline-lapcode): Check how many elements
are added to the stack.
(byte-compile-splice-in-already-compiled-code): Don't touch lexical nor
byte-compile-depth now that byte-inline-lapcode does it for us.
(byte-compile-inline-expand): Don't inline dynbind byte code into
lexbind code, since it has to be done differently.

* lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn):
Correctly extract arglist from `closure's.
(byte-compile-cl-warn): Compiler-macros are run earlier now.
(byte-compile-top-level): Bind byte-compile-lexical-environment to nil,
except for lambdas.
(byte-compile-form): Don't run the compiler-macro expander here.
(byte-compile-let): Merge with byte-compile-let*.
Don't preserve-body-value if the body's value was discarded.

* lisp/emacs-lisp/cconv.el (cconv--set-diff, cconv--set-diff-map)
(cconv--map-diff, cconv--map-diff-elem, cconv--map-diff-set): New funs.
(cconv--env-var): New constant.
(cconv-closure-convert-rec): Use it and use them.  Fix a typo that
ended up forgetting to remove entries from lmenvs in `let'.
For `lambda' use the outer `fvrs' when building the closure and don't
forget to remove `vars' from the `emvrs' and `lmenvs' of the body.

* lisp/emacs-lisp/cl-macs.el (cl-byte-compile-block): Disable optimization
in lexbind, because it needs a different implementation.

* src/bytecode.c (exec_byte_code): Fix handling of &rest.

* src/eval.c (Vinternal_interpreter_environment): Remove.
(syms_of_eval): Do declare Vinternal_interpreter_environment as
a global lisp var, but unintern it to hide it.
(Fcommandp):
* src/data.c (Finteractive_form): Understand `closure's.

lisp/ChangeLog

@@ -1,3 +1,34 @@
+2011-02-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* files.el (lexical-binding): Add a safe-local-variable property.
+
+	* emacs-lisp/cl-macs.el (cl-byte-compile-block): Disable optimization
+	in lexbind, because it needs a different implementation.
+
+	* emacs-lisp/cconv.el (cconv--set-diff, cconv--set-diff-map)
+	(cconv--map-diff, cconv--map-diff-elem, cconv--map-diff-set): New funs.
+	(cconv--env-var): New constant.
+	(cconv-closure-convert-rec): Use it and use them.  Fix a typo that
+	ended up forgetting to remove entries from lmenvs in `let'.
+	For `lambda' use the outer `fvrs' when building the closure and don't
+	forget to remove `vars' from the `emvrs' and `lmenvs' of the body.
+
+	* emacs-lisp/bytecomp.el (byte-compile-arglist-warn):
+	Correctly extract arglist from `closure's.
+	(byte-compile-cl-warn): Compiler-macros are run earlier now.
+	(byte-compile-top-level): Bind byte-compile-lexical-environment to nil,
+	except for lambdas.
+	(byte-compile-form): Don't run the compiler-macro expander here.
+	(byte-compile-let): Merge with byte-compile-let*.
+	Don't preserve-body-value if the body's value was discarded.
+
+	* emacs-lisp/byte-opt.el (byte-inline-lapcode): Check how many elements
+	are added to the stack.
+	(byte-compile-splice-in-already-compiled-code): Don't touch lexical nor
+	byte-compile-depth now that byte-inline-lapcode does it for us.
+	(byte-compile-inline-expand): Don't inline dynbind byte code into
+	lexbind code, since it has to be done differently.
+
 2011-02-12  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* emacs-lisp/byte-lexbind.el: Delete.

lisp/doc-view.el

@@ -1,5 +1,5 @@
-;;; -*- lexical-binding: t -*-
+;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs -*- lexical-binding: t -*-
-;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs
+
 
 ;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
 ;;

lisp/emacs-lisp/byte-opt.el

@@ -248,7 +248,18 @@
 ;; are no collisions, and that byte-compile-tag-number is reasonable
 ;; after this is spliced in.  The provided list is destroyed.
 (defun byte-inline-lapcode (lap)
-  (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))
+  ;; "Replay" the operations: we used to just do
+  ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))
+  ;; but that fails to update byte-compile-depth, so we had to assume
+  ;; that `lap' ends up adding exactly 1 element to the stack.  This
+  ;; happens to be true for byte-code generated by bytecomp.el without
+  ;; lexical-binding, but it's not true in general, and it's not true for
+  ;; code output by bytecomp.el with lexical-binding.
+  (dolist (op lap)
+    (cond
+     ((eq (car op) 'TAG) (byte-compile-out-tag op))
+     ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op)))
+     (t (byte-compile-out (car op) (cdr op))))))
 
 (defun byte-compile-inline-expand (form)
   (let* ((name (car form))
@@ -266,25 +277,32 @@
 		     (cdr (assq name byte-compile-function-environment)))))
       (if (and (consp fn) (eq (car fn) 'autoload))
 	  (error "File `%s' didn't define `%s'" (nth 1 fn) name))
-      (if (and (symbolp fn) (not (eq fn t)))
+      (cond
-	  (byte-compile-inline-expand (cons fn (cdr form)))
+       ((and (symbolp fn) (not (eq fn t))) ;A function alias.
-	(if (byte-code-function-p fn)
+        (byte-compile-inline-expand (cons fn (cdr form))))
-	    (let (string)
+       ((and (byte-code-function-p fn)
-	      (fetch-bytecode fn)
+             ;; FIXME: This works to inline old-style-byte-codes into
-	      (setq string (aref fn 1))
+             ;; old-style-byte-codes, but not mixed cases (not sure
-	      ;; Isn't it an error for `string' not to be unibyte??  --stef
+             ;; about new-style into new-style).
-	      (if (fboundp 'string-as-unibyte)
+             (not lexical-binding)
-		  (setq string (string-as-unibyte string)))
+             (not (and (>= (length fn) 7)
-	      ;; `byte-compile-splice-in-already-compiled-code'
+                       (aref fn 6))))   ;6 = COMPILED_PUSH_ARGS
-	      ;; takes care of inlining the body.
+        ;; (message "Inlining %S byte-code" name)
-	      (cons `(lambda ,(aref fn 0)
+        (fetch-bytecode fn)
-		       (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
+        (let ((string (aref fn 1)))
-		    (cdr form)))
+          ;; Isn't it an error for `string' not to be unibyte??  --stef
-	  (if (eq (car-safe fn) 'lambda)
+          (if (fboundp 'string-as-unibyte)
-	      (macroexpand-all (cons fn (cdr form))
+              (setq string (string-as-unibyte string)))
-			       byte-compile-macro-environment)
+          ;; `byte-compile-splice-in-already-compiled-code'
-	    ;; Give up on inlining.
+          ;; takes care of inlining the body.
-	    form))))))
+          (cons `(lambda ,(aref fn 0)
+                   (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
+                (cdr form))))
+       ((eq (car-safe fn) 'lambda)
+        (macroexpand-all (cons fn (cdr form))
+                         byte-compile-macro-environment))
+       (t ;; Give up on inlining.
+        form)))))
 
 ;; ((lambda ...) ...)
 (defun byte-compile-unfold-lambda (form &optional name)
@@ -1298,10 +1316,7 @@
   (if (not (memq byte-optimize '(t lap)))
       (byte-compile-normal-call form)
     (byte-inline-lapcode
-     (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t))
+     (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t))))
-    (setq byte-compile-maxdepth (max (+ byte-compile-depth (nth 3 form))
-				     byte-compile-maxdepth))
-    (setq byte-compile-depth (1+ byte-compile-depth))))
 
 (put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code)
 

lisp/emacs-lisp/bytecomp.el

@@ -752,9 +752,10 @@ BYTES and PC are updated after evaluating all the arguments."
 	(bytes-var (car (last args 2)))
 	(pc-var (car (last args))))
     `(setq ,bytes-var ,(if (null (cdr byte-exprs))
-			   `(cons ,@byte-exprs ,bytes-var)
+                           `(progn (assert (<= 0 ,(car byte-exprs)))
-			 `(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
+                                   (cons ,@byte-exprs ,bytes-var))
-	   ,pc-var (+ ,(length byte-exprs) ,pc-var))))
+                         `(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
+           ,pc-var (+ ,(length byte-exprs) ,pc-var))))
 
 (defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc)
   "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC.
@@ -817,7 +818,7 @@ CONST2 may be evaulated multiple times."
                ;; These insns all put their operand into one extra byte.
                (byte-compile-push-bytecodes opcode off bytes pc))
               ((= opcode byte-discardN)
-               ;; byte-discardN is wierd in that it encodes a flag in the
+               ;; byte-discardN is weird in that it encodes a flag in the
                ;; top bit of its one-byte argument.  If the argument is
                ;; too large to fit in 7 bits, the opcode can be repeated.
                (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0)))
@@ -1330,11 +1331,11 @@ extra args."
 	       (eq 'lambda (car-safe (cdr-safe old)))
 	       (setq old (cdr old)))
 	  (let ((sig1 (byte-compile-arglist-signature
-		       (if (eq 'lambda (car-safe old))
+		       (pcase old
-			   (nth 1 old)
+                         (`(lambda ,args . ,_) args)
-			 (if (byte-code-function-p old)
+                         (`(closure ,_ ,_ ,args . ,_) args)
-			     (aref old 0)
+                         ((pred byte-code-function-p) (aref old 0))
-			   '(&rest def)))))
+                         (t '(&rest def)))))
 		(sig2 (byte-compile-arglist-signature (nth 2 form))))
 	    (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
 	      (byte-compile-set-symbol-position (nth 1 form))
@@ -1402,14 +1403,7 @@ extra args."
 			  ;; but such warnings are never useful,
 			  ;; so don't warn about them.
 			  macroexpand cl-macroexpand-all
-			  cl-compiling-file)))
+			  cl-compiling-file))))
-	     ;; Avoid warnings for things which are safe because they
-	     ;; have suitable compiler macros, but those aren't
-	     ;; expanded at this stage.  There should probably be more
-	     ;; here than caaar and friends.
-	     (not (and (eq (get func 'byte-compile)
-			   'cl-byte-compile-compiler-macro)
-		       (string-match "\\`c[ad]+r\\'" (symbol-name func)))))
 	(byte-compile-warn "function `%s' from cl package called at runtime"
 			   func)))
   form)
@@ -2701,8 +2695,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	       (if (eq (car-safe form) 'list)
 		   (byte-compile-top-level (nth 1 bytecomp-int))
 		 (setq bytecomp-int (list 'interactive
-				 (byte-compile-top-level
+                                          (byte-compile-top-level
-				  (nth 1 bytecomp-int)))))))
+                                           (nth 1 bytecomp-int)))))))
 	    ((cdr bytecomp-int)
 	     (byte-compile-warn "malformed interactive spec: %s"
 				(prin1-to-string bytecomp-int)))))
@@ -2788,6 +2782,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(byte-compile-tag-number 0)
 	(byte-compile-depth 0)
 	(byte-compile-maxdepth 0)
+        (byte-compile-lexical-environment
+         (when (eq output-type 'lambda)
+           byte-compile-lexical-environment))
 	(byte-compile-output nil))
     (if (memq byte-optimize '(t source))
 	(setq form (byte-optimize-form form for-effect)))
@@ -2798,14 +2795,13 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	     (stringp (nth 1 form)) (vectorp (nth 2 form))
 	     (natnump (nth 3 form)))
 	form
-      ;; Set up things for a lexically-bound function
+      ;; Set up things for a lexically-bound function.
       (when (and lexical-binding (eq output-type 'lambda))
 	;; See how many arguments there are, and set the current stack depth
-	;; accordingly
+	;; accordingly.
-	(dolist (var byte-compile-lexical-environment)
+        (setq byte-compile-depth (length byte-compile-lexical-environment))
-          (setq byte-compile-depth (1+ byte-compile-depth)))
 	;; If there are args, output a tag to record the initial
-	;; stack-depth for the optimizer
+	;; stack-depth for the optimizer.
 	(when (> byte-compile-depth 0)
 	  (byte-compile-out-tag (byte-compile-make-tag))))
       ;; Now compile FORM
@@ -2964,9 +2960,10 @@ That command is designed for interactive use only" bytecomp-fn))
                     ;; for CL compiler macros since the symbol may be
                     ;; `cl-byte-compile-compiler-macro' but if CL isn't
                     ;; loaded, this function doesn't exist.
-                    (or (not (memq bytecomp-handler
+                    (and (not (eq bytecomp-handler
-				   '(cl-byte-compile-compiler-macro)))
+                                  ;; Already handled by macroexpand-all.
-                        (functionp bytecomp-handler)))
+                                  'cl-byte-compile-compiler-macro))
+                         (functionp bytecomp-handler)))
                (funcall bytecomp-handler form)
 	     (byte-compile-normal-call form))
 	   (if (byte-compile-warning-enabled-p 'cl-functions)
@@ -3612,7 +3609,7 @@ discarding."
 (byte-defop-compiler-1 while)
 (byte-defop-compiler-1 funcall)
 (byte-defop-compiler-1 let)
-(byte-defop-compiler-1 let*)
+(byte-defop-compiler-1 let* byte-compile-let)
 
 (defun byte-compile-progn (form)
   (byte-compile-body-do-effect (cdr form)))
@@ -3819,10 +3816,8 @@ Return the offset in the form (VAR . OFFSET)."
         (byte-compile-push-constant nil)))))
 
 (defun byte-compile-not-lexical-var-p (var)
-  (or (not (symbolp var))               ; form is not a list
+  (or (not (symbolp var))
-      (if (eval-when-compile (fboundp 'special-variable-p))
+      (special-variable-p var)
-          (special-variable-p var)
-        (boundp var))
       (memq var byte-compile-bound-variables)
       (memq var '(nil t))
       (keywordp var)))
@@ -3833,9 +3828,8 @@ INIT-LEXENV should be a lexical-environment alist describing the
 positions of the init value that have been pushed on the stack.
 Return non-nil if the TOS value was popped."
   ;; The presence of lexical bindings mean that we may have to
-  ;; juggle things on the stack, either to move them to TOS for
+  ;; juggle things on the stack, to move them to TOS for
-  ;; dynamic binding, or to put them in a non-stack environment
+  ;; dynamic binding.
-  ;; vector.
   (cond ((not (byte-compile-not-lexical-var-p var))
          ;; VAR is a simple stack-allocated lexical variable
          (push (assq var init-lexenv)
@@ -3883,56 +3877,41 @@ binding slots have been popped."
 
 (defun byte-compile-let (form)
   "Generate code for the `let' form FORM."
-  ;; First compute the binding values in the old scope.
+  (let ((clauses (cadr form))
-  (let ((varlist (car (cdr form)))
+	(init-lexenv nil))
-        (init-lexenv nil))
+    (when (eq (car form) 'let)
-    (dolist (var varlist)
+      ;; First compute the binding values in the old scope.
-      (push (byte-compile-push-binding-init var) init-lexenv))
+      (dolist (var clauses)
-    ;; Now do the bindings, execute the body, and undo the bindings.
+        (push (byte-compile-push-binding-init var) init-lexenv)))
-    (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
+    ;; New scope.
-	  (varlist (reverse (car (cdr form))))
+    (let ((byte-compile-bound-variables byte-compile-bound-variables)
           (byte-compile-lexical-environment byte-compile-lexical-environment))
-      (dolist (var varlist)
+      ;; Bind the variables.
-	(let ((var (if (consp var) (car var) var)))
+      ;; For `let', do it in reverse order, because it makes no
-	  (cond ((null lexical-binding)
+      ;; semantic difference, but it is a lot more efficient since the
-		 ;; If there are no lexical bindings, we can do things simply.
+      ;; values are now in reverse order on the stack.
-		 (byte-compile-dynamic-variable-bind var))
+      (dolist (var (if (eq (car form) 'let) (reverse clauses) clauses))
-		((byte-compile-bind var init-lexenv)
+        (unless (eq (car form) 'let)
-		 (pop init-lexenv)))))
+          (push (byte-compile-push-binding-init var) init-lexenv))
+        (let ((var (if (consp var) (car var) var)))
+          (cond ((null lexical-binding)
+                 ;; If there are no lexical bindings, we can do things simply.
+                 (byte-compile-dynamic-variable-bind var))
+                ((byte-compile-bind var init-lexenv)
+                 (pop init-lexenv)))))
       ;; Emit the body.
-      (byte-compile-body-do-effect (cdr (cdr form)))
+      (let ((init-stack-depth byte-compile-depth))
-      ;; Unbind the variables.
+        (byte-compile-body-do-effect (cdr (cdr form)))
-      (if lexical-binding
+        ;; Unbind the variables.
-	  ;; Unbind both lexical and dynamic variables.
+        (if lexical-binding
-	 (byte-compile-unbind varlist init-lexenv t)
+            ;; Unbind both lexical and dynamic variables.
-	;; Unbind dynamic variables.
+            (progn
-	(byte-compile-out 'byte-unbind (length varlist))))))
+              (assert (or (eq byte-compile-depth init-stack-depth)
-
+                          (eq byte-compile-depth (1+ init-stack-depth))))
-(defun byte-compile-let* (form)
+              (byte-compile-unbind clauses init-lexenv (> byte-compile-depth
-  "Generate code for the `let*' form FORM."
+                                                          init-stack-depth)))
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
+          ;; Unbind dynamic variables.
-        (clauses (cadr form))
+          (byte-compile-out 'byte-unbind (length clauses)))))))
-	(init-lexenv nil)
-	;; bind these to restrict the scope of any changes
-	
-	(byte-compile-lexical-environment byte-compile-lexical-environment))
-    ;; Bind the variables
-    (dolist (var clauses)
-      (push (byte-compile-push-binding-init var) init-lexenv)
-      (let ((var (if (consp var) (car var) var)))
-	(cond ((null lexical-binding)
-	       ;; If there are no lexical bindings, we can do things simply.
-	       (byte-compile-dynamic-variable-bind var))
-	      ((byte-compile-bind var init-lexenv)
-	       (pop init-lexenv)))))
-    ;; Emit the body
-    (byte-compile-body-do-effect (cdr (cdr form)))
-    ;; Unbind the variables
-    (if lexical-binding
-	;; Unbind both lexical and dynamic variables
-	(byte-compile-unbind clauses init-lexenv t)
-      ;; Unbind dynamic variables
-      (byte-compile-out 'byte-unbind (length clauses)))))
 
 
 
@@ -4254,8 +4233,8 @@ binding slots have been popped."
       (progn
 	;; ## remove this someday
 	(and byte-compile-depth
-	  (not (= (cdr (cdr tag)) byte-compile-depth))
+             (not (= (cdr (cdr tag)) byte-compile-depth))
-	  (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
+             (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
 	(setq byte-compile-depth (cdr (cdr tag))))
     (setcdr (cdr tag) byte-compile-depth)))
 

lisp/emacs-lisp/cconv.el

@@ -70,6 +70,15 @@
 ;;
 ;;; Code:
 
+;;; TODO:
+;; - Use abstract `make-closure' and `closure-ref' expressions, which bytecomp
+;;   should turn into building corresponding byte-code function.
+;; - don't use `curry', instead build a new compiled-byte-code object
+;;   (merge the closure env into the static constants pool).
+;; - use relative addresses for byte-code-stack-ref.
+;; - warn about unused lexical vars.
+;; - clean up cconv-closure-convert-rec, especially the `let' binding part.
+
 (eval-when-compile (require 'cl))
 
 (defconst cconv-liftwhen 3
@@ -187,14 +196,14 @@ Returns a list of free variables."
 -- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST
 
 Returns a form where all lambdas don't have any free variables."
-  (message "Entering cconv-closure-convert...")
+  ;; (message "Entering cconv-closure-convert...")
   (let ((cconv-mutated '())
 	(cconv-lambda-candidates '())
 	(cconv-captured '())
 	(cconv-captured+mutated '()))
-    ;; Analyse form - fill these variables with new information
+    ;; Analyse form - fill these variables with new information.
     (cconv-analyse-form form '() 0)
-    ;; Calculate an intersection of cconv-mutated and cconv-captured
+    ;; Calculate an intersection of cconv-mutated and cconv-captured.
     (dolist (mvr cconv-mutated)
       (when (memq mvr cconv-captured)   ;
         (push mvr cconv-captured+mutated)))
@@ -216,14 +225,51 @@ Returns a form where all lambdas don't have any free variables."
     res))
 
 (defconst cconv--dummy-var (make-symbol "ignored"))
+(defconst cconv--env-var (make-symbol "env"))
 
-(defun cconv-closure-convert-rec
+(defun cconv--set-diff (s1 s2)
-  (form emvrs fvrs envs lmenvs)
+  "Return elements of set S1 that are not in set S2."
+  (let ((res '()))
+    (dolist (x s1)
+      (unless (memq x s2) (push x res)))
+    (nreverse res)))
+
+(defun cconv--set-diff-map (s m)
+  "Return elements of set S that are not in Dom(M)."
+  (let ((res '()))
+    (dolist (x s)
+      (unless (assq x m) (push x res)))
+    (nreverse res)))
+
+(defun cconv--map-diff (m1 m2)
+  "Return the submap of map M1 that has Dom(M2) removed."
+  (let ((res '()))
+    (dolist (x m1)
+      (unless (assq (car x) m2) (push x res)))
+    (nreverse res)))
+
+(defun cconv--map-diff-elem (m x)
+  "Return the map M minus any mapping for X."
+  ;; Here we assume that X appears at most once in M.
+  (let* ((b (assq x m))
+         (res (if b (remq b m) m)))
+    (assert (null (assq x res))) ;; Check the assumption was warranted.
+    res))
+
+(defun cconv--map-diff-set (m s)
+  "Return the map M minus any mapping for elements of S."
+  ;; Here we assume that X appears at most once in M.
+  (let ((res '()))
+    (dolist (b m)
+      (unless (memq (car b) s) (push b res)))
+    (nreverse res)))
+
+(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs)
   ;; This function actually rewrites the tree.
   "Eliminates all free variables of all lambdas in given forms.
 Arguments:
 -- FORM is a piece of Elisp code after macroexpansion.
--- LMENVS is a list of environments used for lambda-lifting. Initially empty.
+-- LMENVS is a list of environments used for lambda-lifting.  Initially empty.
 -- EMVRS is a list that contains mutated variables that are visible
 within current environment.
 -- ENVS is an environment(list of free variables) of current closure.
@@ -343,10 +389,9 @@ Returns a form where all lambdas don't have any free variables."
                  (setq lmenvs (remq old-lmenv lmenvs))
                  (push new-lmenv lmenvs)
                  (push `(,closedsym ,var) binders-new))))
-           ;; we push the element after redefined free variables
+           ;; We push the element after redefined free variables are
-           ;; are processes. this is important to avoid the bug
+           ;; processed.  This is important to avoid the bug when free
-           ;; when free variable and the function have the same
+           ;; variable and the function have the same name.
-           ;; name
            (push (list var new-val) binders-new)
 
            (when (eq letsym 'let*)      ; update fvrs
@@ -355,11 +400,7 @@ Returns a form where all lambdas don't have any free variables."
              (when emvr-push
                (push emvr-push emvrs)
                (setq emvr-push nil))
-             (let (lmenvs-1)     ; remove var from lmenvs if redefined
+             (setq lmenvs (cconv--map-diff-elem lmenvs var))
-               (dolist (iter lmenvs)
-                 (when (not (assq var lmenvs))
-                   (push iter lmenvs-1)))
-               (setq lmenvs lmenvs-1))
              (when lmenv-push
                (push lmenv-push lmenvs)
                (setq lmenv-push nil)))
@@ -368,19 +409,10 @@ Returns a form where all lambdas don't have any free variables."
 
          (let (var fvrs-1 emvrs-1 lmenvs-1)
            ;; Here we update emvrs, fvrs and lmenvs lists
-           (dolist (vr fvrs)
+           (setq fvrs (cconv--set-diff-map fvrs binders-new))
-					; safely remove
+           (setq emvrs (cconv--set-diff-map emvrs binders-new))
-             (when (not (assq vr binders-new)) (push vr fvrs-1)))
-           (setq fvrs fvrs-1)
-           (dolist (vr emvrs)
-					; safely remove
-             (when (not (assq vr binders-new)) (push vr emvrs-1)))
-           (setq emvrs emvrs-1)
-					; push new
            (setq emvrs (append emvrs emvrs-new))
-           (dolist (vr lmenvs)
+           (setq lmenvs (cconv--set-diff-map lmenvs binders-new))
-             (when (not (assq (car vr) binders-new))
-               (push vr lmenvs-1)))
            (setq lmenvs (append lmenvs lmenvs-new)))
 
          ;; Here we do the same letbinding as for let* above
@@ -402,9 +434,9 @@ Returns a form where all lambdas don't have any free variables."
                                             (symbol-name var))))
 
                    (setq new-lmenv (list (car lmenv)))
-                   (dolist (frv (cdr lmenv)) (if (eq frv var)
+                   (dolist (frv (cdr lmenv))
-                                                 (push closedsym new-lmenv)
+                     (push (if (eq frv var) closedsym frv)
-                                               (push frv new-lmenv)))
+                           new-lmenv))
                    (setq new-lmenv (reverse new-lmenv))
                    (setq lmenvs (remq lmenv lmenvs))
                    (push new-lmenv lmenvs)
@@ -449,13 +481,9 @@ Returns a form where all lambdas don't have any free variables."
     (`(quote . ,_) form)                ; quote form
 
     (`(function . ((lambda ,vars . ,body-forms))) ; function form
-     (let (fvrs-new)      ; we remove vars from fvrs
+     (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs.
-       (dolist (elm fvrs) ;i use such a tricky way to avoid side effects
+	    (fv (delete-dups (cconv-freevars form '())))
-         (when (not (memq elm vars))
+            (leave fvrs-new) ; leave=non-nil if we should leave env unchanged.
-           (push elm fvrs-new)))
-       (setq fvrs fvrs-new))
-     (let* ((fv (delete-dups (cconv-freevars form '())))
-            (leave fvrs) ; leave = non nil if we should leave env unchanged
             (body-forms-new '())
             (letbind '())
             (mv nil)
@@ -470,7 +498,7 @@ Returns a form where all lambdas don't have any free variables."
          (if (eq (length envs) (length fv))
              (let ((fv-temp fv))
                (while (and fv-temp leave)
-                 (when (not (memq (car fv-temp) fvrs)) (setq leave nil))
+                 (when (not (memq (car fv-temp) fvrs-new)) (setq leave nil))
                  (setq fv-temp (cdr fv-temp))))
            (setq leave nil))
 
@@ -479,23 +507,30 @@ Returns a form where all lambdas don't have any free variables."
                (dolist (elm fv)
                  (push
                   (cconv-closure-convert-rec
+                   ;; Remove `elm' from `emvrs' for this call because in case
+                   ;; `elm' is a variable that's wrapped in a cons-cell, we
+                   ;; want to put the cons-cell itself in the closure, rather
+                   ;; than just a copy of its current content.
                    elm (remq elm emvrs) fvrs envs lmenvs)
-                  envector))         ; process vars for closure vector
+                  envector))         ; Process vars for closure vector.
                (setq envector (reverse envector))
                (setq envs fv))
-           (setq envector `(env)))	; leave unchanged
+           (setq envector `(,cconv--env-var))) ; Leave unchanged.
-         (setq fvrs fv))                ; update substitution list
+         (setq fvrs-new fv))                ; Update substitution list.
 
-       ;; the difference between envs and fvrs is explained
+       (setq emvrs (cconv--set-diff emvrs vars))
-       ;; in comment in the beginning of the function
+       (setq lmenvs (cconv--map-diff-set lmenvs vars))
-       (dolist (elm cconv-captured+mutated) ; find mutated arguments
+       
-         (setq mv (car elm))                ; used in inner closures
+       ;; The difference between envs and fvrs is explained
+       ;; in comment in the beginning of the function.
+       (dolist (elm cconv-captured+mutated) ; Find mutated arguments
+         (setq mv (car elm))                ; used in inner closures.
          (when (and (memq mv vars) (eq form (caddr elm)))
            (progn (push mv emvrs)
                   (push `(,mv (list ,mv)) letbind))))
        (dolist (elm body-forms)         ; convert function body
          (push (cconv-closure-convert-rec
-                elm emvrs fvrs envs lmenvs)
+                elm emvrs fvrs-new envs lmenvs)
                body-forms-new))
 
        (setq body-forms-new
@@ -509,12 +544,12 @@ Returns a form where all lambdas don't have any free variables."
                                ; 1 free variable - do not build vector
         ((null (cdr envector))
          `(curry
-           (function (lambda (env . ,vars) . ,body-forms-new))
+           (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new))
            ,(car envector)))
                                    ; >=2 free variables - build vector
         (t
          `(curry
-           (function (lambda (env . ,vars) . ,body-forms-new))
+           (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new))
            (vector . ,envector))))))
 
     (`(function . ,_) form)             ; same as quote
@@ -674,13 +709,10 @@ Returns a form where all lambdas don't have any free variables."
      (let ((free (memq form fvrs)))
        (if free                         ;form is a free variable
            (let* ((numero (- (length fvrs) (length free)))
-                  (var '()))
+                  (var (if (null (cdr envs))
-             (assert numero)
+                           cconv--env-var
-             (if (null (cdr envs))
+                         ;; Replace form => (aref env #)
-                 (setq var 'env)
+                         `(aref ,cconv--env-var ,numero))))
-					;replace form =>
-					;(aref env #)
-               (setq var `(aref env ,numero)))
              (if (memq form emvrs) ; form => (car (aref env #)) if mutable
                  `(car ,var)
                var))

lisp/emacs-lisp/cl-loaddefs.el

@@ -282,7 +282,7 @@ Not documented
 ;;;;;;  do-all-symbols do-symbols dotimes dolist do* do loop return-from
 ;;;;;;  return block etypecase typecase ecase case load-time-value
 ;;;;;;  eval-when destructuring-bind function* defmacro* defun* gentemp
-;;;;;;  gensym) "cl-macs" "cl-macs.el" "0904b956872432ae7cc5fa9abcefce63")
+;;;;;;  gensym) "cl-macs" "cl-macs.el" "7602128fa01003de9a8df4c752865300")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'gensym "cl-macs" "\

lisp/emacs-lisp/cl-macs.el

@@ -602,7 +602,13 @@ called from BODY."
 
 (put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block)
 (defun cl-byte-compile-block (cl-form)
-  (if (fboundp 'byte-compile-form-do-effect)  ; Check for optimizing compiler
+  ;; Here we try to determine if a catch tag is used or not, so as to get rid
+  ;; of the catch when it's not used.
+  (if (and (fboundp 'byte-compile-form-do-effect) ; Optimizing compiler?
+           ;; FIXME: byte-compile-top-level can only be used for code that is
+           ;; closed (as the name implies), so for lexical scoping we should
+           ;; implement this optimization differently.
+           (not lexical-binding))
       (progn
 	(let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil))
 	       (cl-active-block-names (cons cl-entry cl-active-block-names))

lisp/emacs-lisp/pcase.el

@@ -1,5 +1,4 @@
-;;; -*- lexical-binding: t -*-
+;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
-;;; pcase.el --- ML-style pattern-matching macro for Elisp
 
 ;; Copyright (C) 2010-2011  Free Software Foundation, Inc.
 

lisp/files.el

@@ -2851,18 +2851,19 @@ asking you for confirmation."
 ;;
 ;; For variables defined in the C source code the declaration should go here:
 
-(mapc (lambda (pair)
+(dolist (pair
-	(put (car pair) 'safe-local-variable (cdr pair)))
+	 '((buffer-read-only        . booleanp)	;; C source code
-      '((buffer-read-only        . booleanp)   ;; C source code
+	   (default-directory       . stringp)	;; C source code
-	(default-directory       . stringp)    ;; C source code
+	   (fill-column             . integerp)	;; C source code
-	(fill-column             . integerp)   ;; C source code
+	   (indent-tabs-mode        . booleanp)	;; C source code
-	(indent-tabs-mode        . booleanp)   ;; C source code
+	   (left-margin             . integerp)	;; C source code
-	(left-margin             . integerp)   ;; C source code
+	   (no-update-autoloads     . booleanp)
-	(no-update-autoloads     . booleanp)
+	   (lexical-binding	 . booleanp)	  ;; C source code
-	(tab-width               . integerp)   ;; C source code
+	   (tab-width               . integerp)	  ;; C source code
-	(truncate-lines          . booleanp)   ;; C source code
+	   (truncate-lines          . booleanp)	  ;; C source code
-	(word-wrap               . booleanp) ;; C source code
+	   (word-wrap               . booleanp)	  ;; C source code
-	(bidi-display-reordering . booleanp))) ;; C source code
+	   (bidi-display-reordering . booleanp))) ;; C source code
+  (put (car pair) 'safe-local-variable (cdr pair)))
 
 (put 'bidi-paragraph-direction 'safe-local-variable
      (lambda (v) (memq v '(nil right-to-left left-to-right))))

lisp/help-fns.el

@@ -530,7 +530,7 @@ suitable file is found, return nil."
 	      (let ((fill-begin (point)))
 		(insert (car high) "\n")
 		(fill-region fill-begin (point)))
-              (setq doc (cdr high))))
+	      (setq doc (cdr high))))
 	  (let* ((obsolete (and
 			    ;; function might be a lambda construct.
 			    (symbolp function)

src/ChangeLog

@@ -1,3 +1,13 @@
+2011-02-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* eval.c (Vinternal_interpreter_environment): Remove.
+	(syms_of_eval): Do declare Vinternal_interpreter_environment as
+	a global lisp var, but unintern it to hide it.
+	(Fcommandp):
+	* data.c (Finteractive_form): Understand `closure's.
+
+	* bytecode.c (exec_byte_code): Fix handling of &rest.
+
 2011-02-12  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* bytecode.c (Bvec_ref, Bvec_set): Remove.

src/bytecode.c

@@ -500,7 +500,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	  optional = 1;
 	else if (EQ (XCAR (at), Qand_rest))
 	  {
-	    PUSH (Flist (nargs, args));
+	    PUSH (pushed < nargs
+		  ? Flist (nargs - pushed, args)
+		  : Qnil);
 	    pushed = nargs;
 	    at = Qnil;
 	    break;

src/data.c

@@ -755,6 +755,8 @@ Value, if non-nil, is a list \(interactive SPEC).  */)
   else if (CONSP (fun))
     {
       Lisp_Object funcar = XCAR (fun);
+      if (EQ (funcar, Qclosure))
+	fun = Fcdr (XCDR (fun)), funcar = Fcar (fun);
       if (EQ (funcar, Qlambda))
 	return Fassq (Qinteractive, Fcdr (XCDR (fun)));
       else if (EQ (funcar, Qautoload))

src/eval.c

@@ -78,16 +78,6 @@ 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
-   environment.  The lisp name of this variable is
-   `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;
-
 /* Current number of specbindings allocated in specpdl.  */
 
 EMACS_INT specpdl_size;
@@ -2092,9 +2082,11 @@ then strings and vectors are not accepted.  */)
   if (!CONSP (fun))
     return Qnil;
   funcar = XCAR (fun);
+  if (EQ (funcar, Qclosure))
+    fun = Fcdr (XCDR (fun)), funcar = Fcar (fun);
   if (EQ (funcar, Qlambda))
     return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
-  if (EQ (funcar, Qautoload))
+  else if (EQ (funcar, Qautoload))
     return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
   else
     return Qnil;
@@ -3695,6 +3687,8 @@ mark_backtrace (void)
     }
 }
 
+EXFUN (Funintern, 2);
+
 void
 syms_of_eval (void)
 {
@@ -3840,19 +3834,27 @@ DECL is a list `(declare ...)' containing the declarations.
 The value the function returns is not used.  */);
   Vmacro_declaration_function = Qnil;
 
+  /* When lexical binding is being used,
+   vinternal_interpreter_environment is non-nil, and contains an alist
+   of lexically-bound variable, or (t), indicating an empty
+   environment.  The lisp name of this variable would be
+   `internal-interpreter-environment' if it weren't hidden.
+   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.  */
   Qinternal_interpreter_environment
     = intern_c_string ("internal-interpreter-environment");
   staticpro (&Qinternal_interpreter_environment);
-#if 0 /* Don't export this variable to Elisp, so noone can mess with it
+  DEFVAR_LISP ("internal-interpreter-environment",
-	 (Just imagine if someone makes it buffer-local).  */
+		Vinternal_interpreter_environment,
-  DEFVAR__LISP ("internal-interpreter-environment",
-	       Vinternal_interpreter_environment,
 	       doc: /* If non-nil, the current lexical environment of the lisp interpreter.
 When lexical binding is not being used, this variable is nil.
 A value of `(t)' indicates an empty environment, otherwise it is an
 alist of active lexical bindings.  */);
-#endif
   Vinternal_interpreter_environment = Qnil;
+  /* Don't export this variable to Elisp, so noone can mess with it
+     (Just imagine if someone makes it buffer-local).  */
+  Funintern (Qinternal_interpreter_environment, Qnil);
 
   Vrun_hooks = intern_c_string ("run-hooks");
   staticpro (&Vrun_hooks);

src/lisp.h

@@ -2855,7 +2855,7 @@ extern void syms_of_lread (void);
 
 /* Defined in eval.c */
 extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
-extern Lisp_Object Qinhibit_quit;
+extern Lisp_Object Qinhibit_quit, Qclosure;
 extern Lisp_Object Vautoload_queue;
 extern Lisp_Object Vsignaling_function;
 extern int handling_signal;