7 files changed, 111 insertions, 85 deletions

diff --git a/src/alloc.c b/src/alloc.c
index faa14eebb36..b473ebd7ded 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3942,13 +3942,6 @@ make_user_ptr (void (*finalizer) (void *), void *p)
   uptr->p = p;
   return obj;
 }
-
-/* Create a new module function environment object.  */
-Lisp_Object
-make_module_function (void)
-{
-  return allocate_misc (Lisp_Misc_Module_Function);
-}
 #endif
 
 static void
@@ -6640,7 +6633,6 @@ mark_object (Lisp_Object arg)
 
 #ifdef HAVE_MODULES
         case Lisp_Misc_User_Ptr:
-        case Lisp_Misc_Module_Function:
           XMISCANY (obj)->gcmarkbit = true;
           break;
 #endif
diff --git a/src/data.c b/src/data.c
index 4242b90e628..25859105ee0 100644
--- a/src/data.c
+++ b/src/data.c
@@ -233,8 +233,6 @@ for example, (type-of 1) returns `integer'.  */)
         case Lisp_Misc_Finalizer:
           return Qfinalizer;
 #ifdef HAVE_MODULES
-        case Lisp_Misc_Module_Function:
-          return Qmodule_function;
         case Lisp_Misc_User_Ptr:
           return Quser_ptr;
 #endif
@@ -278,6 +276,8 @@ for example, (type-of 1) returns `integer'.  */)
             else
               return t;
           }
+        case PVEC_MODULE_FUNCTION:
+          return Qmodule_function;
         /* "Impossible" cases.  */
         case PVEC_XWIDGET:
         case PVEC_OTHER:
@@ -494,6 +494,14 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
   return Qnil;
 }
 
+DEFUN ("module-function-p", Fmodule_function_p, Smodule_function_p, 1, 1, NULL,
+       doc: /* Return t if OBJECT is a function loaded from a dynamic module.  */
+       attributes: const)
+  (Lisp_Object object)
+{
+  return MODULE_FUNCTIONP (object) ? Qt : Qnil;
+}
+
 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
        doc: /* Return t if OBJECT is a character or a string.  */
        attributes: const)
@@ -3793,6 +3801,7 @@ syms_of_data (void)
   defsubr (&Smarkerp);
   defsubr (&Ssubrp);
   defsubr (&Sbyte_code_function_p);
+  defsubr (&Smodule_function_p);
   defsubr (&Schar_or_string_p);
   defsubr (&Sthreadp);
   defsubr (&Smutexp);
diff --git a/src/doc.c b/src/doc.c
index dd674e3bc05..345e18b9186 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -340,6 +340,8 @@ string is passed through `substitute-command-keys'.  */)
     fun = XCDR (fun);
   if (SUBRP (fun))
     doc = make_number (XSUBR (fun)->doc);
+  else if (MODULE_FUNCTIONP (fun))
+    doc = XMODULE_FUNCTION (fun)->documentation;
   else if (COMPILEDP (fun))
     {
       if (PVSIZE (fun) <= COMPILED_DOC_STRING)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 0bc1b6c384b..99be4a748ee 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -362,30 +362,24 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
              : min_arity <= max_arity)))
     xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity));
 
-  Lisp_Object envobj = make_module_function ();
-  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
+  struct Lisp_Module_Function *envptr = allocate_module_function ();
   envptr->min_arity = min_arity;
   envptr->max_arity = max_arity;
   envptr->subr = subr;
   envptr->data = data;
 
-  Lisp_Object doc = Qnil;
   if (documentation)
     {
       AUTO_STRING (unibyte_doc, documentation);
-      doc = code_convert_string_norecord (unibyte_doc, Qutf_8, false);
+      envptr->documentation =
+        code_convert_string_norecord (unibyte_doc, Qutf_8, false);
     }
 
-  /* FIXME: Use a bytecompiled object, or even better a subr.  */
-  Lisp_Object ret = list4 (Qlambda,
-                           list2 (Qand_rest, Qargs),
-                           doc,
-                           list4 (Qapply,
-                                  list2 (Qfunction, Qinternal__module_call),
-                                  envobj,
-                                  Qargs));
+  Lisp_Object envobj;
+  XSET_MODULE_FUNCTION (envobj, envptr);
+  eassert (MODULE_FUNCTIONP (envobj));
 
-  return lisp_to_value (ret);
+  return lisp_to_value (envobj);
 }
 
 static emacs_value
@@ -648,17 +642,11 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
   return Qt;
 }
 
-DEFUN ("internal--module-call", Finternal_module_call, Sinternal_module_call, 1, MANY, 0,
-       doc: /* Internal function to call a module function.
-ENVOBJ is a save pointer to a module_fun_env structure.
-ARGLIST is a list of arguments passed to SUBRPTR.
-usage: (module-call ENVOBJ &rest ARGLIST)   */)
-  (ptrdiff_t nargs, Lisp_Object *arglist)
+Lisp_Object
+funcall_module (const struct Lisp_Module_Function *const envptr,
+                ptrdiff_t nargs, Lisp_Object *arglist)
 {
-  Lisp_Object envobj = arglist[0];
-  CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj);
-  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
-  EMACS_INT len = nargs - 1;
+  EMACS_INT len = nargs;
   eassume (0 <= envptr->min_arity);
   if (! (envptr->min_arity <= len
          && len <= (envptr->max_arity < 0 ? PTRDIFF_MAX : envptr->max_arity)))
@@ -672,12 +660,12 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
   USE_SAFE_ALLOCA;
   emacs_value *args;
   if (plain_values)
-    args = (emacs_value *) arglist + 1;
+    args = (emacs_value *) arglist;
   else
     {
       args = SAFE_ALLOCA (len * sizeof *args);
       for (ptrdiff_t i = 0; i < len; i++)
-        args[i] = lisp_to_value (arglist[i + 1]);
+        args[i] = lisp_to_value (arglist[i]);
     }
 
   emacs_value ret = envptr->subr (&pub, len, args, envptr->data);
@@ -709,6 +697,15 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
     }
 }
 
+Lisp_Object
+module_function_arity (const struct Lisp_Module_Function *const function)
+{
+  const short minargs = function->min_arity;
+  const short maxargs = function->max_arity;
+  return Fcons (make_number (minargs),
+                maxargs == MANY ? Qmany : make_number (maxargs));
+}
+
 
 /* Helper functions.  */
 
@@ -1025,7 +1022,4 @@ syms_of_module (void)
   DEFSYM (Qmodule_function_p, "module-function-p");
 
   defsubr (&Smodule_load);
-
-  DEFSYM (Qinternal__module_call, "internal--module-call");
-  defsubr (&Sinternal_module_call);
 }
diff --git a/src/eval.c b/src/eval.c
index 98d25cc4fed..f472efad52e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2261,7 +2261,7 @@ eval_sub (Lisp_Object form)
             }
         }
     }
-  else if (COMPILEDP (fun))
+  else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun))
     return apply_lambda (fun, original_args, count);
   else
     {
@@ -2687,7 +2687,7 @@ FUNCTIONP (Lisp_Object object)
 
   if (SUBRP (object))
     return XSUBR (object)->max_args != UNEVALLED;
-  else if (COMPILEDP (object))
+  else if (COMPILEDP (object) || MODULE_FUNCTIONP (object))
     return true;
   else if (CONSP (object))
     {
@@ -2742,7 +2742,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 
   if (SUBRP (fun))
     val = funcall_subr (XSUBR (fun), numargs, args + 1);
-  else if (COMPILEDP (fun))
+  else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun))
     val = funcall_lambda (fun, numargs, args + 1);
   else
     {
@@ -2892,7 +2892,8 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
 
 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
    and return the result of evaluation.
-   FUN must be either a lambda-expression or a compiled-code object.  */
+   FUN must be either a lambda-expression, a compiled-code object,
+   or a module function.  */
 
 static Lisp_Object
 funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
@@ -2949,6 +2950,10 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
         }
       lexenv = Qnil;
     }
+#ifdef HAVE_MODULES
+  else if (MODULE_FUNCTIONP (fun))
+    return funcall_module (XMODULE_FUNCTION (fun), nargs, arg_vector);
+#endif
   else
     emacs_abort ();
 
@@ -3060,6 +3065,10 @@ function with `&rest' args, or `unevalled' for a special form.  */)
     result = Fsubr_arity (function);
   else if (COMPILEDP (function))
     result = lambda_arity (function);
+#ifdef HAVE_MODULES
+  else if (MODULE_FUNCTIONP (function))
+    result = module_function_arity (XMODULE_FUNCTION (function));
+#endif
   else
     {
       if (NILP (function))
diff --git a/src/lisp.h b/src/lisp.h
index de3a548cb6c..ec8a8b1c098 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -464,7 +464,6 @@ enum Lisp_Misc_Type
     Lisp_Misc_Save_Value,
     Lisp_Misc_Finalizer,
 #ifdef HAVE_MODULES
-    Lisp_Misc_Module_Function,
     Lisp_Misc_User_Ptr,
 #endif
     /* Currently floats are not a misc type,
@@ -885,6 +884,7 @@ enum pvec_type
   PVEC_THREAD,
   PVEC_MUTEX,
   PVEC_CONDVAR,
+  PVEC_MODULE_FUNCTION,
 
   /* These should be last, check internal_equal to see why.  */
   PVEC_COMPILED,
@@ -2386,28 +2386,6 @@ struct Lisp_User_Ptr
   void (*finalizer) (void *);
   void *p;
 };
-
-#include "emacs-module.h"
-
-/* Function prototype for the module Lisp functions.  */
-typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
-                                   emacs_value [], void *);
-
-/* Function environments.  */
-
-/* A function environment is an auxiliary structure used by
-   `module_make_function' to store information about a module
-   function.  It is stored in a save pointer and retrieved by
-   `internal--module-call'.  Its members correspond to the arguments
-   given to `module_make_function'.  */
-
-struct Lisp_Module_Function
-{
-  struct Lisp_Misc_Any base;
-  ptrdiff_t min_arity, max_arity;
-  emacs_subr subr;
-  void *data;
-};
 #endif
 
 /* A finalizer sentinel.  */
@@ -2460,7 +2438,6 @@ union Lisp_Misc
     struct Lisp_Finalizer u_finalizer;
 #ifdef HAVE_MODULES
     struct Lisp_User_Ptr u_user_ptr;
-    struct Lisp_Module_Function u_module_function;
 #endif
   };
 
@@ -2509,19 +2486,6 @@ XUSER_PTR (Lisp_Object a)
   eassert (USER_PTRP (a));
   return XUNTAG (a, Lisp_Misc);
 }
-
-INLINE bool
-MODULE_FUNCTIONP (Lisp_Object o)
-{
-  return MISCP (o) && XMISCTYPE (o) == Lisp_Misc_Module_Function;
-}
-
-INLINE struct Lisp_Module_Function *
-XMODULE_FUNCTION (Lisp_Object o)
-{
-  eassert (MODULE_FUNCTIONP (o));
-  return XUNTAG (o, Lisp_Misc);
-}
 #endif
 
 
@@ -3923,12 +3887,66 @@ extern void get_backtrace (Lisp_Object array);
 Lisp_Object backtrace_top_function (void);
 extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
 
+#include "emacs-module.h"
+
+/* Function prototype for the module Lisp functions.  */
+typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
+                                   emacs_value [], void *);
+
+/* Function environments.  */
+
+/* A function environment is an auxiliary structure used by
+   `module_make_function' to store information about a module
+   function.  It is stored in a pseudovector.  Its members correspond
+   to the arguments given to `module_make_function'.  */
+
+struct Lisp_Module_Function
+{
+  struct vectorlike_header header;
+
+  /* Fields traced by GC; these must come first.  */
+  Lisp_Object documentation;
+
+  /* Fields ignored by GC.  */
+  ptrdiff_t min_arity, max_arity;
+  emacs_subr subr;
+  void *data;
+};
+
+INLINE struct Lisp_Module_Function *
+allocate_module_function (void)
+{
+  return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
+                                /* Name of the first field to be
+                                   ignored by GC.  */
+                                min_arity,
+                                PVEC_MODULE_FUNCTION);
+}
+
+INLINE bool
+MODULE_FUNCTIONP (Lisp_Object o)
+{
+  return PSEUDOVECTORP (o, PVEC_MODULE_FUNCTION);
+}
+
+INLINE struct Lisp_Module_Function *
+XMODULE_FUNCTION (Lisp_Object o)
+{
+  eassert (MODULE_FUNCTIONP (o));
+  return XUNTAG (o, Lisp_Vectorlike);
+}
+
+#define XSET_MODULE_FUNCTION(var, ptr)                  \
+  (XSETPSEUDOVECTOR (var, ptr, PVEC_MODULE_FUNCTION))
+
 #ifdef HAVE_MODULES
 /* Defined in alloc.c.  */
 extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
-extern Lisp_Object make_module_function (void);
 
 /* Defined in emacs-module.c.  */
+extern Lisp_Object funcall_module (const struct Lisp_Module_Function *,
+                                   ptrdiff_t, Lisp_Object *);
+extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
 extern Lisp_Object module_format_fun_env (const struct Lisp_Module_Function *);
 extern void syms_of_module (void);
 #endif
diff --git a/src/print.c b/src/print.c
index 7e411a80c88..be2e16a7499 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2051,6 +2051,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
         }
         break;
 
+#ifdef HAVE_MODULES
+      case PVEC_MODULE_FUNCTION:
+        print_string (module_format_fun_env (XMODULE_FUNCTION (obj)),
+                      printcharfun);
+        break;
+#endif
+
         case PVEC_OTHER:
         case PVEC_FREE:
           emacs_abort ();
@@ -2103,11 +2110,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
             printchar ('>', printcharfun);
             break;
           }
-
-        case Lisp_Misc_Module_Function:
-          print_string (module_format_fun_env (XMODULE_FUNCTION (obj)),
-                        printcharfun);
-          break;
 #endif
 
         case Lisp_Misc_Finalizer: