bug#23486: 25.0.93; Modules: features missing from make_function

[Philipp Stephani <p.stephani2@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1209 bytes --]

Philipp Stephani <p.stephani2@gmail.com> schrieb am Mo., 9. Mai 2016 um
18:39 Uhr:

>
> emacs_env::make_function lacks the following features supported by
> `defun':
>
> 1. Functions with both optional and rest arguments.
> 2. Specification of parameter names.
> 3. Integration with `help-function-arglist'.
> 4. Specification of interactive forms.
> 5. Specification of declare forms.
> 6. Docstrings containing null or non-Unicode characters.
>
> (6) is probably rather unimportant.  (5) is probably not implementable
> (would require wrapping `defun', not `lambda').  (1)–(4) are more severe
> and quite limit the usefulness of make_function right now; for a
> truly generic `defun'-like construct one currently has to eval a `defun'
> form wrapping another function.
>
> To solve (1)–(3), I'd propose replacing the "arity" arguments with a
> true arglist specification.  This could either be at the C level, e.g.
>
>     ptrdiff_t num_mandatory_args, char** mandatory_arg_names,
>     ptrdiff_t num_optional_args, char** optional_arg_names,
>     char* rest_arg_name
>
> or by requiring to pass a Lisp argument list.
>

I've attached a patch for fixing (1)-(4) and (6).

[-- Attachment #1.2: Type: text/html, Size: 2034 bytes --]

[-- Attachment #2: 0001-Introduce-new-module-function-make_function_ext.patch --]
[-- Type: application/octet-stream, Size: 8154 bytes --]

From 47ff03da305ec118fb841cac4c7ac994b2eeb52c Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Sun, 11 Sep 2016 16:09:01 +0200
Subject: [PATCH] Introduce new module function `make_function_ext'

This function allows specifying a full argument list and all other
features of `lambda'; see Bug#23486.

* src/emacs-module.c (module_make_function_ext): New function.
(initialize_environment): Use new function.

* modules/mod-test/mod-test.c (Fmod_test_sum_2)
(emacs_module_init): Add an example module function using
make_function_ext.

* modules/mod-test/test.el (mod-test-sum-2-test): Add a test for
new example module function.
---
 modules/mod-test/mod-test.c | 29 +++++++++++++++++++++
 modules/mod-test/test.el    |  9 +++++++
 src/emacs-module.c          | 63 +++++++++++++++++++++++++++++++++++++++++++++
 src/emacs-module.h          | 22 ++++++++++++++++
 4 files changed, 123 insertions(+)

diff --git a/modules/mod-test/mod-test.c b/modules/mod-test/mod-test.c
index 3c8ab0f..1c2e5c6 100644
--- a/modules/mod-test/mod-test.c
+++ b/modules/mod-test/mod-test.c
@@ -52,6 +52,26 @@ Fmod_test_sum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data)
   return env->make_integer (env, r);
 }
 
+static emacs_value
+Fmod_test_sum_2 (emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
+{
+  intmax_t accumulator = 0;
+
+  for (ptrdiff_t i = 0; i < nargs; ++i)
+    {
+      if (! env->is_not_nil (env, args[i]))
+        continue;
+      intmax_t arg = env->extract_integer (env, args[i]);
+      if (__builtin_add_overflow (accumulator, arg, &accumulator))
+        {
+          env->non_local_exit_signal (env, env->intern (env, "overflow-error"), env->intern (env, "nil"));
+          break;
+        }
+    }
+
+  return env->make_integer (env, accumulator);
+}
+
 
 /* Signal '(error 56).  */
 static emacs_value
@@ -263,6 +283,15 @@ emacs_module_init (struct emacs_runtime *ert)
 
 #undef DEFUN
 
+  emacs_value list_args[] = {env->intern (env, "a"),
+                             env->intern (env, "&optional"), env->intern (env, "b"),
+                             env->intern (env, "&rest"), env->intern (env, "rest")};
+  bind_function (env, "mod-test-sum-2",
+                 env->make_function_ext (env,
+                                         env->funcall (env, env->intern (env, "list"), 5, list_args),
+                                         env->intern (env, "nil"), NULL,
+                                         Fmod_test_sum_2, NULL));
+
   provide (env, "mod-test");
   return 0;
 }
diff --git a/modules/mod-test/test.el b/modules/mod-test/test.el
index 2d363c3..037a996 100644
--- a/modules/mod-test/test.el
+++ b/modules/mod-test/test.el
@@ -56,6 +56,15 @@
   (should-error (mod-test-sum -1 most-negative-fixnum)
                 :type 'overflow-error))
 
+(ert-deftest mod-test-sum-2-test ()
+  (should-error (mod-test-sum-2) :type 'wrong-number-of-arguments)
+  (should (equal (mod-test-sum-2 1) 1))
+  (should (equal (mod-test-sum-2 1 2) 3))
+  (should (equal (mod-test-sum-2 1 2 3) 6))
+  (should (equal (mod-test-sum-2 1 2 3 4) 10))
+  (should-error (mod-test-sum-2 'foo) :type 'wrong-type-argument)
+  (should-error (mod-test-sum-2 most-positive-fixnum 1) :type 'overflow-error))
+
 (ert-deftest mod-test-sum-docstring ()
   (should (string= (documentation 'mod-test-sum) "Return A + B")))
 
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 724d24a..25fcdd2 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -415,6 +415,68 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
 }
 
 static emacs_value
+module_make_function_ext (emacs_env *env, emacs_value arglist,
+                          emacs_value docstring, emacs_value *interactive,
+                          emacs_subr function, void *data)
+{
+  MODULE_FUNCTION_BEGIN (module_nil);
+
+  Lisp_Object arglist_obj = value_to_lisp (arglist);
+  CHECK_LIST (arglist_obj);
+
+  Lisp_Object docstring_obj = value_to_lisp (docstring);
+  if (! NILP (docstring_obj))
+    /* Explicitly check whether the docstring is indeed a string, so that
+       callers can't sneak in body forms.  */
+    CHECK_STRING (docstring_obj);
+
+  /* Build up lists that forward the arguments to internal--module-call.  */
+  Lisp_Object normal_args = Qnil;
+  Lisp_Object rest_args = Qnil;
+  for (Lisp_Object it = arglist_obj; ! NILP (it); it = CDR (it))
+    {
+      /* We don't check for invalid parameters here.  funcall_lambda will check.  */
+      Lisp_Object arg = CAR (it);
+      if (EQ (arg, Qand_optional))
+        continue;
+      if (EQ (arg, Qand_rest))
+        {
+          rest_args = Fcons (CAR (CDR (it)), rest_args);
+          break;
+        }
+      normal_args = Fcons (arg, normal_args);
+    }
+  normal_args = Fnreverse (normal_args);
+
+  /* FIXME: This should be freed when envobj is GC'd.  */
+  struct module_fun_env *envptr = xmalloc (sizeof *envptr);
+  /* The actual argument count check is done by funcall_lambda.  */
+  envptr->min_arity = 0;
+  envptr->max_arity = emacs_variadic_function;
+  envptr->subr = function;
+  envptr->data = data;
+  Lisp_Object envobj = make_save_ptr (envptr);
+
+  /* Build up the function definition.  It is a normal lambda form.  */
+  Lisp_Object ret = CALLN (Fappend,
+                           list3 (Qapply,
+                                  list2 (Qfunction, Qinternal__module_call),
+                                  envobj),
+                           normal_args, rest_args);
+  ret = list1 (ret);
+
+  if (interactive != NULL)
+    ret = Fcons (list2 (Qinteractive, value_to_lisp (*interactive)), ret);
+
+  if (! NILP (docstring_obj))
+    ret = Fcons (docstring_obj, ret);
+
+  ret = Fcons (Qlambda, Fcons (arglist_obj, ret));
+
+  return lisp_to_value (ret);
+}
+
+static emacs_value
 module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
 		emacs_value args[])
 {
@@ -916,6 +978,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
   env->non_local_exit_signal = module_non_local_exit_signal;
   env->non_local_exit_throw = module_non_local_exit_throw;
   env->make_function = module_make_function;
+  env->make_function_ext = module_make_function_ext;
   env->funcall = module_funcall;
   env->intern = module_intern;
   env->type_of = module_type_of;
diff --git a/src/emacs-module.h b/src/emacs-module.h
index ae7311b..da6a103 100644
--- a/src/emacs-module.h
+++ b/src/emacs-module.h
@@ -185,6 +185,28 @@ struct emacs_env_25
 		   emacs_value val);
 
   ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec);
+
+  /* Variant of make_function that allows specifying a full argument list,
+     documentation string, and interactive form.  This allows defining
+     functions that are impossible to define with make_function, such as
+     functions with both optional and rest arguments.  It also improves help
+     display for the function, as the arguments are named.  ARGLIST must be a
+     list specifying the function parameters, as with `lambda' or `defun'.
+     DOCSTRING must be either nil (for an undocumented function) or a string.
+     INTERACTIVE must be either NULL (for a non-interactive function) or a
+     pointer to a Lisp object to be used as argument to `interactive', which
+     see.  When calling the function, it is unspecified whether optional
+     arguments are passed as nil or not passed at all.  */
+  emacs_value (*make_function_ext) (emacs_env *env,
+                                    emacs_value arglist,
+                                    emacs_value docstring,
+                                    emacs_value *interactive,
+                                    emacs_value (*function) (emacs_env *env,
+                                                             ptrdiff_t nargs,
+                                                             emacs_value *args,
+                                                             void *data)
+                                    EMACS_NOEXCEPT,
+                                    void *data);
 };
 
 /* Every module should define a function as follows.  */
-- 
2.9.0