promises are in their own file now

* libguile.h:
* libguile/Makefile.am:
* libguile/eval.c:
* libguile/eval.h:
* libguile/init.c:
* libguile/promises.c:
* libguile/promises.h: Split promises out into their own file.

7 files changed, 218 insertions, 91 deletions

diff --git a/libguile.h b/libguile.h
index 2b764d1cd..7a8b6333f 100644
--- a/libguile.h
+++ b/libguile.h
@@ -80,6 +80,7 @@ extern "C" {
 #include "libguile/posix.h"
 #include "libguile/print.h"
 #include "libguile/procprop.h"
+#include "libguile/promises.h"
 #include "libguile/properties.h"
 #include "libguile/procs.h"
 #include "libguile/r6rs-ports.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index a093053f3..c453c84b0 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -167,6 +167,7 @@ libguile_la_SOURCES =				\
 	procprop.c				\
 	procs.c					\
 	programs.c				\
+	promises.c				\
 	properties.c				\
 	r6rs-ports.c				\
 	random.c				\
@@ -260,6 +261,7 @@ DOT_X_FILES =					\
 	print.x					\
 	procprop.x				\
 	procs.x					\
+	promises.x				\
 	properties.x				\
 	r6rs-ports.x				\
 	random.x				\
@@ -357,6 +359,7 @@ DOT_DOC_FILES = 				\
 	print.doc				\
 	procprop.doc				\
 	procs.doc				\
+	promises.doc				\
 	properties.doc				\
 	r6rs-ports.doc				\
 	random.doc				\
@@ -525,6 +528,7 @@ modinclude_HEADERS =				\
 	procprop.h				\
 	procs.h					\
 	programs.h				\
+	promises.h				\
 	properties.h				\
 	pthread-threads.h			\
 	r6rs-ports.h				\
diff --git a/libguile/eval.c b/libguile/eval.c
index b47721df7..616410d49 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -987,72 +987,6 @@ scm_closure (SCM code, SCM env)
 }
 
 
-scm_t_bits scm_tc16_promise;
-
-SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0, 
-	    (SCM thunk),
-	    "Create a new promise object.\n\n"
-            "@code{make-promise} is a procedural form of @code{delay}.\n"
-            "These two expressions are equivalent:\n"
-            "@lisp\n"
-	    "(delay @var{exp})\n"
-	    "(make-promise (lambda () @var{exp}))\n"
-            "@end lisp\n")
-#define FUNC_NAME s_scm_make_promise
-{
-  SCM_VALIDATE_THUNK (1, thunk);
-  SCM_RETURN_NEWSMOB2 (scm_tc16_promise,
-		       SCM_UNPACK (thunk),
-		       scm_make_recursive_mutex ());
-}
-#undef FUNC_NAME
-
-static int 
-promise_print (SCM exp, SCM port, scm_print_state *pstate)
-{
-  int writingp = SCM_WRITINGP (pstate);
-  scm_puts ("#<promise ", port);
-  SCM_SET_WRITINGP (pstate, 1);
-  scm_iprin1 (SCM_PROMISE_DATA (exp), port, pstate);
-  SCM_SET_WRITINGP (pstate, writingp);
-  scm_putc ('>', port);
-  return !0;
-}
-
-SCM_DEFINE (scm_force, "force", 1, 0, 0, 
-	    (SCM promise),
-	    "If the promise @var{x} has not been computed yet, compute and\n"
-	    "return @var{x}, otherwise just return the previously computed\n"
-	    "value.")
-#define FUNC_NAME s_scm_force
-{
-  SCM_VALIDATE_SMOB (1, promise, promise);
-  scm_lock_mutex (SCM_PROMISE_MUTEX (promise));
-  if (!SCM_PROMISE_COMPUTED_P (promise))
-    {
-      SCM ans = scm_call_0 (SCM_PROMISE_DATA (promise));
-      if (!SCM_PROMISE_COMPUTED_P (promise))
-	{
-	  SCM_SET_PROMISE_DATA (promise, ans);
-	  SCM_SET_PROMISE_COMPUTED (promise);
-	}
-    }
-  scm_unlock_mutex (SCM_PROMISE_MUTEX (promise));
-  return SCM_PROMISE_DATA (promise);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_promise_p, "promise?", 1, 0, 0, 
-            (SCM obj),
-	    "Return true if @var{obj} is a promise, i.e. a delayed computation\n"
-	    "(@pxref{Delayed evaluation,,,r5rs.info,The Revised^5 Report on Scheme}).")
-#define FUNC_NAME s_scm_promise_p
-{
-  return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_promise, obj));
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0,
 	    (SCM exp),
 	    "Evaluate @var{exp} in the top-level environment specified by\n"
@@ -1138,17 +1072,12 @@ scm_init_eval ()
   scm_init_opts (scm_eval_options_interface,
 		 scm_eval_opts);
   
-  scm_tc16_promise = scm_make_smob_type ("promise", 0);
-  scm_set_smob_print (scm_tc16_promise, promise_print);
-
   scm_listofnull = scm_list_1 (SCM_EOL);
 
   f_apply = scm_c_define_subr ("apply", scm_tc7_lsubr_2, scm_apply);
   scm_permanent_object (f_apply);
 
 #include "libguile/eval.x"
-
-  scm_add_feature ("delay");
 }
 
 /*
diff --git a/libguile/eval.h b/libguile/eval.h
index fbb5bf512..f10110fb3 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -46,23 +46,6 @@
 
 
 
-/* {Promises}
- */
-
-#define SCM_F_PROMISE_COMPUTED (1L << 0)
-#define SCM_PROMISE_COMPUTED_P(promise) \
-  (SCM_F_PROMISE_COMPUTED & SCM_SMOB_FLAGS (promise))
-#define SCM_SET_PROMISE_COMPUTED(promise) \
-  SCM_SET_SMOB_FLAGS ((promise), SCM_F_PROMISE_COMPUTED)
-#define SCM_PROMISE_MUTEX     SCM_SMOB_OBJECT_2
-#define SCM_PROMISE_DATA      SCM_SMOB_OBJECT
-#define SCM_SET_PROMISE_DATA  SCM_SET_SMOB_OBJECT
-
-
-SCM_API scm_t_bits scm_tc16_promise;
-
-
-
 /* {Evaluator}
  */
 
@@ -97,9 +80,6 @@ SCM_API SCM scm_apply (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_map (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_for_each (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_closure (SCM code, SCM env);
-SCM_API SCM scm_make_promise (SCM thunk);
-SCM_API SCM scm_force (SCM x);
-SCM_API SCM scm_promise_p (SCM x);
 SCM_API SCM scm_primitive_eval (SCM exp);
 #define scm_primitive_eval_x(exp) scm_primitive_eval (exp)
 SCM_API SCM scm_eval (SCM exp, SCM module);
diff --git a/libguile/init.c b/libguile/init.c
index 6c13a88ec..85b277b32 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -94,6 +94,7 @@
 #include "libguile/print.h"
 #include "libguile/procprop.h"
 #include "libguile/procs.h"
+#include "libguile/promises.h"
 #include "libguile/properties.h"
 #include "libguile/array-map.h"
 #include "libguile/random.h"
@@ -490,6 +491,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_hashtab ();
   scm_init_deprecation ();      /* Requires hashtabs */
   scm_init_objprop ();
+  scm_init_promises ();
   scm_init_properties ();
   scm_init_hooks ();            /* Requires smob_prehistory */
   scm_init_gc ();		/* Requires hooks, async */
diff --git a/libguile/promises.c b/libguile/promises.c
new file mode 100644
index 000000000..fc34cc8f5
--- /dev/null
+++ b/libguile/promises.c
@@ -0,0 +1,150 @@
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
+ * Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <alloca.h>
+
+#include "libguile/__scm.h"
+
+#include "libguile/_scm.h"
+#include "libguile/alist.h"
+#include "libguile/async.h"
+#include "libguile/continuations.h"
+#include "libguile/debug.h"
+#include "libguile/deprecation.h"
+#include "libguile/dynwind.h"
+#include "libguile/eq.h"
+#include "libguile/eval.h"
+#include "libguile/feature.h"
+#include "libguile/fluids.h"
+#include "libguile/goops.h"
+#include "libguile/hash.h"
+#include "libguile/hashtab.h"
+#include "libguile/lang.h"
+#include "libguile/list.h"
+#include "libguile/macros.h"
+#include "libguile/memoize.h"
+#include "libguile/modules.h"
+#include "libguile/ports.h"
+#include "libguile/print.h"
+#include "libguile/procprop.h"
+#include "libguile/programs.h"
+#include "libguile/root.h"
+#include "libguile/smob.h"
+#include "libguile/srcprop.h"
+#include "libguile/stackchk.h"
+#include "libguile/strings.h"
+#include "libguile/threads.h"
+#include "libguile/throw.h"
+#include "libguile/validate.h"
+#include "libguile/values.h"
+#include "libguile/promises.h"
+
+
+
+
+
+scm_t_bits scm_tc16_promise;
+
+SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0, 
+	    (SCM thunk),
+	    "Create a new promise object.\n\n"
+            "@code{make-promise} is a procedural form of @code{delay}.\n"
+            "These two expressions are equivalent:\n"
+            "@lisp\n"
+	    "(delay @var{exp})\n"
+	    "(make-promise (lambda () @var{exp}))\n"
+            "@end lisp\n")
+#define FUNC_NAME s_scm_make_promise
+{
+  SCM_VALIDATE_THUNK (1, thunk);
+  SCM_RETURN_NEWSMOB2 (scm_tc16_promise,
+		       SCM_UNPACK (thunk),
+		       scm_make_recursive_mutex ());
+}
+#undef FUNC_NAME
+
+static int 
+promise_print (SCM exp, SCM port, scm_print_state *pstate)
+{
+  int writingp = SCM_WRITINGP (pstate);
+  scm_puts ("#<promise ", port);
+  SCM_SET_WRITINGP (pstate, 1);
+  scm_iprin1 (SCM_PROMISE_DATA (exp), port, pstate);
+  SCM_SET_WRITINGP (pstate, writingp);
+  scm_putc ('>', port);
+  return !0;
+}
+
+SCM_DEFINE (scm_force, "force", 1, 0, 0, 
+	    (SCM promise),
+	    "If the promise @var{x} has not been computed yet, compute and\n"
+	    "return @var{x}, otherwise just return the previously computed\n"
+	    "value.")
+#define FUNC_NAME s_scm_force
+{
+  SCM_VALIDATE_SMOB (1, promise, promise);
+  scm_lock_mutex (SCM_PROMISE_MUTEX (promise));
+  if (!SCM_PROMISE_COMPUTED_P (promise))
+    {
+      SCM ans = scm_call_0 (SCM_PROMISE_DATA (promise));
+      if (!SCM_PROMISE_COMPUTED_P (promise))
+	{
+	  SCM_SET_PROMISE_DATA (promise, ans);
+	  SCM_SET_PROMISE_COMPUTED (promise);
+	}
+    }
+  scm_unlock_mutex (SCM_PROMISE_MUTEX (promise));
+  return SCM_PROMISE_DATA (promise);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_promise_p, "promise?", 1, 0, 0, 
+            (SCM obj),
+	    "Return true if @var{obj} is a promise, i.e. a delayed computation\n"
+	    "(@pxref{Delayed evaluation,,,r5rs.info,The Revised^5 Report on Scheme}).")
+#define FUNC_NAME s_scm_promise_p
+{
+  return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_promise, obj));
+}
+#undef FUNC_NAME
+
+void 
+scm_init_promises ()
+{
+  scm_tc16_promise = scm_make_smob_type ("promise", 0);
+  scm_set_smob_print (scm_tc16_promise, promise_print);
+
+#include "libguile/promises.x"
+
+  scm_add_feature ("delay");
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
+
diff --git a/libguile/promises.h b/libguile/promises.h
new file mode 100644
index 000000000..66349b5ab
--- /dev/null
+++ b/libguile/promises.h
@@ -0,0 +1,61 @@
+/* classes: h_files */
+
+#ifndef SCM_PROMISES_H
+#define SCM_PROMISES_H
+
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009
+ * Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+
+
+
+/* {Promises}
+ */
+
+#define SCM_F_PROMISE_COMPUTED (1L << 0)
+#define SCM_PROMISE_COMPUTED_P(promise) \
+  (SCM_F_PROMISE_COMPUTED & SCM_SMOB_FLAGS (promise))
+#define SCM_SET_PROMISE_COMPUTED(promise) \
+  SCM_SET_SMOB_FLAGS ((promise), SCM_F_PROMISE_COMPUTED)
+#define SCM_PROMISE_MUTEX     SCM_SMOB_OBJECT_2
+#define SCM_PROMISE_DATA      SCM_SMOB_OBJECT
+#define SCM_SET_PROMISE_DATA  SCM_SET_SMOB_OBJECT
+
+
+SCM_API scm_t_bits scm_tc16_promise;
+
+
+
+SCM_API SCM scm_make_promise (SCM thunk);
+SCM_API SCM scm_force (SCM x);
+SCM_API SCM scm_promise_p (SCM x);
+
+SCM_INTERNAL void scm_init_promises (void);
+
+
+#endif  /* SCM_PROMISES_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/