From a7ab51c02e36aa9e2a6a6faa2b59c965bf82d309 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 18 Oct 2019 06:08:35 -0700
Subject: functions: provide accessors for basic properties.

* eval.c (eval_init): Register intrinsic functions
fun-fixparam-count, fun-optparam-count, fun-variadic.

* lib.c (get_param_counts): New static function.
(fun_fixparam_count, fun_optparam_count, fun_variadic): New
functions.

* lib.h (fun_fixparam_count, fun_optparam_count,
fun_variadic): Declared.

* txr.1: Documented.
---
 eval.c |  3 +++
 lib.c  | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lib.h  |  3 +++
 txr.1  | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 124 insertions(+)

diff --git a/eval.c b/eval.c
index 2a345f09..4e1c7aad 100644
--- a/eval.c
+++ b/eval.c
@@ -6856,6 +6856,9 @@ void eval_init(void)
   reg_fun(intern(lit("functionp"), user_package), func_n1(functionp));
   reg_fun(intern(lit("interp-fun-p"), user_package), func_n1(interp_fun_p));
   reg_fun(intern(lit("vm-fun-p"), user_package), func_n1(vm_fun_p));
+  reg_fun(intern(lit("fun-fixparam-count"), user_package), func_n1(fun_fixparam_count));
+  reg_fun(intern(lit("fun-optparam-count"), user_package), func_n1(fun_optparam_count));
+  reg_fun(intern(lit("fun-variadic"), user_package), func_n1(fun_variadic));
   reg_fun(intern(lit("ctx-form"), system_package), func_n1(ctx_form));
   reg_fun(intern(lit("ctx-name"), system_package), func_n1(ctx_name));
 
diff --git a/lib.c b/lib.c
index 411bfd4a..c288c8fc 100644
--- a/lib.c
+++ b/lib.c
@@ -6206,6 +6206,69 @@ val vm_fun_p(val obj)
   return (functionp(obj) && obj->f.functype == FVM) ? t : nil;
 }
 
+static val get_param_counts(val params, cnum *fixparam, cnum *optparam)
+{
+  cnum fx = 0, oa = -1;
+
+  for (; consp(params); params = us_cdr(params)) {
+    val param = us_car(params);
+    if (param == colon_k && oa < 0) {
+      oa = 0;
+    } else {
+      fx++;
+      oa += (oa >= 0);
+    }
+  }
+
+  *fixparam = fx;
+  *optparam = oa;
+  return params;
+}
+
+val fun_fixparam_count(val fun)
+{
+  type_check(lit("func-fixparam-count"), fun, FUN);
+
+  if (fun->f.functype != FINTERP) {
+    return num(fun->f.fixparam);
+  } else {
+    val form = fun->f.f.interp_fun;
+    cnum fixparam, optparam;
+    val params = cadr(form);
+    (void) get_param_counts(params, &fixparam, &optparam);
+    return num(fixparam);
+  }
+}
+
+val fun_optparam_count(val fun)
+{
+  type_check(lit("func-optparam-count"), fun, FUN);
+
+  if (fun->f.functype != FINTERP) {
+    return num(fun->f.optargs);
+  } else {
+    val form = fun->f.f.interp_fun;
+    cnum fixparam, optparam;
+    val params = cadr(form);
+    (void) get_param_counts(params, &fixparam, &optparam);
+    return num(optparam);
+  }
+}
+
+val fun_variadic(val fun)
+{
+  type_check(lit("func-variadic"), fun, FUN);
+
+  if (fun->f.functype != FINTERP) {
+    return tnil(fun->f.variadic);
+  } else {
+    val form = fun->f.f.interp_fun;
+    cnum fixparam, optparam;
+    val params = cadr(form);
+    return tnil(get_param_counts(params, &fixparam, &optparam));
+  }
+}
+
 static noreturn void callerror(val fun, val msg)
 {
   uses_or2;
diff --git a/lib.h b/lib.h
index 35da0a43..a1763d77 100644
--- a/lib.h
+++ b/lib.h
@@ -966,6 +966,9 @@ val us_func_set_env(val fun, val env);
 val functionp(val);
 val interp_fun_p(val);
 val vm_fun_p(val);
+val fun_fixparam_count(val obj);
+val fun_optparam_count(val obj);
+val fun_variadic(val obj);
 val generic_funcall(val fun, struct args *);
 val funcall(val fun);
 val funcall1(val fun, val arg);
diff --git a/txr.1 b/txr.1
index 0bc8eb93..8e287d9b 100644
--- a/txr.1
+++ b/txr.1
@@ -17321,6 +17321,61 @@ function
 The environment object holds the captured bindings of a
 lexical closure.
 
+.coNP Functions @ fun-fixparam-count and @ fun-optparam-count
+.synb
+.mets (fun-fixparam-count << func )
+.mets (fun-optparam-count << func )
+.syne
+.desc
+The
+.code fun-fixparam-count
+reports
+.metn func 's
+number of fixed parameters. The fixed parameters consist of the required
+parameters and the optional parameters.  Variadic functions have a parameter
+which captures the remaining arguments which are in excess of the fixed
+parameters. That parameter is not considered a fixed parameter and therefore
+doesn't contribute to this count.
+
+The
+.code fun-optparam-count
+reports
+.metn func 's
+number of optional parameters.
+
+The
+.meta func
+argument must be a function.
+
+Note: if a function isn't variadic (see the
+.meta fun-variadic
+function) then the value reported by
+.code fun-fixparam-count
+represents the maximum number of arguments which can be passed to the function.
+The minimum number of required arguments can be calculated for any function by
+subtracting the value from
+.code fun-optparam-count
+from the value from
+.codn fun-fixparam-count .
+
+.coNP Function @ fun-variadic
+.synb
+.mets (fun-variadic << func )
+.syne
+.desc
+The
+.code fun-variadic
+function returns
+.code t
+if
+.meta func
+is a variadic function, otherwise
+.codn nil .
+
+The
+.meta func
+argument must be a function.
+
 .coNP Function @ interp-fun-p
 .synb
 .mets (interp-fun-p << obj )
-- 
cgit v1.2.3