[Emacs-diffs] master 3b0080d 03/14: Rework printing of module functions

[Philipp Stephani]

branch: master
commit 3b0080de52db1756fc47f1642ee9980655421af9
Author: Philipp Stephani <address@hidden>
Commit: Philipp Stephani <address@hidden>

    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'.
---
 src/emacs-module.c             | 44 +++++++-----------------------------------
 src/eval.c                     |  2 +-
 src/lisp.h                     |  4 +---
 src/print.c                    | 30 ++++++++++++++++++++++++++--
 test/src/emacs-module-tests.el |  4 ++--
 5 files changed, 39 insertions(+), 45 deletions(-)

diff --git a/src/emacs-module.c b/src/emacs-module.c
index f2eaa71..f9e76b5 100644
--- 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);
@@ -942,35 +941,6 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val)
 }
 
 
-/* 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;
-}
-
-
 /* Segment initializer.  */
 
 void
diff --git a/src/eval.c b/src/eval.c
index f472efa..8aa33a1 100644
--- 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 7b8f1e7..ce939fc 100644
--- 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 49408bb..e89f3d8 100644
--- 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 5e78aeb..622bbad 100644
--- 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)