scratch/interpreted-function dad29e4f1c6: Fmake_byte_code: don't build interpreted functions

[Stefan Monnier]

branch: scratch/interpreted-function
commit dad29e4f1c60cacfc44c310420cd77a517f93e89
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    Fmake_byte_code: don't build interpreted functions
---
 src/alloc.c | 23 +++++++++--------------
 src/eval.c  | 29 +++++++++++++----------------
 2 files changed, 22 insertions(+), 30 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index b0e5d52cc32..a8dfde56739 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3813,22 +3813,17 @@ stack before executing the byte-code.
 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING 
INTERACTIVE-SPEC &rest ELEMENTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  if (CONSP (args[CLOSURE_CODE]))
-    ;                           /* An interpreted closure.  */
-  else if ((FIXNUMP (args[CLOSURE_ARGLIST])
-           || CONSP (args[CLOSURE_ARGLIST])
-           || NILP (args[CLOSURE_ARGLIST]))
-          && STRINGP (args[CLOSURE_CODE])
-          && !STRING_MULTIBYTE (args[CLOSURE_CODE])
-          && VECTORP (args[CLOSURE_CONSTANTS])
-          && FIXNATP (args[CLOSURE_STACK_DEPTH]))
-    {
-      /* Bytecode must be immovable.  */
-      pin_string (args[CLOSURE_CODE]);
-    }
-  else
+  if (! ((FIXNUMP (args[CLOSURE_ARGLIST])
+         || CONSP (args[CLOSURE_ARGLIST])
+         || NILP (args[CLOSURE_ARGLIST]))
+        && STRINGP (args[CLOSURE_CODE])
+        && !STRING_MULTIBYTE (args[CLOSURE_CODE])
+        && VECTORP (args[CLOSURE_CONSTANTS])
+        && FIXNATP (args[CLOSURE_STACK_DEPTH])))
     error ("Invalid byte-code object");
 
+  /* Bytecode must be immovable.  */
+  pin_string (args[CLOSURE_CODE]);
 
   /* 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/eval.c b/src/eval.c
index aa8ac4f10af..c1a936b5a29 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -521,22 +521,19 @@ IFORM if non-nil should be of the form (interactive ...). 
 */)
    Lisp_Object docstring, Lisp_Object iform)
 {
   CHECK_CONS (body);          /* Make sure it's not confused with byte-code! */
-  /* Despite its name 'Fmake_byte_code' works to build all kinds of 'closure'
-     objects, including interpreted functions, rather than only byte-code
-     functions.  */
-  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);
+  CHECK_LIST (args);
+  CHECK_LIST (iform);
+  Lisp_Object slots[] = { args,  body, env, Qnil, docstring,
+                         NILP (Fcdr (iform))
+                         ? Fcar (iform)
+                         : CALLN (Fvector, XCAR (iform), XCDR (iform)) };
+  /* 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,