Use a dedicated type to represent interpreted-function valuesscratch/interpreted-function

Change `function` so that when evaluating #'(lambda ...)
we return an object of type `interpreted-function` rather than
a list starting with one of `lambda` or `closure`.
The new type reuses the existing PVEC_CLOSURE (nee PVEC_COMPILED)
tag and tries to align the corresponding elements:

- the arglist, the docstring, and the interactive-form go in the
  same slots as for byte-code functions.
- the body of the function goes in the slot used for the bytecode string.
- the lexical context goes in the slot used for the constants of
  bytecoded functions.

The first point above means that `help-function-arglist`,
`documentation`, and `interactive-form`s don't need to
distinguish interpreted and bytecode functions any more.

Main benefits of the change:

- We can now reliably distinguish a list from a function value.
- `cl-defmethod` can dispatch on `interactive-function` and `closure`.
  Dispatch on `function` also works now for interpreted functions but still
  won't work for functions represented as lists or as symbols, of course.
- Function values are now self-evaluating.  That was alrready the case
  when byte-compiled, but not when interpreted since
  (eval '(closure ...)) signals a void-function error.
  That also avoids false-positive warnings about "don't quote your lambdas"
  when doing things like `(mapcar ',func ...)`.

* src/eval.c (Fmake_interpreted_closure): New function.
(Ffunction): Use it and change calling convention of
`Vinternal_make_interpreted_closure_function`.
(FUNCTIONP, Fcommandp, eval_sub, funcall_general, funcall_lambda)
(Ffunc_arity, lambda_arity): Simplify.
(funcall_lambda): Adjust to new representation.
(syms_of_eval): `defsubr` the new function.  Remove definition of `Qclosure`.

* lisp/emacs-lisp/cconv.el (cconv-make-interpreted-closure):
Change calling convention and use `make-interpreted-closure`.

* src/data.c (Fcl_type_of): Distinguish `byte-code-function`s from
`interpreted-function`s.
(Fclosurep, finterpreted_function_p): New functions.
(Fbyte_code_function_p): Don't be confused by `interpreted-function`s.
(Finteractive_form, Fcommand_modes): Simplify.
(syms_of_data): Define new type symbols and `defsubr` the two
new functions.

* lisp/emacs-lisp/cl-print.el (cl-print-object) <interpreted-function>:
New method.

* lisp/emacs-lisp/oclosure.el (oclosure): Refine the parent
to be `closure`.
(oclosure--fix-type, oclosure-type): Simplify.
(oclosure--copy, oclosure--get, oclosure--set): Adjust to
new representation.

* src/callint.c (Fcall_interactively): Adjust to new representation.

* src/lread.c (bytecode_from_rev_list):

* lisp/simple.el (function-documentation):
* lisp/help.el (help-function-arglist): Remove the old `closure` case
and adjust the byte-code case so it handles `interpreted-function`s.

* lisp/emacs-lisp/cl-preloaded.el (closure): New type.
(byte-code-function): Add it as a parent.
(interpreted-function): Adjust parent (the type itself was already
added earlier by accident).

* lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Adjust to
new representation.
(byte-compile): Use `interpreted-function-p`.

* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Adjust to
new representation.
(side-effect-free-fns): Add `interpreted-function-p` and `closurep`.

* src/profiler.c (trace_hash, ffunction_equal): Simplify.
* lisp/profiler.el (profiler-function-equal): Simplify.

* lisp/emacs-lisp/nadvice.el (advice--interactive-form-1):
Use `interpreted-function-p`; adjust to new representation; and take
advantage of the fact that function values are now self-evaluating.

* lisp/emacs-lisp/lisp-mode.el (closure):
Remove `lisp-indent-function` property.

* lisp/emacs-lisp/disass.el (disassemble-internal): Adjust to
new representation.
* lisp/emacs-lisp/edebug.el (edebug--strip-instrumentation):
Use `interpreted-function-p`.
* lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers):
Add `closurep` and `interpreted-function-p`.

* test/lisp/help-fns-tests.el (help-fns-test-lisp-defun): Adjust to
more precise type info in `describe-function`.
* test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d--render-entries):
Use `interpreted-function-p`.
* test/lisp/emacs-lisp/macroexp-resources/vk.el (vk-f4, vk-f5):
Don't hardcode function values.

* doc/lispref/functions.texi (Anonymous Functions): Don't suggest that
function values are lists.  Reword "self-quoting" to reflect the
fact that #' doesn't return the exact same object.  Update examples
with the new shape of the return value.

* doc/lispref/variables.texi (Lexical Binding):
* doc/lispref/lists.texi (Rearrangement):
* doc/lispref/control.texi (Handling Errors): Update examples to reflect
new representation of function values.

1 files changed, 93 insertions, 55 deletions

diff --git a/src/eval.c b/src/eval.c
index a7d860114cf..fd388706108 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -510,6 +510,33 @@ usage: (quote ARG)  */)
   return XCAR (args);
 }
 
+DEFUN ("make-interpreted-closure", Fmake_interpreted_closure,
+       Smake_interpreted_closure, 3, 5, 0,
+       doc: /* Make an interpreted closure.
+ARGS should be the list of formal arguments.
+BODY should be a non-empty list of forms.
+ENV should be a lexical environment, like the second argument of `eval'.
+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_CONS (body);          /* Make sure it's not confused with byte-code! */
+  CHECK_LIST (args);
+  CHECK_LIST (iform);
+  Lisp_Object ifcdr = Fcdr (iform);
+  Lisp_Object slots[] = { args,  body, env, Qnil, docstring,
+                          NILP (Fcdr (ifcdr))
+                          ? Fcar (ifcdr)
+                          : CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr)) };
+  /* Adjusting the size is indispensable since, as for byte-code objects,
+     we distinguish interactive functions by the presence or absence of the
+     iform slot.  */
+  Lisp_Object val
+    = Fvector (!NILP (iform) ? 6 : !NILP (docstring) ? 5 : 3, slots);
+  XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
+  return val;
+}
+
 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
@@ -525,33 +552,55 @@ usage: (function ARG)  */)
   if (!NILP (XCDR (args)))
     xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
 
-  if (!NILP (Vinternal_interpreter_environment)
-      && CONSP (quoted)
+  if (CONSP (quoted)
       && EQ (XCAR (quoted), Qlambda))
     { /* This is a lambda expression within a lexical environment;
          return an interpreted closure instead of a simple lambda.  */
       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))))
-        { /* Handle the special (:documentation <form>) to build the docstring
+      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);
+              if (!NILP (tmp))
+                cdr = tmp;
+              else     /* It's not a docstring, it's a return value.  */
+                docstring = Qnil;
+            }
+          /* Handle the special (:documentation <form>) to build the docstring
              dynamically.  */
-          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))));
-        }
-      if (NILP (Vinternal_make_interpreted_closure_function))
-        return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, cdr));
+          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_interpreter_environment)
+          || NILP (Vinternal_make_interpreted_closure_function))
+        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.  */
@@ -2193,15 +2242,12 @@ then strings and vectors are not accepted.  */)
       else
         {
           Lisp_Object body = CDR_SAFE (XCDR (fun));
-          if (EQ (funcar, Qclosure))
-            body = CDR_SAFE (body);
-          else if (!EQ (funcar, Qlambda))
+          if (!EQ (funcar, Qlambda))
             return Qnil;
           if (!NILP (Fassq (Qinteractive, body)))
             return Qt;
-          else if (VALID_DOCSTRING_P (CAR_SAFE (body)))
-            /* A "docstring" is a sign that we may have an OClosure.  */
-            genfun = true;
+          else
+            return Qnil;
         }
     }
 
@@ -2611,8 +2657,7 @@ eval_sub (Lisp_Object form)
           exp = unbind_to (count1, exp);
           val = eval_sub (exp);
         }
-      else if (EQ (funcar, Qlambda)
-               || EQ (funcar, Qclosure))
+      else if (EQ (funcar, Qlambda))
         return apply_lambda (fun, original_args, count);
       else
         xsignal1 (Qinvalid_function, original_fun);
@@ -2950,7 +2995,7 @@ FUNCTIONP (Lisp_Object object)
   else if (CONSP (object))
     {
       Lisp_Object car = XCAR (object);
-      return EQ (car, Qlambda) || EQ (car, Qclosure);
+      return EQ (car, Qlambda);
     }
   else
     return false;
@@ -2980,8 +3025,7 @@ funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args)
       Lisp_Object funcar = XCAR (fun);
       if (!SYMBOLP (funcar))
         xsignal1 (Qinvalid_function, original_fun);
-      if (EQ (funcar, Qlambda)
-          || EQ (funcar, Qclosure))
+      if (EQ (funcar, Qlambda))
         return funcall_lambda (fun, numargs, args);
       else if (EQ (funcar, Qautoload))
         {
@@ -3165,16 +3209,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
 
   if (CONSP (fun))
     {
-      if (EQ (XCAR (fun), Qclosure))
-        {
-          Lisp_Object cdr = XCDR (fun); /* Drop `closure'.  */
-          if (! CONSP (cdr))
-            xsignal1 (Qinvalid_function, fun);
-          fun = cdr;
-          lexenv = XCAR (fun);
-        }
-      else
-        lexenv = Qnil;
+      lexenv = Qnil;
       syms_left = XCDR (fun);
       if (CONSP (syms_left))
         syms_left = XCAR (syms_left);
@@ -3189,10 +3224,12 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
          engine directly.  */
       if (FIXNUMP (syms_left))
         return 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 closure either is interpreted
+         or uses dynamic binding and the ARGLIST slot contains a standard
+         formal argument list whose variables are bound dynamically below.  */
+      lexenv = CONSP (AREF (fun, CLOSURE_CODE))
+               ? AREF (fun, CLOSURE_CONSTANTS)
+               : Qnil;
     }
 #ifdef HAVE_MODULES
   else if (MODULE_FUNCTIONP (fun))
@@ -3280,7 +3317,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
       val = XSUBR (fun)->function.a0 ();
     }
   else
-    val = exec_byte_code (fun, 0, 0, NULL);
+    {
+      eassert (CLOSUREP (fun));
+      val = CONSP (AREF (fun, CLOSURE_CODE))
+            /* Interpreted function.  */
+            ? Fprogn (AREF (fun, CLOSURE_CODE))
+            /* Dynbound bytecode.  */
+            : exec_byte_code (fun, 0, 0, NULL);
+    }
 
   return unbind_to (count, val);
 }
@@ -3330,8 +3374,7 @@ function with `&rest' args, or `unevalled' for a special form.  */)
       funcar = XCAR (function);
       if (!SYMBOLP (funcar))
         xsignal1 (Qinvalid_function, original);
-      if (EQ (funcar, Qlambda)
-          || EQ (funcar, Qclosure))
+      if (EQ (funcar, Qlambda))
         result = lambda_arity (function);
       else if (EQ (funcar, Qautoload))
         {
@@ -3352,11 +3395,6 @@ lambda_arity (Lisp_Object fun)
 
   if (CONSP (fun))
     {
-      if (EQ (XCAR (fun), Qclosure))
-        {
-          fun = XCDR (fun);     /* Drop `closure'.  */
-          CHECK_CONS (fun);
-        }
       syms_left = XCDR (fun);
       if (CONSP (syms_left))
         syms_left = XCAR (syms_left);
@@ -4265,7 +4303,6 @@ before making `inhibit-quit' nil.  */);
   DEFSYM (Qcommandp, "commandp");
   DEFSYM (Qand_rest, "&rest");
   DEFSYM (Qand_optional, "&optional");
-  DEFSYM (Qclosure, "closure");
   DEFSYM (QCdocumentation, ":documentation");
   DEFSYM (Qdebug, "debug");
   DEFSYM (Qdebug_early, "debug-early");
@@ -4423,6 +4460,7 @@ alist of active lexical bindings.  */);
   defsubr (&Ssetq);
   defsubr (&Squote);
   defsubr (&Sfunction);
+  defsubr (&Smake_interpreted_closure);
   defsubr (&Sdefault_toplevel_value);
   defsubr (&Sset_default_toplevel_value);
   defsubr (&Sdefvar);