* lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte

compiler choose the representation of closures.
(cconv--env-var): Remove.
* lisp/emacs-lisp/bytecomp.el (byte-compile--env-var): New var.
(byte-compile-make-closure, byte-compile-get-closed-var):
New functions.
* lisp/cedet/semantic/wisent/comp.el (wisent-byte-compile-grammar):
Macroexpand before passing to byte-compile-form.

5 files changed, 61 insertions, 44 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4e2e87ab60f..f7a62bc8385 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,14 @@
 2011-02-21  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte
+        compiler choose the representation of closures.
+        (cconv--env-var): Remove.
+        * emacs-lisp/bytecomp.el (byte-compile--env-var): New var.
+        (byte-compile-make-closure, byte-compile-get-closed-var):
+        New functions.
+
+2011-02-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
         * subr.el (with-output-to-temp-buffer): New macro.
 
         * simple.el (count-words-region): Don't use interactive-p.
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index b6d5cff6b51..fa3f633d1ac 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * semantic/wisent/comp.el (wisent-byte-compile-grammar):
+        Macroexpand before passing to byte-compile-form.
+
 2011-01-13  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * srecode/srt-mode.el (srecode-template-mode): Use define-derived-mode.
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index c3243c12923..6b473f9ad81 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -3452,15 +3452,13 @@ where:
   (if (wisent-automaton-p grammar)
       grammar ;; Grammar already compiled just return it
     (wisent-with-context compile-grammar
-      (let* ((gc-cons-threshold 1000000)
-             automaton)
+      (let* ((gc-cons-threshold 1000000))
         (garbage-collect)
         (setq wisent-new-log-flag t)
         ;; Parse input grammar
         (wisent-parse-grammar grammar start-list)
         ;; Generate the LALR(1) automaton
-        (setq automaton (wisent-parser-automaton))
-        automaton))))
+        (wisent-parser-automaton)))))
 
 ;;;; --------------------------
 ;;;; Byte compile input grammar
@@ -3476,7 +3474,15 @@ Automatically called by the Emacs Lisp byte compiler as a
   ;; automaton internal data structure.  Then, because the internal
   ;; data structure contains an obarray, convert it to a lisp form so
   ;; it can be byte-compiled.
-  (byte-compile-form (wisent-automaton-lisp-form (eval form))))
+  (byte-compile-form
+   ;; FIXME: we macroexpand here since `byte-compile-form' expects
+   ;; macroexpanded code, but that's just a workaround: for lexical-binding
+   ;; the lisp form should have to pass through closure-conversion and
+   ;; `wisent-byte-compile-grammar' is called much too late for that.
+   ;; Why isn't this `wisent-automaton-lisp-form' performed at
+   ;; macroexpansion time?  --Stef
+   (macroexpand-all
+    (wisent-automaton-lisp-form (eval form)))))
 
 (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar)
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 8892a27b29c..771306bb0e6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3339,6 +3339,24 @@ discarding."
   "Output byte codes to store the top-of-stack value at position STACK-POS in the stack."
   (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos))))
 
+(byte-defop-compiler-1 internal-make-closure byte-compile-make-closure)
+(byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var)
+
+(defconst byte-compile--env-var (make-symbol "env"))
+
+(defun byte-compile-make-closure (form)
+  ;; FIXME: don't use `curry'!
+  (byte-compile-form
+   (unless for-effect
+     `(curry (function (lambda (,byte-compile--env-var . ,(nth 1 form))
+                         . ,(nthcdr 3 form)))
+             (vector . ,(nth 2 form))))
+   for-effect))
+
+(defun byte-compile-get-closed-var (form)
+  (byte-compile-form (unless for-effect
+                       `(aref ,byte-compile--env-var ,(nth 1 form)))
+                     for-effect))
 
 ;; Compile a function that accepts one or more args and is right-associative.
 ;; We do it by left-associativity so that the operations
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 66e5051c2f1..6aa4b7e0a61 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -71,6 +71,8 @@
 ;;; Code:
 
 ;;; TODO:
+;; - canonize code in macro-expand so we don't have to handle (let (var) body)
+;;   and other oddities.
 ;; - Change new byte-code representation, so it directly gives the
 ;;   number of mandatory and optional arguments as well as whether or
 ;;   not there's a &rest arg.
@@ -229,7 +231,6 @@ 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--set-diff (s1 s2)
   "Return elements of set S1 that are not in set S2."
@@ -494,32 +495,18 @@ Returns a form where all lambdas don't have any free variables."
             (envector nil))
        (when fv
          ;; Here we form our environment vector.
-         ;; If outer closure contains all
-         ;; free variables of this function(and nothing else)
-         ;; then we use the same environment vector as for outer closure,
-         ;; i.e. we leave the environment vector unchanged,
-         ;; otherwise we build a new environment vector.
-         (if (eq (length envs) (length fv))
-             (let ((fv-temp fv))
-               (while (and fv-temp leave)
-                 (when (not (memq (car fv-temp) fvrs-new)) (setq leave nil))
-                 (setq fv-temp (cdr fv-temp))))
-           (setq leave nil))
-
-         (if (not leave)
-             (progn
-               (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.
-               (setq envector (reverse envector))
-               (setq envs fv))
-           (setq envector `(,cconv--env-var))) ; Leave unchanged.
+
+         (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.
+         (setq envector (reverse envector))
+         (setq envs fv)
          (setq fvrs-new fv))                ; Update substitution list.
 
        (setq emvrs (cconv--set-diff emvrs vars))
@@ -546,15 +533,9 @@ Returns a form where all lambdas don't have any free variables."
         ((null envector)
          `(function (lambda ,vars . ,body-forms-new)))
                                ; 1 free variable - do not build vector
-        ((null (cdr envector))
-         `(curry
-           (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new))
-           ,(car envector)))
-                                   ; >=2 free variables - build vector
         (t
-         `(curry
-           (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new))
-           (vector . ,envector))))))
+         `(internal-make-closure
+           ,vars ,envector . ,body-forms-new)))))
 
     (`(function . ,_) form)             ; Same as quote.
 
@@ -714,10 +695,8 @@ 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 (if (null (cdr envs))
-                           cconv--env-var
-                         ;; Replace form => (aref env #)
-                         `(aref ,cconv--env-var ,numero))))
+                  ;; Replace form => (aref env #)
+                  (var `(internal-get-closed-var ,numero)))
              (if (memq form emvrs) ; form => (car (aref env #)) if mutable
                  `(car ,var)
                var))