From 44bd53b980ff65f72122b982f3f6acdaeedfe876 Mon Sep 17 00:00:00 2001
From: Mikael Djurfeldt <djurfeldt@nada.kth.se>
Date: Sat, 5 Oct 1996 16:50:00 +0000
Subject: [PATCH] * procs.c: New function: scm_thunk_p.

---
 libguile/procs.c | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

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