Clean up left over Emacs-18/19 code, inline byte-code-functions.

* lisp/emacs-lisp/byte-opt.el (byte-inline-lapcode): Move to bytecomp.el.
(byte-compile-inline-expand): Inline all bytecompiled functions.
Unify the inlining code of the lexbind and dynbind interpreted functions.
(byte-compile-unfold-lambda): Don't handle byte-compiled functions at all.
(byte-optimize-form-code-walker): Don't optimize byte-compiled inlined
functions here.
(byte-compile-splice-in-already-compiled-code): Remove.
(byte-code): Don't optimize it any more.
(byte-decompile-bytecode-1): Remove unused bytedecomp-bytes.
Leave `byte-return's even for `make-spliceable'.
* lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble):
byte-compile-lambda now always returns a byte-code-function.
(byte-compile-byte-code-maker, byte-compile-byte-code-unmake)
(byte-compile-closure): Remove.
(byte-compile-lambda): Always return a byte-code-function.
(byte-compile-top-level): Don't handle `byte-code' forms specially.
(byte-compile-inline-lapcode): New function, taken from byte-opt.el.
(byte-compile-unfold-bcf): New function.
(byte-compile-form): Use it to optimize inline byte-code-functions.
(byte-compile-function-form, byte-compile-defun): Simplify.
(byte-compile-defmacro): Don't bother calling
byte-compile-byte-code-maker.

1 files changed, 45 insertions, 97 deletions

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 6a04dfb2507..35c9a5ddf45 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -244,25 +244,6 @@
 	       sexp)))
 	 (cdr form))))
 
-
-;; Splice the given lap code into the current instruction stream.
-;; If it has any labels in it, you're responsible for making sure there
-;; 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)
-  ;; "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))
          (localfn (cdr (assq name byte-compile-function-environment)))
@@ -280,54 +261,42 @@
        (error "File `%s' didn't define `%s'" (nth 1 fn) name))
       ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias.
        (byte-compile-inline-expand (cons fn (cdr form))))
-      ((and (pred byte-code-function-p)
-            ;; FIXME: This only works to inline old-style-byte-codes into
-            ;; old-style-byte-codes.
-            (guard (not (or lexical-binding
-                            (integerp (aref fn 0))))))
-       ;; (message "Inlining %S byte-code" name)
-       (fetch-bytecode fn)
-       (let ((string (aref fn 1)))
-         (assert (not (multibyte-string-p string)))
-         ;; `byte-compile-splice-in-already-compiled-code'
-         ;; takes care of inlining the body.
-         (cons `(lambda ,(aref fn 0)
-                  (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
-               (cdr form))))
-      ((and `(lambda . ,_)
-            ;; With lexical-binding we have several problems:
-            ;; - if `fn' comes from byte-compile-function-environment, we
-            ;;   need to preprocess `fn', so we handle it below.
-            ;; - else, it means that `fn' is dyn-bound (otherwise it would
-            ;;   start with `closure') so copying the code here would cause
-            ;;   it to be mis-interpreted.
-            (guard (not lexical-binding)))
-       (macroexpand-all (cons fn (cdr form))
-                        byte-compile-macro-environment))
-      ((and (or (and `(lambda ,args . ,body)
-                     (let env nil)
-                     (guard (eq fn localfn)))
-                `(closure ,env ,args . ,body))
-            (guard lexical-binding))
-       (let ((renv ()))
-         (dolist (binding env)
-           (cond
-	    ((consp binding)
-             ;; We check shadowing by the args, so that the `let' can be
-             ;; moved within the lambda, which can then be unfolded.
-             ;; FIXME: Some of those bindings might be unused in `body'.
-             (unless (memq (car binding) args) ;Shadowed.
-               (push `(,(car binding) ',(cdr binding)) renv)))
-	    ((eq binding t))
-	    (t (push `(defvar ,binding) body))))
-         ;; (message "Inlining closure %S" (car form))
-         (let ((newfn (byte-compile-preprocess
-                       `(lambda ,args (let ,(nreverse renv) ,@body)))))
-           (if (eq (car-safe newfn) 'function)
-               (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
-             (byte-compile-log-warning
-              (format "Inlining closure %S failed" name))
-             form))))
+      ((pred byte-code-function-p)
+       ;; (message "Inlining byte-code for %S!" name)
+       ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
+       `(,fn ,@(cdr form)))
+      ((or (and `(lambda ,args . ,body) (let env nil))
+           `(closure ,env ,args . ,body))
+       (if (not (or (eq fn localfn)     ;From the same file => same mode.
+                    (eq (not lexical-binding) (not env)))) ;Same mode.
+           ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
+           ;; letbind byte-code (or any other combination for that matter), we
+           ;; can only inline dynbind source into dynbind source or letbind
+           ;; source into letbind source.
+           ;; FIXME: we could of course byte-compile the inlined function
+           ;; first, and then inline its byte-code.
+           form
+         (let ((renv ()))
+           ;; Turn the function's closed vars (if any) into local let bindings.
+           (dolist (binding env)
+             (cond
+              ((consp binding)
+               ;; We check shadowing by the args, so that the `let' can be
+               ;; moved within the lambda, which can then be unfolded.
+               ;; FIXME: Some of those bindings might be unused in `body'.
+               (unless (memq (car binding) args) ;Shadowed.
+                 (push `(,(car binding) ',(cdr binding)) renv)))
+              ((eq binding t))
+              (t (push `(defvar ,binding) body))))
+           (let ((newfn (byte-compile-preprocess
+                         (if (null renv)
+                             `(lambda ,args ,@body)
+                           `(lambda ,args (let ,(nreverse renv) ,@body))))))
+             (if (eq (car-safe newfn) 'function)
+                 (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
+               (byte-compile-log-warning
+                (format "Inlining closure %S failed" name))
+               form)))))
 
       (t ;; Give up on inlining.
        form))))
@@ -341,10 +310,6 @@
   (or name (setq name "anonymous lambda"))
   (let ((lambda (car form))
 	(values (cdr form)))
-    (if (byte-code-function-p lambda)
-	(setq lambda (list 'lambda (aref lambda 0)
-			   (list 'byte-code (aref lambda 1)
-				 (aref lambda 2) (aref lambda 3)))))
     (let ((arglist (nth 1 lambda))
 	  (body (cdr (cdr lambda)))
 	  optionalp restp
@@ -353,6 +318,7 @@
 	  (setq body (cdr body)))
       (if (and (consp (car body)) (eq 'interactive (car (car body))))
 	  (setq body (cdr body)))
+      ;; FIXME: The checks below do not belong in an optimization phase.
       (while arglist
 	(cond ((eq (car arglist) '&optional)
 	       ;; ok, I'll let this slide because funcall_lambda() does...
@@ -430,8 +396,7 @@
 	   (and (nth 1 form)
 		(not for-effect)
 		form))
-	  ((or (byte-code-function-p fn)
-	       (eq 'lambda (car-safe fn)))
+	  ((eq 'lambda (car-safe fn))
 	   (let ((newform (byte-compile-unfold-lambda form)))
 	     (if (eq newform form)
 		 ;; Some error occurred, avoid infinite recursion
@@ -564,7 +529,10 @@
 
           ;; Neeeded as long as we run byte-optimize-form after cconv.
           ((eq fn 'internal-make-closure) form)
-          
+
+          ((byte-code-function-p fn)
+           (cons fn (mapcar #'byte-optimize-form (cdr form))))
+
 	  ((not (symbolp fn))
            (debug)
 	   (byte-compile-warn "`%s' is a malformed function"
@@ -1328,16 +1296,6 @@
     (put (car pure-fns) 'pure t)
     (setq pure-fns (cdr pure-fns)))
   nil)
-
-(defun byte-compile-splice-in-already-compiled-code (form)
-  ;; form is (byte-code "..." [...] n)
-  (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))))
-
-(put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code)
-
 
 (defconst byte-constref-ops
   '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
@@ -1405,18 +1363,17 @@
 ;; In that case, we put a pc value into the list
 ;; before each insn (or its label).
 (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
-  (let ((bytedecomp-bytes bytes)
-	(length (length bytes))
+  (let ((length (length bytes))
         (bytedecomp-ptr 0) optr tags bytedecomp-op offset
 	lap tmp
 	endtag)
     (while (not (= bytedecomp-ptr length))
       (or make-spliceable
 	  (push bytedecomp-ptr lap))
-      (setq bytedecomp-op (aref bytedecomp-bytes bytedecomp-ptr)
+      (setq bytedecomp-op (aref bytes bytedecomp-ptr)
 	    optr bytedecomp-ptr
             ;; This uses dynamic-scope magic.
-            offset (disassemble-offset bytedecomp-bytes))
+            offset (disassemble-offset bytes))
       (setq bytedecomp-op (aref byte-code-vector bytedecomp-op))
       (cond ((memq bytedecomp-op byte-goto-ops)
 	     ;; It's a pc.
@@ -1437,12 +1394,6 @@
                                 (let ((new (list tmp)))
                                   (push new byte-compile-variables)
                                   new)))))
-	    ((and make-spliceable
-		  (eq bytedecomp-op 'byte-return))
-	     (if (= bytedecomp-ptr (1- length))
-		 (setq bytedecomp-op nil)
-	       (setq offset (or endtag (setq endtag (byte-compile-make-tag)))
-		     bytedecomp-op 'byte-goto)))
 	    ((eq bytedecomp-op 'byte-stack-set2)
 	     (setq bytedecomp-op 'byte-stack-set))
 	    ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80))
@@ -1467,9 +1418,6 @@
 	       (setq rest (cdr rest))))
 	(setq rest (cdr rest))))
     (if tags (error "optimizer error: missed tags %s" tags))
-    ;; Take off the dummy nil op that we replaced a trailing "return" with.
-    (if (null (car (cdr (car lap))))
-	(setq lap (cdr lap)))
     (if endtag
 	(setq lap (cons (cons nil endtag) lap)))
     ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )