Re: Unify make-closure, make-interpreted-closure, and make-byte-code

[Thuna <thuna.cing@gmail.com>]

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

This makes a test in comp.el fail (I don't really understand why or how)
but here's a possible way this could be implemented (which should also
give a better insight into the sort of thing that I am thinking of):


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Unify-closure-allocators.patch --]
[-- Type: text/x-patch, Size: 9185 bytes --]

From 54e0af41949694191b5ef6c3a1f04efe206dc433 Mon Sep 17 00:00:00 2001
From: Thuna <thuna.cing@gmail.com>
Date: Sun, 17 Nov 2024 18:28:38 +0100
Subject: [PATCH] Unify closure allocators

---
 lisp/emacs-lisp/bytecomp.el |   2 +-
 lisp/emacs-lisp/oclosure.el |   2 +-
 src/alloc.c                 | 115 +++++++++++++++++++++++++++++++++++-
 src/data.c                  |   1 +
 src/eval.c                  |  36 -----------
 5 files changed, 117 insertions(+), 39 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f058fc48cc7..187955f92db 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4202,7 +4202,7 @@ byte-compile-make-closure
                                                ; have been stripped in
                                                ; `byte-compile-lambda'.
                             opt-args))))
-             `(make-closure ,proto-fun ,@env))
+             `(copy-closure ,proto-fun ,@env))
          ;; Nontrivial doc string expression: create a bytecode object
          ;; from small pieces at run time.
          `(make-byte-code
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 165d7c4b6e8..4c6b848227e 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -441,7 +441,7 @@ oclosure--fix-type
 (defun oclosure--copy (oclosure mutlist &rest args)
   (cl-assert (closurep oclosure))
   (if (byte-code-function-p oclosure)
-      (apply #'make-closure oclosure
+      (apply #'copy-closure oclosure
              (if (null mutlist)
                  args
                (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
diff --git a/src/alloc.c b/src/alloc.c
index 4fab0d54248..2ab2d96af40 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3848,7 +3848,116 @@ and (optional) INTERACTIVE-SPEC.
   return val;
 }
 
-DEFUN ("make-closure", Fmake_closure, Smake_closure, 1, MANY, 0,
+Lisp_Object
+make_closure (Lisp_Object argdesc, Lisp_Object code, Lisp_Object env,
+	      Lisp_Object depth, Lisp_Object docstring, Lisp_Object iform)
+{
+  ptrdiff_t nargs;
+  Lisp_Object value, slots[6];
+
+  slots[CLOSURE_ARGLIST] = argdesc;
+  slots[CLOSURE_CODE] = code;
+  slots[CLOSURE_CONSTANTS] = env;
+  slots[CLOSURE_STACK_DEPTH] = depth;
+  slots[CLOSURE_DOC_STRING] = docstring;
+  slots[CLOSURE_INTERACTIVE] = iform;
+
+  nargs = !NILP (iform) ? 6
+	: !NILP (docstring) ? 5
+        : !NILP (depth) ? 4
+	: 3;
+  value = Fvector (nargs, slots);
+  XSETPVECTYPE (XVECTOR (value), PVEC_CLOSURE);
+  return value;
+}
+
+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_LIST (args);
+  CHECK_CONS (body);
+  CHECK_LIST (iform);
+
+  Lisp_Object ifcdr = CDR (iform);
+  if (NILP (CDR (ifcdr)))
+    iform = CAR (ifcdr);
+  else
+    iform = CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr));
+
+  return make_closure (args, body, env, Qnil, docstring, iform);
+}
+
+DEFUN ("make-compiled-closure", Fmake_compiled_closure,
+       Smake_compiled_closure, 4, 6, 0,
+       doc: /* Create and return a byte-compiled closure.
+
+See `make-closure' for the meaning of the arguments. */)
+  (Lisp_Object argdesc, Lisp_Object bytecode, Lisp_Object constants,
+   Lisp_Object depth, Lisp_Object docstring, Lisp_Object iform)
+{
+  CHECK_TYPE (NILP (argdesc) || CONSP (argdesc) || FIXNUMP (argdesc),
+	      list3 (Qor, Qlistp, Qfixnump),
+	      argdesc);
+  CHECK_STRING (bytecode);
+  if (STRING_MULTIBYTE (bytecode))
+    error ("Multibyte byte-code");
+  CHECK_VECTOR (constants);
+  CHECK_FIXNAT (depth);
+
+  /* Bytecode must be immovable.  */
+  pin_string (bytecode);
+
+  return make_closure (argdesc, bytecode, constants, depth, docstring, iform);
+}
+
+DEFUN ("make-closure", Fmake_closure, Smake_closure, 2, 6, 0,
+       doc: /* Create and return a closure object.
+
+ARGDESC is either be a lambda list that is recognized by `lambda', or a
+fixnum of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
+minimum number of arguments, the 7-bit NNNNNNN specifies the maximum
+number of arguments (ignoring &rest) and the R bit specifies whether
+there is a &rest argument to catch the left-over arguments.  ARGDESC can
+only be an integer for byte compiled closures.
+
+For interpreted closures, CODE is a non-empty list of elisp forms which
+make up the closure's body.  For byte compiled closures, CODE is a
+unibyte string containing the byte code instructions.
+
+For byte compiled closures, ENV holds the vector of elisp objects
+referenced by the byte code.  For interpreted closures, if the closure
+uses dynamic scoping, ENV is nil, otherwise it is the lexical
+environment, like the second argument of `eval'.
+
+For byte compiled closures, DEPTH is the maximum stack size needed.
+DEPTH should be nil for interpreted closures.
+
+DOCSTRING, if non-nil, should be a string containing the documentation,
+or a number or a list, in case the documentation is stored in a file.
+
+IFORM, if non-nil, should be a string or an elisp form.  If nil,
+the closure is non-interactive. */)
+  (Lisp_Object argdesc, Lisp_Object code, Lisp_Object env,
+   Lisp_Object depth, Lisp_Object docstring, Lisp_Object iform)
+{
+  if (CONSP (code))
+    return Fmake_interpreted_closure
+	     (argdesc, code, env, docstring,
+	      NILP (iform) ? Qnil : list2 (Qinteractive, iform));
+  else if (STRINGP (code))
+    return Fmake_compiled_closure (argdesc, code, env, depth, docstring, iform);
+  else
+    wrong_type_argument (list3 (Qor, Qconsp, Qstringp), code);
+}
+
+DEFUN ("copy-closure", Fcopy_closure, Scopy_closure, 1, MANY, 0,
        doc: /* Create a byte-code closure from PROTOTYPE and CLOSURE-VARS.
 Return a copy of PROTOTYPE, a byte-code object, with CLOSURE-VARS
 replacing the elements in the beginning of the constant-vector.
@@ -8232,6 +8341,7 @@ syms_of_alloc (void)
   DEFSYM (Qvector_slots, "vector-slots");
   DEFSYM (Qheap, "heap");
   DEFSYM (QAutomatic_GC, "Automatic GC");
+  DEFSYM (Qvalid_docstring_p, "valid-docstring-p");
 
   DEFSYM (Qgc_cons_percentage, "gc-cons-percentage");
   DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
@@ -8254,7 +8364,10 @@ syms_of_alloc (void)
   defsubr (&Srecord);
   defsubr (&Sbool_vector);
   defsubr (&Smake_byte_code);
+  defsubr (&Smake_interpreted_closure);
+  defsubr (&Smake_compiled_closure);
   defsubr (&Smake_closure);
+  defsubr (&Scopy_closure);
   defsubr (&Smake_list);
   defsubr (&Smake_vector);
   defsubr (&Smake_record);
diff --git a/src/data.c b/src/data.c
index 66cf34c1e60..83ecd040dca 100644
--- a/src/data.c
+++ b/src/data.c
@@ -4067,6 +4067,7 @@ syms_of_data (void)
   DEFSYM (Qoclosure_interactive_form, "oclosure-interactive-form");
 
   DEFSYM (Qsubrp, "subrp");
+  DEFSYM (Qclosurep, "closurep");
   DEFSYM (Qunevalled, "unevalled");
   DEFSYM (Qmany, "many");
 
diff --git a/src/eval.c b/src/eval.c
index d0a2abf0089..836930259b0 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -517,41 +517,6 @@ 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.
-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)
-{
-  Lisp_Object ifcdr, value, slots[6];
-
-  CHECK_CONS (body);          /* Make sure it's not confused with byte-code! */
-  CHECK_LIST (args);
-  CHECK_LIST (iform);
-  ifcdr = CDR (iform);
-  if (NILP (CDR (ifcdr)))
-    value = CAR (ifcdr);
-  else
-    value = CALLN (Fvector, XCAR (ifcdr), XCDR (ifcdr));
-  slots[0] = args;
-  slots[1] = body;
-  slots[2] = env;
-  slots[3] = Qnil;
-  slots[4] = docstring;
-  slots[5] = value;
-  /* 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
@@ -4491,7 +4456,6 @@ 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);
-- 
2.44.2