Rework printing of module functions

Fix a FIXME in emacs-module.c.  Put the printing into print.c, like
other types.

* src/print.c (print_vectorlike): Add code to print module functions.

* src/emacs-module.c (funcall_module): Stop calling
'module_format_fun_env'.  Now that module functions are first-class
objects, they can be added to signal data directly.
(module_handle_signal): Remove now-unused function
'module_format_fun_env'.

* test/src/emacs-module-tests.el (mod-test-sum-test): Adapt unit test.

* src/eval.c (funcall_lambda): Adapt call to changed signature of
'funcall_module'.

diff --git a/src/emacs-module.c b/src/emacs-module.c
index f2eaa71de3f648e0e02c50a00b85167beb57be0e..f9e76b5f0f881aceb2c85eccc3a624c714ec27a9 100644 (file)
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -645,14 +645,13 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
 }
 
 Lisp_Object
-funcall_module (const struct Lisp_Module_Function *const function,
-                ptrdiff_t nargs, Lisp_Object *arglist)
+funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
 {
-  eassume (0 <= function->min_arity);
-  if (! (function->min_arity <= nargs
-        && (function->max_arity < 0 || nargs <= function->max_arity)))
-    xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (function),
-             make_number (nargs));
+  const struct Lisp_Module_Function *func = XMODULE_FUNCTION (function);
+  eassume (0 <= func->min_arity);
+  if (! (func->min_arity <= nargs
+        && (func->max_arity < 0 || nargs <= func->max_arity)))
+    xsignal2 (Qwrong_number_of_arguments, function, make_natnum (nargs));
 
   emacs_env pub;
   struct emacs_env_private priv;
@@ -669,7 +668,7 @@ funcall_module (const struct Lisp_Module_Function *const function,
        args[i] = lisp_to_value (arglist[i]);
     }
 
-  emacs_value ret = function->subr (&pub, nargs, args, function->data);
+  emacs_value ret = func->subr (&pub, nargs, args, func->data);
   SAFE_FREE ();
 
   eassert (&priv == pub.private_members);
@@ -941,35 +940,6 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
   module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val));
 }
 
-\f
-/* Function environments.  */
-
-/* Return a string object that contains a user-friendly
-   representation of the function environment.  */
-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];
-  char *buf = buffer;
-  ptrdiff_t bufsize = sizeof buffer;
-  ptrdiff_t size
-    = (dynlib_addr (env->subr, &path, &sym)
-       ? exprintf (&buf, &bufsize, buffer, -1,
-                  "#<module function %s from %s>", sym, path)
-       : sprintf (buffer, noaddr_format, env->subr));
-  AUTO_STRING_WITH_LEN (unibyte_result, buffer, size);
-  Lisp_Object result = code_convert_string_norecord (unibyte_result,
-                                                    Qutf_8, false);
-  if (buf != buffer)
-    xfree (buf);
-  return result;
-}
-
 \f
 /* Segment initializer.  */
 

diff --git a/src/eval.c b/src/eval.c
index f472efad52eb77cd5787eb3b632a9bfd891ec80c..8aa33a11282ebd1d82ea52106a4c987e9214b1d9 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -2952,7 +2952,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
     }
 #ifdef HAVE_MODULES
   else if (MODULE_FUNCTIONP (fun))
-    return funcall_module (XMODULE_FUNCTION (fun), nargs, arg_vector);
+    return funcall_module (fun, nargs, arg_vector);
 #endif
   else
     emacs_abort ();

diff --git a/src/lisp.h b/src/lisp.h
index 7b8f1e754d8329963d6c8cede91f52c383cbed83..ce939fcee62eacf386e7e136670b40fa4ff14c6d 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3952,10 +3952,8 @@ XMODULE_FUNCTION (Lisp_Object o)
 extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p);
 
 /* Defined in emacs-module.c.  */
-extern Lisp_Object funcall_module (const struct Lisp_Module_Function *,
-                                   ptrdiff_t, Lisp_Object *);
+extern Lisp_Object funcall_module (Lisp_Object, 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 49408bbeb4086f6c72acc190bbfde092b8af77e0..e89f3d80725f2e037af3153aa5a4040382d42f60 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -33,6 +33,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "intervals.h"
 #include "blockinput.h"
 #include "xwidget.h"
+#include "dynlib.h"
 
 #include <c-ctype.h>
 #include <float.h>
@@ -1699,8 +1700,33 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 
 #ifdef HAVE_MODULES
     case PVEC_MODULE_FUNCTION:
-      print_string (module_format_fun_env (XMODULE_FUNCTION (obj)),
-                   printcharfun);
+      {
+        print_c_string ("#<module function ", printcharfun);
+        void *ptr = XMODULE_FUNCTION (obj)->subr;
+        const char *file = NULL;
+        const char *symbol = NULL;
+        dynlib_addr (ptr, &file, &symbol);
+
+        if (symbol == NULL)
+          {
+            print_c_string (" at ", printcharfun);
+            enum { pointer_bufsize = sizeof ptr * 16 / CHAR_BIT + 2 + 1 };
+            char buffer[pointer_bufsize];
+            int needed = snprintf (buffer, sizeof buffer, "%p", ptr);
+            eassert (needed <= sizeof buffer);
+            print_c_string (buffer, printcharfun);
+          }
+        else
+          print_c_string (symbol, printcharfun);
+
+        if (file != NULL)
+          {
+            print_c_string (" from ", printcharfun);
+            print_c_string (file, printcharfun);
+          }
+
+        printchar ('>', printcharfun);
+      }
       break;
 #endif
 

diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 5e78aebf7c3b3935f77e3a2755aca705282bc0a9..622bbadb3eff5b18974d9ef81d9d5ab3cb01eb05 100644 (file)
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -31,13 +31,13 @@
   (should (= (mod-test-sum 1 2) 3))
   (let ((descr (should-error (mod-test-sum 1 2 3))))
     (should (eq (car descr) 'wrong-number-of-arguments))
-    (should (stringp (nth 1 descr)))
+    (should (module-function-p (nth 1 descr)))
     (should (eq 0
                 (string-match
                  (concat "#<module function "
                          "\\(at \\(0x\\)?[0-9a-fA-F]+\\( from .*\\)?"
                          "\\|Fmod_test_sum from .*\\)>")
-                 (nth 1 descr))))
+                 (prin1-to-string (nth 1 descr)))))
     (should (= (nth 2 descr) 3)))
   (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
   (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)