diff options
author | BT Templeton <[email protected]> | 2013-08-20 13:00:47 -0400 |
---|---|---|
committer | Robin Templeton <[email protected]> | 2015-04-19 03:43:02 -0400 |
commit | 0a436d7db5235d741467a0c886db3136d524ee02 (patch) | |
tree | 6cfcb304da78f2ef4840e5875e2a0b6e0c97a8b1 /src | |
parent | 42c30833c2f65f8d44f3a9f7564f41deac939659 (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.c | 24 | ||||
-rw-r--r-- | src/lisp.h | 2 |
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 |