summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1996-10-05 16:50:00 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1996-10-05 16:50:00 +0000
commit44bd53b980ff65f72122b982f3f6acdaeedfe876 (patch)
tree70bc618f58d9523936c4dba85f2a69996b5aec6b
parent4b5166ac27650ade1430efb00e68261cd2541dd6 (diff)
downloadguile-44bd53b980ff65f72122b982f3f6acdaeedfe876.tar.gz
* procs.c: New function: scm_thunk_p.
-rw-r--r--libguile/procs.c30
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