* 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.

2 files changed, 36 insertions, 39 deletions

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))