diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1996-10-05 16:50:00 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1996-10-05 16:50:00 +0000 |
commit | 44bd53b980ff65f72122b982f3f6acdaeedfe876 (patch) | |
tree | 70bc618f58d9523936c4dba85f2a69996b5aec6b | |
parent | 4b5166ac27650ade1430efb00e68261cd2541dd6 (diff) | |
download | guile-44bd53b980ff65f72122b982f3f6acdaeedfe876.tar.gz |
* procs.c: New function: scm_thunk_p.
-rw-r--r-- | libguile/procs.c | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/libguile/procs.c b/libguile/procs.c index 25c1135a0..ae23e663e 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -144,6 +144,36 @@ scm_procedure_p (obj) return SCM_BOOL_F; } +#ifdef __STDC__ +SCM +scm_thunk_p (SCM obj) +#else +SCM +scm_thunk_p (obj) + SCM obj; +#endif +{ + if (SCM_NIMP (obj)) + switch (SCM_TYP7 (obj)) + { + case scm_tcs_closures: + if (SCM_NULLP (SCM_CAR (SCM_CODE (obj)))) + return SCM_BOOL_T; + case scm_tc7_subr_0: + case scm_tc7_subr_1o: + case scm_tc7_lsubr: + case scm_tc7_rpsubr: + case scm_tc7_asubr: +#ifdef CCLO + case scm_tc7_cclo: +#endif + return SCM_BOOL_T; + default: + ; + } + return SCM_BOOL_F; +} + #ifdef __STDC__ void |