Distinguishing `consp` and `functionp`

[Stefan Monnier <monnier@iro.umontreal.ca>]

[-- Attachment #1: Type: text/plain, Size: 1104 bytes --]

I've been annoyed at the use of lists to represent function values for
a while now.  For a reason I cannot fathom, I even managed to reproduce
that very same mistake in Emacs-24 with the `(closure ...)` value for
statically scoped interpreted function values.

That was a major blunder.

In any case, I'm playing around with a "fix", making lambda evaluate
(when interpreted) not to (lambda ...) or (closure ...) but to
a self-evaluating value that can be more reliably distinguished.
In the patch below, I just reused the #[...] byte-code objects for that,
putting the function's body where the bytecode string goes and the
function's captured environment where the "constant vector" goes.

It's got several rough edges (most importantly that
`byte-code-function-p` returns non-nil for interpreted function values),
but it seems to work OK so far.

You can't use the patch as-is because it's written against my local
branch, with various local hacks, some of which (partly) remove support
for lexical-binding==nil.
But hopefully, it's readable enough for you to form an opinion.

WDYT?


        Stefan

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: interpreted-function.diff --]
[-- Type: text/x-diff, Size: 28624 bytes --]

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 94e467c31b7..a967487dce1 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -160,12 +160,14 @@ byte-compile-inline-expand
        (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))))
-      ((pred byte-code-function-p)
+      ((and (pred byte-code-function-p)
+            (pred compiled-function-p))
        ;; (message "Inlining byte-code for %S!" name)
        ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
        (byte-compile--check-arity-bytecode form fn)
        `(,fn ,@(cdr form)))
-      ((or `(lambda . ,_) `(closure . ,_))
+      ((or `(lambda . ,_) `(closure . ,_)    ;FIXME??
+           (pred byte-code-function-p)) ;But not compiled!
        ;; 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 lexbind
@@ -3139,7 +3141,6 @@ byte-optimize-lapcode
 ;;
 (eval-when-compile
  (or (compiled-function-p (symbol-function 'byte-optimize-form))
-     (assq 'byte-code (symbol-function 'byte-optimize-form))
      (let ((byte-optimize nil)
 	   (byte-compile-warnings nil))
        (mapc (lambda (x)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f3a494ab7ae..62e6cac404f 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2928,18 +2928,13 @@ byte-compile-output-as-comment
 
 (defun byte-compile--reify-function (fun)
   "Return an expression which will evaluate to a function value FUN.
-FUN should be either a `lambda' value or a `closure' value."
-  (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil))
-                    `(closure ,env ,args . ,body))
-                fun)
-               (preamble nil)
-               (renv ()))
-    ;; Split docstring and `interactive' form from body.
-    (when (stringp (car body))
-      (push (pop body) preamble))
-    (when (eq (car-safe (car body)) 'interactive)
-      (push (pop body) preamble))
-    (setq preamble (nreverse preamble))
+FUN should be either an interpreted closure."
+  (let ((args (aref fun 0))
+        (body (aref fun 1))
+        (env (aref fun 2))
+        (docstring (function-documentation fun))
+        (iform (interactive-form fun))
+        (renv ()))
     ;; Turn the function's closed vars (if any) into local let bindings.
     (dolist (binding env)
       (cond
@@ -2947,9 +2942,10 @@ byte-compile--reify-function
         (push `(,(car binding) ',(cdr binding)) renv))
        ((eq binding t))
        (t (push `(defvar ,binding) body))))
-    (if (null renv)
-        `(lambda ,args ,@preamble ,@body)
-      `(let ,renv (lambda ,args ,@preamble ,@body)))))
+    (let ((fun `(lambda ,args
+                  ,@(if docstring (list docstring))
+                  ,iform ,@body)))
+      (if (null renv) fun `(let ,renv ,fun)))))
 \f
 ;;;###autoload
 (defun byte-compile (form)
@@ -2975,10 +2971,10 @@ byte-compile
         fun)
        (t
         (let (final-eval)
-          (when (or (symbolp form) (eq (car-safe fun) 'closure))
+          (when (eq (type-of fun) 'interpreted-function)
             ;; `fun' is a function *value*, so try to recover its corresponding
             ;; source code.
-            (setq lexical-binding (eq (car fun) 'closure))
+            (setq lexical-binding (not (null (aref fun 2))))
             (setq fun (byte-compile--reify-function fun))
             (setq final-eval t))
           ;; Expand macros.
@@ -3492,6 +3488,7 @@ byte-compile-form
               (funcall handler form)
             (byte-compile-normal-call form))))
        ((and (byte-code-function-p (car form))
+             (compiled-function-p (car form))
              (memq byte-optimize '(t lap)))
         (byte-compile-unfold-bcf form))
        ((byte-compile-normal-call form)))
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 305c10c2d7e..5cb2470cf8b 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -909,7 +909,7 @@ cconv-fv
                                     (delete-dups cconv--dynbindings)))))
         (cons fvs dyns)))))
 
-(defun cconv-make-interpreted-closure (fun env)
+(defun cconv-make-interpreted-closure (args body env docstring iform)
   "Make a closure for the interpreter.
 This is intended to be called at runtime by the ELisp interpreter (when
 the code has not been compiled).
@@ -918,22 +918,23 @@ cconv-make-interpreted-closure
 i.e. a list whose elements can be either plain symbols (which indicate
 that this symbol should use dynamic scoping) or pairs (SYMBOL . VALUE)
 for the lexical bindings."
-  (cl-assert (eq (car-safe fun) 'lambda))
+  (cl-assert (listp body))
+  (cl-assert (listp args))
   (let ((lexvars (delq nil (mapcar #'car-safe env))))
     (if (or (null lexvars)
             ;; Functions with a `:closure-dont-trim-context' marker
             ;; should keep their whole context untrimmed (bug#59213).
-            (and (eq :closure-dont-trim-context (nth 2 fun))
+            (and (eq :closure-dont-trim-context (car body))
                  ;; Check the function doesn't just return the magic keyword.
-                 (nthcdr 3 fun)))
+                 (cdr body)))
         ;; The lexical environment is empty, or needs to be preserved,
         ;; so there's no need to look for free variables.
         ;; Attempting to replace ,(cdr fun) by a macroexpanded version
         ;; causes bootstrap to fail.
-        `(closure ,env . ,(cdr fun))
+        (make-interpreted-closure args body env docstring iform)
       ;; We could try and cache the result of the macroexpansion and
       ;; `cconv-fv' analysis.  Not sure it's worth the trouble.
-      (let* ((form `#',fun)
+      (let* ((form `#'(lambda ,args ,iform . ,body))
              (expanded-form
               (let ((lexical-binding t) ;; Tell macros which dialect is in use.
 	            ;; Make the macro aware of any defvar declarations in scope.
@@ -942,16 +943,17 @@ cconv-make-interpreted-closure
                          (append env macroexp--dynvars) env)))
                 (macroexpand-all form macroexpand-all-environment)))
              ;; Since we macroexpanded the body, we may as well use that.
-             (expanded-fun-cdr
+             (expanded-fun-body
               (pcase expanded-form
-                (`#'(lambda . ,cdr) cdr)
-                (_ (cdr fun))))
+                (`#'(lambda ,_args ,_iform . ,newbody) newbody)
+                (_ body)))
 
              (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
              (fvs (cconv-fv expanded-form lexvars dynvars))
              (newenv (nconc (mapcar (lambda (fv) (assq fv env)) (car fvs))
                             (cdr fvs))))
-        `(closure ,newenv . ,expanded-fun-cdr)))))
+        (make-interpreted-closure args expanded-fun-body newenv
+                                  docstring iform)))))
 
 
 (provide 'cconv)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 25aa2c03a66..2974079bba7 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -758,7 +758,7 @@ cl--generic-compiler
   ;; compiled.  Otherwise the byte-compiler and all the code on
   ;; which it depends needs to be usable before cl-generic is loaded,
   ;; which imposes a significant burden on the bootstrap.
-  (if (consp (lambda (x) (+ x 1)))
+  (if (not (compiled-function-p (lambda (x) (+ x 1))))
       (lambda (exp) (eval exp t))
     ;; But do byte-compile the dispatchers once bootstrap is passed:
     ;; the performance difference is substantial (like a 5x speedup on
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 896fd6b1f18..72113441f85 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -62,8 +62,9 @@ cl--typeof-types
     (marker integer-or-marker number-or-marker atom)
     (overlay atom) (float number number-or-marker atom)
     (window-configuration atom) (process atom) (window atom)
-    ;; FIXME: Actually `function' isn't true for special forms!
-    (subr function cons-or-function atom)
+    ;; FIXME: Actually `(compiled-)function' isn't true for special forms!
+    (subr compiled-function function cons-or-function atom)
+    (interpreted-function function cons-or-function atom)
     (byte-code-function compiled-function function cons-or-function atom)
     (module-function function cons-or-function atom)
     (buffer atom) (char-table array sequence atom)
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index a1627709092..447a4d265e6 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -237,6 +237,62 @@ cl-print-object
                               'byte-code-function object)))))
     (princ ")" stream)))
 
+(cl-defmethod cl-print-object ((object interpreted-function) stream)
+  (unless stream (setq stream standard-output))
+  (princ "#f(interpreted-function " stream)
+  (let ((args (help-function-arglist object 'preserve-names)))
+    (if args
+        (prin1 args stream)
+      (princ "()" stream)))
+  (if (eq cl-print-compiled 'raw)
+      (let ((button-start
+             (and cl-print-compiled-button
+                  (bufferp stream)
+                  (with-current-buffer stream (1+ (point))))))
+        (princ " " stream)
+        (prin1 object stream)
+        (when button-start
+          (with-current-buffer stream
+            (make-text-button button-start (point)
+                              :type 'help-byte-code
+                              'byte-code-function object))))
+    (pcase (help-split-fundoc (documentation object 'raw) object)
+      ;; Drop args which `help-function-arglist' already printed.
+      (`(,_usage . ,(and doc (guard (stringp doc))))
+       (princ " " stream)
+       (prin1 doc stream)))
+    (let ((inter (interactive-form object)))
+      (when inter
+        (princ " " stream)
+        (cl-print-object
+         (if (eq 'byte-code (car-safe (cadr inter)))
+             `(interactive ,(make-byte-code nil (nth 1 (cadr inter))
+                                            (nth 2 (cadr inter))
+                                            (nth 3 (cadr inter))))
+           inter)
+         stream)))
+    (if (eq cl-print-compiled 'disassemble)
+        (princ
+         (with-temp-buffer
+           (insert "\n")
+           (pp (aref object 1))
+           (buffer-string))
+         stream)
+      (princ " " stream)
+      (let ((button-start (and cl-print-compiled-button
+                               (bufferp stream)
+                               (with-current-buffer stream (point)))))
+        (princ (format "#<sexpcode %#x>" (sxhash object)) stream)
+        (when (eq cl-print-compiled 'static)
+          (princ " " stream)
+          (cl-print-object (aref object 2) stream))
+        (when button-start
+          (with-current-buffer stream
+            (make-text-button button-start (point)
+                              :type 'help-byte-code
+                              'byte-code-function object)))))
+    (princ ")" stream)))
+
 ;; This belongs in oclosure.el, of course, but some load-ordering issues make it
 ;; complicated.
 (cl-defmethod cl-print-object ((object accessor) stream)
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 6d79f9c41f8..4763f2223fd 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -548,70 +548,51 @@ oclosure--fix-type
   by moving it from the docstring to the environment.
 - For compiled code, this is used as a marker which cconv uses to check that
   immutable fields are indeed not mutated."
-  (if (byte-code-function-p oclosure)
-      ;; Actually, this should never happen since the `cconv.el' should have
-      ;; optimized away the call to this function.
-      oclosure
-    ;; For byte-coded functions, we store the type as a symbol in the docstring
-    ;; slot.  For interpreted functions, there's no specific docstring slot
-    ;; so `Ffunction' turns the symbol into a string.
-    ;; We thus have convert it back into a symbol (via `intern') and then
-    ;; stuff it into the environment part of the closure with a special
-    ;; marker so we can distinguish this entry from actual variables.
-    (cl-assert (eq 'closure (car-safe oclosure)))
-    (let ((typename (nth 3 oclosure))) ;; The "docstring".
-      (cl-assert (stringp typename))
-      (push (cons :type (intern typename))
-            (cadr oclosure))
-      oclosure)))
+  (cl-assert (byte-code-function-p oclosure))
+  ;; This should happen only for interpreted closures since the `cconv.el'
+  ;; should have optimized away the call to this function.
+  oclosure)
 
 (defun oclosure--copy (oclosure mutlist &rest args)
-  (if (byte-code-function-p oclosure)
+  (cl-assert (byte-code-function-p oclosure))
+  (if (stringp (aref oclosure 1))       ;Actual byte-code
       (apply #'make-closure oclosure
              (if (null mutlist)
                  args
                (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
-    (cl-assert (eq 'closure (car-safe oclosure))
-               nil "oclosure not closure: %S" oclosure)
-    (cl-assert (eq :type (caar (cadr oclosure))))
-    (let ((env (cadr oclosure)))
-      `(closure
-           (,(car env)
-            ,@(named-let loop ((env (cdr env)) (args args))
-                (when args
+    (cl-assert (listp (aref oclosure 1)))
+    (cl-assert (symbolp (aref oclosure 4)))
+    (let ((env (aref oclosure 2)))
+      (apply #'make-interpreted-closure
+             (aref oclosure 0)
+             (aref oclosure 1)
+             (named-let loop ((env env) (args args))
+                (if (null args) env
                   (cons (cons (caar env) (car args))
                         (loop (cdr env) (cdr args)))))
-            ,@(nthcdr (1+ (length args)) env))
-           ,@(nthcdr 2 oclosure)))))
+             (nthcdr 4 (append oclosure '()))))))
 
 (defun oclosure--get (oclosure index mutable)
-  (if (byte-code-function-p oclosure)
-      (let* ((csts (aref oclosure 2))
-             (v (aref csts index)))
-        (if mutable (car v) v))
-    (cl-assert (eq 'closure (car-safe oclosure)))
-    (cl-assert (eq :type (caar (cadr oclosure))))
-    (cdr (nth (1+ index) (cadr oclosure)))))
+  (cl-assert (byte-code-function-p oclosure))
+  (let* ((csts (aref oclosure 2)))
+    (if (vectorp csts)
+        (let ((v (aref csts index)))
+          (if mutable (car v) v))
+      (cdr (nth index csts)))))
 
 (defun oclosure--set (v oclosure index)
-  (if (byte-code-function-p oclosure)
-      (let* ((csts (aref oclosure 2))
-             (cell (aref csts index)))
-        (setcar cell v))
-    (cl-assert (eq 'closure (car-safe oclosure)))
-    (cl-assert (eq :type (caar (cadr oclosure))))
-    (setcdr (nth (1+ index) (cadr oclosure)) v)))
+  (cl-assert (byte-code-function-p oclosure))
+  (let ((csts (aref oclosure 2)))
+    (if (vectorp csts)
+        (let ((cell (aref csts index)))
+          (setcar cell v))
+      (setcdr (nth index csts) v))))
 
 (defun oclosure-type (oclosure)
   "Return the type of OCLOSURE, or nil if the arg is not a OClosure."
   (if (byte-code-function-p oclosure)
       (let ((type (and (> (length oclosure) 4) (aref oclosure 4))))
-        (if (symbolp type) type))
-    (and (eq 'closure (car-safe oclosure))
-         (let* ((env (car-safe (cdr oclosure)))
-                (first-var (car-safe env)))
-           (and (eq :type (car-safe first-var))
-                (cdr first-var))))))
+        (if (symbolp type) type))))
 
 (defconst oclosure--accessor-prototype
   ;; Use `oclosure--lambda' to circumvent a bootstrapping problem:
diff --git a/lisp/subr.el b/lisp/subr.el
index b6b6eeac843..ffea44265c9 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4666,7 +4666,8 @@ compiled-function-p
 Does not distinguish between functions implemented in machine code
 or byte-code."
   (declare (side-effect-free error-free))
-  (or (subrp object) (byte-code-function-p object)))
+  (or (subrp object)
+      (and (byte-code-function-p object) (stringp (aref object 1)))))
 
 (defun field-at-pos (pos)
   "Return the field at position POS, taking stickiness etc into account."
diff --git a/src/alloc.c b/src/alloc.c
index c4d92c9d198..3137e7a7758 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3823,17 +3823,22 @@ and (optional) INTERACTIVE-SPEC.
 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  if (! ((FIXNUMP (args[COMPILED_ARGLIST])
-	  || CONSP (args[COMPILED_ARGLIST])
-	  || NILP (args[COMPILED_ARGLIST]))
-	 && STRINGP (args[COMPILED_BYTECODE])
-	 && !STRING_MULTIBYTE (args[COMPILED_BYTECODE])
-	 && VECTORP (args[COMPILED_CONSTANTS])
-	 && FIXNATP (args[COMPILED_STACK_DEPTH])))
+  if (CONSP (args[COMPILED_BYTECODE]))
+    ;                           /* An interpreted closure.  */
+  else if ((FIXNUMP (args[COMPILED_ARGLIST])
+	    || CONSP (args[COMPILED_ARGLIST])
+	    || NILP (args[COMPILED_ARGLIST]))
+	   && STRINGP (args[COMPILED_BYTECODE])
+	   && !STRING_MULTIBYTE (args[COMPILED_BYTECODE])
+	   && VECTORP (args[COMPILED_CONSTANTS])
+	   && FIXNATP (args[COMPILED_STACK_DEPTH]))
+    {
+      /* Bytecode must be immovable.  */
+      pin_string (args[COMPILED_BYTECODE]);
+    }
+  else
     error ("Invalid byte-code object");
 
-  /* Bytecode must be immovable.  */
-  pin_string (args[COMPILED_BYTECODE]);
 
   /* We used to purecopy everything here, if purify-flag was set.  This worked
      OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
diff --git a/src/data.c b/src/data.c
index f780170d683..321f7c5183c 100644
--- a/src/data.c
+++ b/src/data.c
@@ -226,7 +226,9 @@ DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
         case PVEC_PROCESS: return Qprocess;
         case PVEC_WINDOW: return Qwindow;
         case PVEC_SUBR: return Qsubr;
-        case PVEC_COMPILED: return Qbyte_code_function;
+        case PVEC_COMPILED:
+          return CONSP (AREF (object, 1))
+                 ? Qinterpreted_function : Qbyte_code_function;
         case PVEC_OBARRAY: return Qobarray;
         case PVEC_BUFFER: return Qbuffer;
         case PVEC_CHAR_TABLE: return Qchar_table;
@@ -4183,6 +4185,7 @@ #define PUT_ERROR(sym, tail, msg)			\
   DEFSYM (Qwindow, "window");
   DEFSYM (Qsubr, "subr");
   DEFSYM (Qbyte_code_function, "byte-code-function");
+  DEFSYM (Qinterpreted_function, "interpreted-function");
   DEFSYM (Qbuffer, "buffer");
   DEFSYM (Qframe, "frame");
   DEFSYM (Qvector, "vector");
diff --git a/src/eval.c b/src/eval.c
index 916e9d8353a..b4c43d08e54 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -518,6 +518,30 @@ DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
   return XCAR (args);
 }
 
+DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
+       Smake_interpreted_closure, 3, 5, 0,
+       doc: /* Make an interpreted closure.
+BODY should be a list of forms.
+IFORM if non-nil should be of the form (interactive ...).  */)
+  (Lisp_Object args, Lisp_Object body, Lisp_Object env,
+   Lisp_Object docstring, Lisp_Object iform)
+{
+  CHECK_LIST (body);          /* Make sure it's not confused with byte-code! */
+  if (!NILP (iform))
+    {
+      iform = Fcdr (iform);
+      return CALLN (Fmake_byte_code,
+                    args, body, env, Qnil, docstring,
+                    NILP (Fcdr (iform))
+                    ? Fcar (iform)
+                    : CALLN (Fvector, XCAR (iform), XCDR (iform)));
+    }
+  else if (!NILP (docstring))
+    return CALLN (Fmake_byte_code, args, body, env, Qnil, docstring);
+  else
+    return CALLN (Fmake_byte_code, args, body, env);
+}
+
 DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
        doc: /* Like `quote', but preferred for objects which are functions.
 In byte compilation, `function' causes its argument to be handled by
@@ -540,26 +564,46 @@ DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
 	 Also return a "closure" for dynamically scoped functions, just so as to
 	 distinguish lambda source expressions from their evaluated value!  */
       Lisp_Object cdr = XCDR (quoted);
-      Lisp_Object tmp = cdr;
-      if (CONSP (tmp)
-	  && (tmp = XCDR (tmp), CONSP (tmp))
-	  && (tmp = XCAR (tmp), CONSP (tmp))
-	  && (EQ (QCdocumentation, XCAR (tmp))))
-	{
-	  Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp)));
-	  if (SYMBOLP (docstring) && !NILP (docstring))
-	    /* Hack for OClosures: Allow the docstring to be a symbol
-             * (the OClosure's type).  */
-	    docstring = Fsymbol_name (docstring);
-	  CHECK_STRING (docstring);
-	  cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
-	}
+      Lisp_Object args = Fcar (cdr);
+      cdr = Fcdr (cdr);
+      Lisp_Object docstring = Qnil, iform = Qnil;
+      if (CONSP (cdr))
+        {
+          docstring = XCAR (cdr);
+          if (STRINGP (docstring))
+            {
+              Lisp_Object tmp = XCDR (cdr);
+              /* Beware: The docstring can be also the return value!  */
+              if (!NILP (tmp))
+                cdr = tmp;
+            }
+          else if (CONSP (docstring)
+                   && EQ (QCdocumentation, XCAR (docstring))
+                   && (docstring = eval_sub (Fcar (XCDR (docstring))),
+                       true))
+            cdr = XCDR (cdr);
+          else
+            docstring = Qnil;   /* Not a docstring after all.  */
+        }
+      if (CONSP (cdr))
+        {
+          iform = XCAR (cdr);
+          if (CONSP (iform)
+              && EQ (Qinteractive, XCAR (iform)))
+            cdr = XCDR (cdr);
+          else
+            iform = Qnil;   /* Not an interactive-form after all.  */
+        }
+      if (NILP (cdr))
+        cdr = Fcons (Qnil, Qnil); /* Make sure the body is never empty! */
+
       if (NILP (Vinternal_make_interpreted_closure_function))
-        return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr));
+        return Fmake_interpreted_closure
+            (args, cdr, Vinternal_interpreter_environment, docstring, iform);
       else
-        return call2 (Vinternal_make_interpreted_closure_function,
-                      Fcons (Qlambda, cdr),
-                      Vinternal_interpreter_environment);
+        return call5 (Vinternal_make_interpreted_closure_function,
+                      args, cdr, Vinternal_interpreter_environment,
+                      docstring, iform);
     }
   else
     /* Simply quote the argument.  */
@@ -3102,7 +3146,7 @@ fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
 			  ptrdiff_t nargs, Lisp_Object *args)
 {
   if (CONSP (AREF (fun, COMPILED_BYTECODE)))
-    Ffetch_bytecode (fun);
+    return Fprogn (AREF (fun, COMPILED_BYTECODE));
 
   return exec_byte_code (fun, args_template, nargs, args);
 }
@@ -3178,10 +3222,12 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
       if (FIXNUMP (syms_left))
 	return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left),
 					 nargs, arg_vector);
-      /* Otherwise the bytecode object uses dynamic binding and the
-	 ARGLIST slot contains a standard formal argument list whose
-	 variables are bound dynamically below.  */
-      lexenv = Qnil;
+      /* Otherwise the bytecode object either is an interpreted closure
+	 or uses dynamic binding and the ARGLIST slot contains a standard
+	 formal argument list whose variables are bound dynamically below.  */
+      lexenv = CONSP (AREF (fun, COMPILED_BYTECODE))
+               ? AREF (fun, COMPILED_CONSTANTS)
+               : Qnil;
     }
 #ifdef HAVE_MODULES
   else if (MODULE_FUNCTIONP (fun))
@@ -3387,7 +3433,8 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
 
   if (COMPILEDP (object))
     {
-      if (CONSP (AREF (object, COMPILED_BYTECODE)))
+      if (CONSP (AREF (object, COMPILED_BYTECODE))
+	  && INTEGERP (XCDR (AREF (object, COMPILED_BYTECODE))))
 	{
 	  tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
 	  if (! (CONSP (tem) && STRINGP (XCAR (tem))
@@ -4316,7 +4363,7 @@ syms_of_eval (void)
 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
 The command `toggle-debug-on-error' toggles this.
 See also the variable `debug-on-quit' and `inhibit-debugger'.  */);
-  Vdebug_on_error = Qt;
+  Vdebug_on_error = Qnil;
 
   DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
     doc: /* List of errors for which the debugger should not be called.
@@ -4449,6 +4496,7 @@ syms_of_eval (void)
   defsubr (&Ssetq);
   defsubr (&Squote);
   defsubr (&Sfunction);
+  defsubr (&Smake_interpreted_closure);
   defsubr (&Sdefault_toplevel_value);
   defsubr (&Sset_default_toplevel_value);
   defsubr (&Sdefvar);
diff --git a/src/lread.c b/src/lread.c
index 35f3a4e97a4..92f4c523239 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3272,11 +3272,12 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
   Lisp_Object *vec = XVECTOR (obj)->contents;
   ptrdiff_t size = ASIZE (obj);
 
-  if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1
+  if (!(size >= COMPILED_STACK_DEPTH && size <= COMPILED_INTERACTIVE + 1
 	&& (FIXNUMP (vec[COMPILED_ARGLIST])
 	    || CONSP (vec[COMPILED_ARGLIST])
 	    || NILP (vec[COMPILED_ARGLIST]))
-	&& FIXNATP (vec[COMPILED_STACK_DEPTH])))
+	&& (FIXNATP (vec[COMPILED_STACK_DEPTH])
+	     || !STRINGP (vec[COMPILED_BYTECODE]))))
     invalid_syntax ("Invalid byte-code object", readcharfun);
 
   if (load_force_doc_strings
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 3f544a35e3e..282cf13edbc 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -2893,7 +2893,7 @@ group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum)
    To guarantee termination, at each iteration, either LOOP_BEG should
    get bigger, or it should stay the same and P should get bigger.  */
 static bool
-forall_firstchar_1 (re_char *p, re_char *pend,
+forall_firstchar_1 (struct re_pattern_buffer *bufp, re_char *p, re_char *pend,
                     re_char *loop_beg, re_char *loop_end,
                     bool f (const re_char *p, void *arg), void *arg)
 {
@@ -2985,8 +2985,18 @@ forall_firstchar_1 (re_char *p, re_char *pend,
                forward over a subsequent `jump`.  Recognize this pattern
                since that subsequent `jump` is the one that jumps to the
                loop-entry.  */
-	    newp2 = ((re_opcode_t) *newp2 == jump)
-	            ? extract_address (newp2 + 1) : newp2;
+	    if ((re_opcode_t) *newp2 == jump)
+	      {
+	        re_char *p3 = extract_address (newp2 + 1);
+	        /* Only recognize this pattern if one of the two destinations
+	           is going forward, otherwise we'll fall into the pessimistic
+	           "Both destinations go backward" below.
+	           This is important if the `jump` at newp2 is the end of an
+	           outer loop while the `on_failure_jump` is the end of an
+	           inner loop.  */
+	        if (p3 > p_orig || newp1 > p_orig)
+	          newp2 = p3;
+	      }
 
 	  do_twoway_jump:
 	    /* We have to check that both destinations are safe.
@@ -2998,11 +3008,17 @@ forall_firstchar_1 (re_char *p, re_char *pend,
 	      {
 #if ENABLE_CHECKING
 	        fprintf (stderr, "FORALL_FIRSTCHAR: Broken assumption2!!\n");
+	        fprintf (stderr, "Destinations: %ld and %ld!!\n",
+	                 newp1 - bufp->buffer,
+	                 newp2 - bufp->buffer);
+	        fprintf (stderr, "loop_beg = %ld and loop_end = %ld!!\n",
+	                 loop_beg - bufp->buffer,
+	                 loop_end - bufp->buffer);
 #endif
 	        return false;
               }
 
-            if (!forall_firstchar_1 (newp2, pend, loop_beg, loop_end, f, arg))
+            if (!forall_firstchar_1 (bufp, newp2, pend, loop_beg, loop_end, f, arg))
               return false;
 
 	  do_jump:
@@ -3100,7 +3116,7 @@ forall_firstchar (struct re_pattern_buffer *bufp, re_char *p, re_char *pend,
 {
   eassert (!bufp || bufp->used);
   eassert (pend || bufp->used);
-  return forall_firstchar_1 (p, pend,
+  return forall_firstchar_1 (bufp, p, pend,
                              bufp ? bufp->buffer - 1 : p,
                              bufp ? bufp->buffer + bufp->used + 1 : pend,
                              f, arg);