[PATCH] Introduce new misc type for module function

[PATCH] Introduce new misc type for module function

[Philipp Stephani]

This resolves a couple of FIXMEs in emacs-module.c.

* lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions.

* alloc.c (make_module_function): New function.
(mark_object): GC support.

* print.c (print_object): Print support for new type.

* emacs-module.c (module_make_function, Finternal_module_call):
Use new module function type, remove FIXMEs.
(module_format_fun_env): Adapt and give it external linkage.
---
 src/alloc.c        |  7 +++++++
 src/emacs-module.c | 48 +++++++++---------------------------------------
 src/lisp.h         | 39 +++++++++++++++++++++++++++++++++++++++
 src/print.c        |  5 +++++
 4 files changed, 60 insertions(+), 39 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 88a1a1ed66..9be570fe59 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3937,6 +3937,12 @@ make_user_ptr (void (*finalizer) (void *), void *p)
   return obj;
 }
 
+/* Create a new module function environment object.  */
+Lisp_Object
+make_module_function ()
+{
+  return allocate_misc (Lisp_Misc_Module_Function);
+}
 #endif
 
 static void
@@ -6628,6 +6634,7 @@ 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/emacs-module.c b/src/emacs-module.c
index 1b445dcc3b..cd025a1396 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -62,10 +62,6 @@ enum
 /* Function prototype for the module init function.  */
 typedef int (*emacs_init_function) (struct emacs_runtime *);
 
-/* Function prototype for the module Lisp functions.  */
-typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
-				   emacs_value [], void *);
-
 /* Function prototype for module user-pointer finalizers.  These
    should not throw C++ exceptions, so emacs-module.h declares the
    corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
@@ -102,7 +98,6 @@ struct emacs_runtime_private
 
 struct module_fun_env;
 
-static Lisp_Object module_format_fun_env (const struct module_fun_env *);
 static Lisp_Object value_to_lisp (emacs_value);
 static emacs_value lisp_to_value (Lisp_Object);
 static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
@@ -184,22 +179,6 @@ static emacs_value const module_nil = 0;
   do { } while (false)
 
 \f
-/* 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 module_fun_env
-{
-  ptrdiff_t min_arity, max_arity;
-  emacs_subr subr;
-  void *data;
-};
-
-\f
 /* Implementation of runtime and environment functions.
 
    These should abide by the following rules:
@@ -382,14 +361,13 @@ 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));
 
-  /* FIXME: This should be freed when envobj is GC'd.  */
-  struct module_fun_env *envptr = xmalloc (sizeof *envptr);
+  Lisp_Object envobj = make_module_function ();
+  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
   envptr->min_arity = min_arity;
   envptr->max_arity = max_arity;
   envptr->subr = subr;
   envptr->data = data;
 
-  Lisp_Object envobj = make_save_ptr (envptr);
   Lisp_Object doc = Qnil;
   if (documentation)
     {
@@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
   (ptrdiff_t nargs, Lisp_Object *arglist)
 {
   Lisp_Object envobj = arglist[0];
-  /* FIXME: Rather than use a save_value, we should create a new object type.
-     Making save_value visible to Lisp is wrong.  */
-  CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj);
-  struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj);
-  CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj);
-  /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0)
-     is a module_fun_env pointer.  If some other part of Emacs also
-     exports save_value objects to Elisp, than we may be getting here this
-     other kind of save_value which will likely hold something completely
-     different in this field.  */
-  struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0);
+  CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj);
+  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
   EMACS_INT len = nargs - 1;
   eassume (0 <= envptr->min_arity);
   if (! (envptr->min_arity <= len
@@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
 
 /* Return a string object that contains a user-friendly
    representation of the function environment.  */
-static Lisp_Object
-module_format_fun_env (const struct module_fun_env *env)
+Lisp_Object
+module_format_fun_env (const struct Lisp_Module_Function *env)
 {
   /* Try to print a function name if possible.  */
+  /* FIXME: Move this function into print.c, then use prin1-to-string
+     above.  */
   const char *path, *sym;
   static char const noaddr_format[] = "#<module function at %p>";
   char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256];
@@ -1048,8 +1019,7 @@ syms_of_module (void)
      code or modules should not access it.  */
   Funintern (Qmodule_refs_hash, Qnil);
 
-  DEFSYM (Qsave_value_p, "save-value-p");
-  DEFSYM (Qsave_pointer_p, "save-pointer-p");
+  DEFSYM (Qmodule_function_p, "module-function-p");
 
   defsubr (&Smodule_load);
 
diff --git a/src/lisp.h b/src/lisp.h
index daf57ed906..5d4c64a2e5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -464,6 +464,7 @@ 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,
@@ -2385,6 +2386,28 @@ 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.  */
@@ -2437,6 +2460,7 @@ 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
   };
 
@@ -2485,6 +2509,19 @@ 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
 
 \f
@@ -3889,8 +3926,10 @@ extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
 #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 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 872103bd4c..7e411a80c8 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2103,6 +2103,11 @@ 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:
-- 
2.12.2

Re: [PATCH] Introduce new misc type for module function

[Aurélien Aptel]

Hi Philipp,

Nice to see you work on modules :)

* Shouldn't we try to map module function to subr instead of adding
another type?
* Should we get rid of make_global_ref? It serves no purpose anymore
IIUC since you can't reuse emacs_values between module function calls.

Re: [PATCH] Introduce new misc type for module function

[Philipp Stephani]

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

Aurélien Aptel <aurelien.aptel+emacs@gmail.com> schrieb am So., 23. Apr.
2017 um 17:19 Uhr:

> Hi Philipp,
>
> Nice to see you work on modules :)
>
> * Shouldn't we try to map module function to subr instead of adding
> another type?
>

Eventually yes, but I'd prefer to do that later and introduce the misc
subtype now to get rid of the most pressing problems associated with using
the save pointer (probably wrong type, no garbage collection). Turning
module functions into proper subrs is a bit more involved since all pieces
of code that touch subrs need to be adapted.


> * Should we get rid of make_global_ref? It serves no purpose anymore
> IIUC since you can't reuse emacs_values between module function calls.
>

My understanding is that the emacs_value objects returned from
make_global_ref should be usable across environments and threads; at least
that's my understanding of both the desired and the implemented behavior.

[-- Attachment #2: Type: text/html, Size: 1409 bytes --]

Re: [PATCH] Introduce new misc type for module function

[Eli Zaretskii]

> From: Philipp Stephani <p.stephani2@gmail.com>
> Date: Sat, 22 Apr 2017 18:05:53 +0200
> Cc: Philipp Stephani <phst@google.com>
> 
> This resolves a couple of FIXMEs in emacs-module.c.

Thanks.  Can we have a couple of tests for the new functionality?

Re: [PATCH] Introduce new misc type for module function

[Philipp Stephani]

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

Eli Zaretskii <eliz@gnu.org> schrieb am Fr., 28. Apr. 2017 um 11:30 Uhr:

> > From: Philipp Stephani <p.stephani2@gmail.com>
> > Date: Sat, 22 Apr 2017 18:05:53 +0200
> > Cc: Philipp Stephani <phst@google.com>
> >
> > This resolves a couple of FIXMEs in emacs-module.c.
>
> Thanks.  Can we have a couple of tests for the new functionality?
>

There is no new functionality. It's just refactoring, and the new misc type
isn't visible from Lisp.

[-- Attachment #2: Type: text/html, Size: 875 bytes --]

Re: [PATCH] Introduce new misc type for module function

[Eli Zaretskii]

> From: Philipp Stephani <p.stephani2@gmail.com>
> Date: Sat, 29 Apr 2017 12:43:14 +0000
> Cc: emacs-devel@gnu.org, phst@google.com
> 
>  Thanks. Can we have a couple of tests for the new functionality?
> 
> There is no new functionality. It's just refactoring, and the new misc type isn't visible from Lisp.

I see module-function-p and the support for printing that.

[PATCH] Introduce new misc type for module function

[Philipp Stephani]

This resolves a couple of FIXMEs in emacs-module.c.

* src/lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions.

* src/alloc.c (make_module_function): New function.
(mark_object): GC support.

* src/data.c (Ftype_of, syms_of_data): Handle module function type.

* src/print.c (print_object): Print support for new type.

* src/emacs-module.c (module_make_function, Finternal_module_call):
Use new module function type, remove FIXMEs.
(module_format_fun_env): Adapt and give it external linkage.

* test/src/emacs-module-tests.el (module-function-object): Add unit
test.
---
 src/alloc.c                    |  7 ++++++
 src/data.c                     |  3 +++
 src/emacs-module.c             | 48 ++++++++----------------------------------
 src/lisp.h                     | 39 ++++++++++++++++++++++++++++++++++
 src/print.c                    |  5 +++++
 test/src/emacs-module-tests.el | 22 +++++++++++++++++++
 6 files changed, 85 insertions(+), 39 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 88a1a1ed66..9be570fe59 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3937,6 +3937,12 @@ make_user_ptr (void (*finalizer) (void *), void *p)
   return obj;
 }
 
+/* Create a new module function environment object.  */
+Lisp_Object
+make_module_function ()
+{
+  return allocate_misc (Lisp_Misc_Module_Function);
+}
 #endif
 
 static void
@@ -6628,6 +6634,7 @@ 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 141b26ccf3..44f7ba0e88 100644
--- a/src/data.c
+++ b/src/data.c
@@ -233,6 +233,8 @@ 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
@@ -3729,6 +3731,7 @@ syms_of_data (void)
   DEFSYM (Qoverlay, "overlay");
   DEFSYM (Qfinalizer, "finalizer");
 #ifdef HAVE_MODULES
+  DEFSYM (Qmodule_function, "module-function");
   DEFSYM (Quser_ptr, "user-ptr");
 #endif
   DEFSYM (Qfloat, "float");
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 1b445dcc3b..cd025a1396 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -62,10 +62,6 @@ enum
 /* Function prototype for the module init function.  */
 typedef int (*emacs_init_function) (struct emacs_runtime *);
 
-/* Function prototype for the module Lisp functions.  */
-typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
-				   emacs_value [], void *);
-
 /* Function prototype for module user-pointer finalizers.  These
    should not throw C++ exceptions, so emacs-module.h declares the
    corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
@@ -102,7 +98,6 @@ struct emacs_runtime_private
 
 struct module_fun_env;
 
-static Lisp_Object module_format_fun_env (const struct module_fun_env *);
 static Lisp_Object value_to_lisp (emacs_value);
 static emacs_value lisp_to_value (Lisp_Object);
 static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
@@ -184,22 +179,6 @@ static emacs_value const module_nil = 0;
   do { } while (false)
 
 \f
-/* 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 module_fun_env
-{
-  ptrdiff_t min_arity, max_arity;
-  emacs_subr subr;
-  void *data;
-};
-
-\f
 /* Implementation of runtime and environment functions.
 
    These should abide by the following rules:
@@ -382,14 +361,13 @@ 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));
 
-  /* FIXME: This should be freed when envobj is GC'd.  */
-  struct module_fun_env *envptr = xmalloc (sizeof *envptr);
+  Lisp_Object envobj = make_module_function ();
+  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
   envptr->min_arity = min_arity;
   envptr->max_arity = max_arity;
   envptr->subr = subr;
   envptr->data = data;
 
-  Lisp_Object envobj = make_save_ptr (envptr);
   Lisp_Object doc = Qnil;
   if (documentation)
     {
@@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
   (ptrdiff_t nargs, Lisp_Object *arglist)
 {
   Lisp_Object envobj = arglist[0];
-  /* FIXME: Rather than use a save_value, we should create a new object type.
-     Making save_value visible to Lisp is wrong.  */
-  CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj);
-  struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj);
-  CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj);
-  /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0)
-     is a module_fun_env pointer.  If some other part of Emacs also
-     exports save_value objects to Elisp, than we may be getting here this
-     other kind of save_value which will likely hold something completely
-     different in this field.  */
-  struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0);
+  CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj);
+  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
   EMACS_INT len = nargs - 1;
   eassume (0 <= envptr->min_arity);
   if (! (envptr->min_arity <= len
@@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
 
 /* Return a string object that contains a user-friendly
    representation of the function environment.  */
-static Lisp_Object
-module_format_fun_env (const struct module_fun_env *env)
+Lisp_Object
+module_format_fun_env (const struct Lisp_Module_Function *env)
 {
   /* Try to print a function name if possible.  */
+  /* FIXME: Move this function into print.c, then use prin1-to-string
+     above.  */
   const char *path, *sym;
   static char const noaddr_format[] = "#<module function at %p>";
   char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256];
@@ -1048,8 +1019,7 @@ syms_of_module (void)
      code or modules should not access it.  */
   Funintern (Qmodule_refs_hash, Qnil);
 
-  DEFSYM (Qsave_value_p, "save-value-p");
-  DEFSYM (Qsave_pointer_p, "save-pointer-p");
+  DEFSYM (Qmodule_function_p, "module-function-p");
 
   defsubr (&Smodule_load);
 
diff --git a/src/lisp.h b/src/lisp.h
index daf57ed906..5d4c64a2e5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -464,6 +464,7 @@ 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,
@@ -2385,6 +2386,28 @@ 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.  */
@@ -2437,6 +2460,7 @@ 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
   };
 
@@ -2485,6 +2509,19 @@ 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
 
 \f
@@ -3889,8 +3926,10 @@ extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
 #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 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 872103bd4c..7e411a80c8 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2103,6 +2103,11 @@ 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:
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 93e85ae22d..958b2c003b 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -59,6 +59,28 @@
 (ert-deftest mod-test-sum-docstring ()
   (should (string= (documentation 'mod-test-sum) "Return A + B")))
 
+(ert-deftest module-function-object ()
+  "Extract and test the implementation of a module function.
+This test needs to be changed whenever the implementation
+changes."
+  (let ((func (symbol-function #'mod-test-sum)))
+    (should (consp func))
+    (should (equal (length func) 4))
+    (should (equal (nth 0 func) 'lambda))
+    (should (equal (nth 1 func) '(&rest args)))
+    (should (equal (nth 2 func) "Return A + B"))
+    (let ((body (nth 3 func)))
+      (should (consp body))
+      (should (equal (nth 0 body) #'apply))
+      (should (equal (nth 1 body) '#'internal--module-call))
+      (should (equal (nth 3 body) 'args))
+      (let ((obj (nth 2 body)))
+        (should (equal (type-of obj) 'module-function))
+        (should (string-match-p
+                 (rx "#<module function Fmod_test_sum from /" (+ nonl)
+                     "/mod-test.so>")
+                 (prin1-to-string obj)))))))
+
 ;;
 ;; Non-local exists (throw, signal).
 ;;
-- 
2.12.2

Re: [PATCH] Introduce new misc type for module function

[Eli Zaretskii]

> From: Philipp Stephani <p.stephani2@gmail.com>
> Cc: Philipp Stephani <phst@google.com>
> Date: Sat, 29 Apr 2017 16:44:22 +0200
> 
> +        (should (string-match-p
> +                 (rx "#<module function Fmod_test_sum from /" (+ nonl)
> +                     "/mod-test.so>")
> +                 (prin1-to-string obj)))))))

The ".so" part should actually use module-file-suffix, or it will fail
on non-Unix systems.

Thanks.

[PATCH] Introduce new misc type for module function

[Philipp Stephani]

This resolves a couple of FIXMEs in emacs-module.c.

* src/lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions.

* src/alloc.c (make_module_function): New function.
(mark_object): GC support.

* src/data.c (Ftype_of, syms_of_data): Handle module function type.

* src/print.c (print_object): Print support for new type.

* src/emacs-module.c (module_make_function, Finternal_module_call):
Use new module function type, remove FIXMEs.
(module_format_fun_env): Adapt and give it external linkage.

* test/src/emacs-module-tests.el (module-function-object): Add unit
test.
---
 src/alloc.c                    |  7 ++++++
 src/data.c                     |  3 +++
 src/emacs-module.c             | 48 ++++++++----------------------------------
 src/lisp.h                     | 39 ++++++++++++++++++++++++++++++++++
 src/print.c                    |  5 +++++
 test/src/emacs-module-tests.el | 23 ++++++++++++++++++++
 6 files changed, 86 insertions(+), 39 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 88a1a1ed66..9be570fe59 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3937,6 +3937,12 @@ make_user_ptr (void (*finalizer) (void *), void *p)
   return obj;
 }
 
+/* Create a new module function environment object.  */
+Lisp_Object
+make_module_function ()
+{
+  return allocate_misc (Lisp_Misc_Module_Function);
+}
 #endif
 
 static void
@@ -6628,6 +6634,7 @@ 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 141b26ccf3..44f7ba0e88 100644
--- a/src/data.c
+++ b/src/data.c
@@ -233,6 +233,8 @@ 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
@@ -3729,6 +3731,7 @@ syms_of_data (void)
   DEFSYM (Qoverlay, "overlay");
   DEFSYM (Qfinalizer, "finalizer");
 #ifdef HAVE_MODULES
+  DEFSYM (Qmodule_function, "module-function");
   DEFSYM (Quser_ptr, "user-ptr");
 #endif
   DEFSYM (Qfloat, "float");
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 1b445dcc3b..cd025a1396 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -62,10 +62,6 @@ enum
 /* Function prototype for the module init function.  */
 typedef int (*emacs_init_function) (struct emacs_runtime *);
 
-/* Function prototype for the module Lisp functions.  */
-typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
-				   emacs_value [], void *);
-
 /* Function prototype for module user-pointer finalizers.  These
    should not throw C++ exceptions, so emacs-module.h declares the
    corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
@@ -102,7 +98,6 @@ struct emacs_runtime_private
 
 struct module_fun_env;
 
-static Lisp_Object module_format_fun_env (const struct module_fun_env *);
 static Lisp_Object value_to_lisp (emacs_value);
 static emacs_value lisp_to_value (Lisp_Object);
 static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
@@ -184,22 +179,6 @@ static emacs_value const module_nil = 0;
   do { } while (false)
 
 \f
-/* 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 module_fun_env
-{
-  ptrdiff_t min_arity, max_arity;
-  emacs_subr subr;
-  void *data;
-};
-
-\f
 /* Implementation of runtime and environment functions.
 
    These should abide by the following rules:
@@ -382,14 +361,13 @@ 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));
 
-  /* FIXME: This should be freed when envobj is GC'd.  */
-  struct module_fun_env *envptr = xmalloc (sizeof *envptr);
+  Lisp_Object envobj = make_module_function ();
+  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
   envptr->min_arity = min_arity;
   envptr->max_arity = max_arity;
   envptr->subr = subr;
   envptr->data = data;
 
-  Lisp_Object envobj = make_save_ptr (envptr);
   Lisp_Object doc = Qnil;
   if (documentation)
     {
@@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
   (ptrdiff_t nargs, Lisp_Object *arglist)
 {
   Lisp_Object envobj = arglist[0];
-  /* FIXME: Rather than use a save_value, we should create a new object type.
-     Making save_value visible to Lisp is wrong.  */
-  CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj);
-  struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj);
-  CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj);
-  /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0)
-     is a module_fun_env pointer.  If some other part of Emacs also
-     exports save_value objects to Elisp, than we may be getting here this
-     other kind of save_value which will likely hold something completely
-     different in this field.  */
-  struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0);
+  CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj);
+  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
   EMACS_INT len = nargs - 1;
   eassume (0 <= envptr->min_arity);
   if (! (envptr->min_arity <= len
@@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
 
 /* Return a string object that contains a user-friendly
    representation of the function environment.  */
-static Lisp_Object
-module_format_fun_env (const struct module_fun_env *env)
+Lisp_Object
+module_format_fun_env (const struct Lisp_Module_Function *env)
 {
   /* Try to print a function name if possible.  */
+  /* FIXME: Move this function into print.c, then use prin1-to-string
+     above.  */
   const char *path, *sym;
   static char const noaddr_format[] = "#<module function at %p>";
   char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256];
@@ -1048,8 +1019,7 @@ syms_of_module (void)
      code or modules should not access it.  */
   Funintern (Qmodule_refs_hash, Qnil);
 
-  DEFSYM (Qsave_value_p, "save-value-p");
-  DEFSYM (Qsave_pointer_p, "save-pointer-p");
+  DEFSYM (Qmodule_function_p, "module-function-p");
 
   defsubr (&Smodule_load);
 
diff --git a/src/lisp.h b/src/lisp.h
index daf57ed906..5d4c64a2e5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -464,6 +464,7 @@ 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,
@@ -2385,6 +2386,28 @@ 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.  */
@@ -2437,6 +2460,7 @@ 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
   };
 
@@ -2485,6 +2509,19 @@ 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
 
 \f
@@ -3889,8 +3926,10 @@ extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
 #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 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 872103bd4c..7e411a80c8 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2103,6 +2103,11 @@ 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:
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 93e85ae22d..7859fc5dce 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -59,6 +59,29 @@
 (ert-deftest mod-test-sum-docstring ()
   (should (string= (documentation 'mod-test-sum) "Return A + B")))
 
+(ert-deftest module-function-object ()
+  "Extract and test the implementation of a module function.
+This test needs to be changed whenever the implementation
+changes."
+  (let ((func (symbol-function #'mod-test-sum)))
+    (should (consp func))
+    (should (equal (length func) 4))
+    (should (equal (nth 0 func) 'lambda))
+    (should (equal (nth 1 func) '(&rest args)))
+    (should (equal (nth 2 func) "Return A + B"))
+    (let ((body (nth 3 func)))
+      (should (consp body))
+      (should (equal (length body) 4))
+      (should (equal (nth 0 body) #'apply))
+      (should (equal (nth 1 body) '#'internal--module-call))
+      (should (equal (nth 3 body) 'args))
+      (let ((obj (nth 2 body)))
+        (should (equal (type-of obj) 'module-function))
+        (should (string-match-p
+                 (rx "#<module function Fmod_test_sum from "
+                     (* nonl) "mod-test" (* nonl) ">")
+                 (prin1-to-string obj)))))))
+
 ;;
 ;; Non-local exists (throw, signal).
 ;;
-- 
2.12.2

Re: [PATCH] Introduce new misc type for module function

[Philipp]

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

Philipp Stephani <p.stephani2@gmail.com> schrieb am Sa., 29. Apr. 2017 um
19:27 Uhr:

> This resolves a couple of FIXMEs in emacs-module.c.
>
> * src/lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions.
>
> * src/alloc.c (make_module_function): New function.
> (mark_object): GC support.
>
> * src/data.c (Ftype_of, syms_of_data): Handle module function type.
>
> * src/print.c (print_object): Print support for new type.
>
> * src/emacs-module.c (module_make_function, Finternal_module_call):
> Use new module function type, remove FIXMEs.
> (module_format_fun_env): Adapt and give it external linkage.
>
> * test/src/emacs-module-tests.el (module-function-object): Add unit
> test.
> ---
>  src/alloc.c                    |  7 ++++++
>  src/data.c                     |  3 +++
>  src/emacs-module.c             | 48
> ++++++++----------------------------------
>  src/lisp.h                     | 39 ++++++++++++++++++++++++++++++++++
>  src/print.c                    |  5 +++++
>  test/src/emacs-module-tests.el | 23 ++++++++++++++++++++
>  6 files changed, 86 insertions(+), 39 deletions(-)
>
> diff --git a/src/alloc.c b/src/alloc.c
> index 88a1a1ed66..9be570fe59 100644
> --- a/src/alloc.c
> +++ b/src/alloc.c
> @@ -3937,6 +3937,12 @@ make_user_ptr (void (*finalizer) (void *), void *p)
>    return obj;
>  }
>
> +/* Create a new module function environment object.  */
> +Lisp_Object
> +make_module_function ()
> +{
> +  return allocate_misc (Lisp_Misc_Module_Function);
> +}
>  #endif
>
>  static void
> @@ -6628,6 +6634,7 @@ 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 141b26ccf3..44f7ba0e88 100644
> --- a/src/data.c
> +++ b/src/data.c
> @@ -233,6 +233,8 @@ 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
> @@ -3729,6 +3731,7 @@ syms_of_data (void)
>    DEFSYM (Qoverlay, "overlay");
>    DEFSYM (Qfinalizer, "finalizer");
>  #ifdef HAVE_MODULES
> +  DEFSYM (Qmodule_function, "module-function");
>    DEFSYM (Quser_ptr, "user-ptr");
>  #endif
>    DEFSYM (Qfloat, "float");
> diff --git a/src/emacs-module.c b/src/emacs-module.c
> index 1b445dcc3b..cd025a1396 100644
> --- a/src/emacs-module.c
> +++ b/src/emacs-module.c
> @@ -62,10 +62,6 @@ enum
>  /* Function prototype for the module init function.  */
>  typedef int (*emacs_init_function) (struct emacs_runtime *);
>
> -/* Function prototype for the module Lisp functions.  */
> -typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
> -                                  emacs_value [], void *);
> -
>  /* Function prototype for module user-pointer finalizers.  These
>     should not throw C++ exceptions, so emacs-module.h declares the
>     corresponding interfaces with EMACS_NOEXCEPT.  There is only C code
> @@ -102,7 +98,6 @@ struct emacs_runtime_private
>
>  struct module_fun_env;
>
> -static Lisp_Object module_format_fun_env (const struct module_fun_env *);
>  static Lisp_Object value_to_lisp (emacs_value);
>  static emacs_value lisp_to_value (Lisp_Object);
>  static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
> @@ -184,22 +179,6 @@ static emacs_value const module_nil = 0;
>    do { } while (false)
>
>
> -/* 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 module_fun_env
> -{
> -  ptrdiff_t min_arity, max_arity;
> -  emacs_subr subr;
> -  void *data;
> -};
> -
> -
>  /* Implementation of runtime and environment functions.
>
>     These should abide by the following rules:
> @@ -382,14 +361,13 @@ 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));
>
> -  /* FIXME: This should be freed when envobj is GC'd.  */
> -  struct module_fun_env *envptr = xmalloc (sizeof *envptr);
> +  Lisp_Object envobj = make_module_function ();
> +  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
>    envptr->min_arity = min_arity;
>    envptr->max_arity = max_arity;
>    envptr->subr = subr;
>    envptr->data = data;
>
> -  Lisp_Object envobj = make_save_ptr (envptr);
>    Lisp_Object doc = Qnil;
>    if (documentation)
>      {
> @@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST)   */)
>    (ptrdiff_t nargs, Lisp_Object *arglist)
>  {
>    Lisp_Object envobj = arglist[0];
> -  /* FIXME: Rather than use a save_value, we should create a new object
> type.
> -     Making save_value visible to Lisp is wrong.  */
> -  CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj);
> -  struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj);
> -  CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p,
> envobj);
> -  /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0)
> -     is a module_fun_env pointer.  If some other part of Emacs also
> -     exports save_value objects to Elisp, than we may be getting here this
> -     other kind of save_value which will likely hold something completely
> -     different in this field.  */
> -  struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0);
> +  CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj);
> +  struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj);
>    EMACS_INT len = nargs - 1;
>    eassume (0 <= envptr->min_arity);
>    if (! (envptr->min_arity <= len
> @@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object
> tag_val)
>
>  /* Return a string object that contains a user-friendly
>     representation of the function environment.  */
> -static Lisp_Object
> -module_format_fun_env (const struct module_fun_env *env)
> +Lisp_Object
> +module_format_fun_env (const struct Lisp_Module_Function *env)
>  {
>    /* Try to print a function name if possible.  */
> +  /* FIXME: Move this function into print.c, then use prin1-to-string
> +     above.  */
>    const char *path, *sym;
>    static char const noaddr_format[] = "#<module function at %p>";
>    char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256];
> @@ -1048,8 +1019,7 @@ syms_of_module (void)
>       code or modules should not access it.  */
>    Funintern (Qmodule_refs_hash, Qnil);
>
> -  DEFSYM (Qsave_value_p, "save-value-p");
> -  DEFSYM (Qsave_pointer_p, "save-pointer-p");
> +  DEFSYM (Qmodule_function_p, "module-function-p");
>
>    defsubr (&Smodule_load);
>
> diff --git a/src/lisp.h b/src/lisp.h
> index daf57ed906..5d4c64a2e5 100644
> --- a/src/lisp.h
> +++ b/src/lisp.h
> @@ -464,6 +464,7 @@ 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,
> @@ -2385,6 +2386,28 @@ 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.  */
> @@ -2437,6 +2460,7 @@ 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
>    };
>
> @@ -2485,6 +2509,19 @@ 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
>
>
> @@ -3889,8 +3926,10 @@ extern bool let_shadows_buffer_binding_p (struct
> Lisp_Symbol *symbol);
>  #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 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 872103bd4c..7e411a80c8 100644
> --- a/src/print.c
> +++ b/src/print.c
> @@ -2103,6 +2103,11 @@ 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:
> diff --git a/test/src/emacs-module-tests.el
> b/test/src/emacs-module-tests.el
> index 93e85ae22d..7859fc5dce 100644
> --- a/test/src/emacs-module-tests.el
> +++ b/test/src/emacs-module-tests.el
> @@ -59,6 +59,29 @@
>  (ert-deftest mod-test-sum-docstring ()
>    (should (string= (documentation 'mod-test-sum) "Return A + B")))
>
> +(ert-deftest module-function-object ()
> +  "Extract and test the implementation of a module function.
> +This test needs to be changed whenever the implementation
> +changes."
> +  (let ((func (symbol-function #'mod-test-sum)))
> +    (should (consp func))
> +    (should (equal (length func) 4))
> +    (should (equal (nth 0 func) 'lambda))
> +    (should (equal (nth 1 func) '(&rest args)))
> +    (should (equal (nth 2 func) "Return A + B"))
> +    (let ((body (nth 3 func)))
> +      (should (consp body))
> +      (should (equal (length body) 4))
> +      (should (equal (nth 0 body) #'apply))
> +      (should (equal (nth 1 body) '#'internal--module-call))
> +      (should (equal (nth 3 body) 'args))
> +      (let ((obj (nth 2 body)))
> +        (should (equal (type-of obj) 'module-function))
> +        (should (string-match-p
> +                 (rx "#<module function Fmod_test_sum from "
> +                     (* nonl) "mod-test" (* nonl) ">")
> +                 (prin1-to-string obj)))))))
> +
>  ;;
>  ;; Non-local exists (throw, signal).
>  ;;
> --
> 2.12.2
>
>
No further comments, so I've pushed this as a3e9694078.

[-- Attachment #2: Type: text/html, Size: 13420 bytes --]