Fix disassembly of non-compiled lexical functions (bug#21377)

* lisp/emacs-lisp/bytecomp.el (byte-compile): Handle `closure' arg.
* lisp/emacs-lisp/disass.el: Use lexical-binding.
(disassemble): Recognize `closure's as well.
(disassemble-internal): Use indirect-function and
help-function-arglist, and accept `closure's.
(disassemble-internal): Use interactive-form.
(disassemble-1): Use functionp.

2 files changed, 32 insertions, 35 deletions

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 7182c0b6372..9edb8d7122c 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2585,7 +2585,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                  (if (symbolp form) form "provided"))
         fun)
        (t
-        (when (symbolp form)
+        (when (or (symbolp form) (eq (car-safe fun) 'closure))
+          ;; `fun' is a function *value*, so try to recover its corresponding
+          ;; source code.
           (setq lexical-binding (eq (car fun) 'closure))
           (setq fun (byte-compile--reify-function fun)))
         ;; Expand macros.
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 15489fc2015..12cf605cce9 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -1,4 +1,4 @@
-;;; disass.el --- disassembler for compiled Emacs Lisp code
+;;; disass.el --- disassembler for compiled Emacs Lisp code  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 1986, 1991, 2002-2015 Free Software Foundation, Inc.
 
@@ -37,9 +37,9 @@
 
 (require 'macroexp)
 
-;;; The variable byte-code-vector is defined by the new bytecomp.el.
-;;; The function byte-decompile-lapcode is defined in byte-opt.el.
-;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
+;; The variable byte-code-vector is defined by the new bytecomp.el.
+;; The function byte-decompile-lapcode is defined in byte-opt.el.
+;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
 (require 'byte-compile "bytecomp")
 
 (defvar disassemble-column-1-indent 8 "*")
@@ -57,8 +57,8 @@ redefine OBJECT if it is a symbol."
   (interactive (list (intern (completing-read "Disassemble function: "
                                               obarray 'fboundp t))
                      nil 0 t))
-  (if (and (consp object) (not (eq (car object) 'lambda)))
-      (setq object (list 'lambda () object)))
+  (if (and (consp object) (not (functionp object)))
+      (setq object `(lambda () ,object)))
   (or indent (setq indent 0))           ;Default indent to zero
   (save-excursion
     (if (or interactive-p (null buffer))
@@ -72,37 +72,34 @@ redefine OBJECT if it is a symbol."
 
 (defun disassemble-internal (obj indent interactive-p)
   (let ((macro 'nil)
-        (name 'nil)
-        (doc 'nil)
+        (name (when (symbolp obj)
+                (prog1 obj
+                  (setq obj (indirect-function obj)))))
         args)
-    (while (symbolp obj)
-      (setq name obj
-            obj (symbol-function obj)))
+    (setq obj (autoload-do-load obj name))
     (if (subrp obj)
         (error "Can't disassemble #<subr %s>" name))
-    (setq obj (autoload-do-load obj name))
     (if (eq (car-safe obj) 'macro)      ;Handle macros.
         (setq macro t
               obj (cdr obj)))
-    (if (and (listp obj) (eq (car obj) 'byte-code))
-        (setq obj (list 'lambda nil obj)))
-    (if (and (listp obj) (not (eq (car obj) 'lambda)))
-        (error "not a function"))
-    (if (consp obj)
-        (if (assq 'byte-code obj)
-            nil
-          (if interactive-p (message (if name
-                                         "Compiling %s's definition..."
-                                       "Compiling definition...")
-                                     name))
-          (setq obj (byte-compile obj))
-          (if interactive-p (message "Done compiling.  Disassembling..."))))
+    (if (eq (car-safe obj) 'byte-code)
+        (setq obj `(lambda () ,obj)))
+    (when (consp obj)
+      (unless (functionp obj) (error "not a function"))
+      (if (assq 'byte-code obj)
+          nil
+        (if interactive-p (message (if name
+                                       "Compiling %s's definition..."
+                                     "Compiling definition...")
+                                   name))
+        (setq obj (byte-compile obj))
+        (if interactive-p (message "Done compiling.  Disassembling..."))))
     (cond ((consp obj)
+           (setq args (help-function-arglist obj))      ;save arg list
            (setq obj (cdr obj))         ;throw lambda away
-           (setq args (car obj))        ;save arg list
            (setq obj (cdr obj)))
           ((byte-code-function-p obj)
-           (setq args (aref obj 0)))
+           (setq args (help-function-arglist obj)))
           (t (error "Compilation failed")))
     (if (zerop indent) ; not a nested function
         (progn
@@ -127,10 +124,7 @@ redefine OBJECT if it is a symbol."
     (insert "  args: ")
     (prin1 args (current-buffer))
     (insert "\n")
-    (let ((interactive (cond ((consp obj)
-                              (assq 'interactive obj))
-                             ((> (length obj) 5)
-                              (list 'interactive (aref obj 5))))))
+    (let ((interactive (interactive-form obj)))
       (if interactive
           (progn
             (setq interactive (nth 1 interactive))
@@ -226,15 +220,16 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
                  ;; but if the value of the constant is compiled code, then
                  ;; recursively disassemble it.
                  (cond ((or (byte-code-function-p arg)
-                            (and (eq (car-safe arg) 'lambda)
+                            (and (consp arg) (functionp arg)
                                  (assq 'byte-code arg))
                             (and (eq (car-safe arg) 'macro)
                                  (or (byte-code-function-p (cdr arg))
-                                     (and (eq (car-safe (cdr arg)) 'lambda)
+                                     (and (consp (cdr arg))
+                                          (functionp (cdr arg))
                                           (assq 'byte-code (cdr arg))))))
                         (cond ((byte-code-function-p arg)
                                (insert "<compiled-function>\n"))
-                              ((eq (car-safe arg) 'lambda)
+                              ((functionp arg)
                                (insert "<compiled lambda>"))
                               (t (insert "<compiled macro>\n")))
                         (disassemble-internal