aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorBT Templeton <[email protected]>2013-08-20 13:00:47 -0400
committerRobin Templeton <[email protected]>2015-04-19 03:43:02 -0400
commit0a436d7db5235d741467a0c886db3136d524ee02 (patch)
tree6cfcb304da78f2ef4840e5875e2a0b6e0c97a8b1 /src
parent42c30833c2f65f8d44f3a9f7564f41deac939659 (diff)
callable guile procs
* src/eval.c (eval_sub_1, Ffuncall): * src/lisp.h (functionp): Add support for calling Guile procedures.
Diffstat (limited to 'src')
-rw-r--r--src/eval.c24
-rw-r--r--src/lisp.h2
2 files changed, 23 insertions, 3 deletions
diff --git a/src/eval.c b/src/eval.c
index bb6d23e01f..e6b39a5064 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2166,7 +2166,23 @@ eval_sub_1 (Lisp_Object form)
else if (!NILP (fun) && (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun)))
fun = indirect_function (fun);
- if (SUBRP (fun))
+ if (scm_is_true (scm_procedure_p (fun)))
+ {
+ Lisp_Object args_left = original_args;
+ Lisp_Object nargs = Flength (args_left);
+ Lisp_Object *args;
+ size_t argnum = 0;
+
+ SAFE_ALLOCA_LISP (args, XINT (nargs));
+
+ while (! NILP (args_left))
+ {
+ args[argnum++] = eval_sub (Fcar (args_left));
+ args_left = Fcdr (args_left);
+ }
+ val = scm_call_n (fun, args, argnum);
+ }
+ else if (SUBRP (fun))
{
Lisp_Object numargs;
Lisp_Object argvals[8];
@@ -2869,7 +2885,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
&& (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun)))
fun = indirect_function (fun);
- if (SUBRP (fun))
+ if (scm_is_true (scm_procedure_p (fun)))
+ {
+ val = scm_call_n (fun, args + 1, numargs);
+ }
+ else if (SUBRP (fun))
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
diff --git a/src/lisp.h b/src/lisp.h
index 86d20cea0a..3d5e7bed62 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3989,7 +3989,7 @@ functionp (Lisp_Object object)
return EQ (car, Qlambda) || EQ (car, Qclosure);
}
else
- return false;
+ return scm_is_true (scm_procedure_p (object));
}
INLINE_HEADER_END