From 5dda93a3b5debe8f10da6cb7868876728d99fe9e Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Wed, 18 Sep 2013 16:21:26 +0100
Subject: [PATCH] Pass a suspension to 'require'.

---
 goaljobs.ml  | 2 +-
 goaljobs.mli | 2 +-
 pa_goal.ml   | 6 +++---
 3 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/goaljobs.ml b/goaljobs.ml
index 2dc0541..3be5b51 100644
--- a/goaljobs.ml
+++ b/goaljobs.ml
@@ -35,7 +35,7 @@ let target v =
   if v then raise (Goal_result Goal_OK)
 let target_all vs = target (List.fold_left (&&) true vs)
 let target_exists vs = target (List.fold_left (||) false vs)
-let require () = ()
+let require f = f ()
 
 type period_t = Seconds | Days | Months | Years
 let seconds = (1, Seconds)
diff --git a/goaljobs.mli b/goaljobs.mli
index 0437826..daaf0b2 100644
--- a/goaljobs.mli
+++ b/goaljobs.mli
@@ -100,7 +100,7 @@ val target_exists : bool list -> unit
   (** [target_exists [t1; t2; ...]] is the same as writing
       [target (t1 || t2 || ...)] *)
 
-val require : unit -> unit
+val require : (unit -> unit) -> unit
   (** [require] {!goal} defines the requirements of this rule, that
       is, other goals that have to be met before this rule is able to run.
 
diff --git a/pa_goal.ml b/pa_goal.ml
index 723df1b..86f67db 100644
--- a/pa_goal.ml
+++ b/pa_goal.ml
@@ -111,7 +111,7 @@ let generate_let_goal _loc (r : rec_flag) (lets : binding) =
           let () = publish $str:name$ (
             function
             | [] ->
-              Goaljobs.require ($lid:gname$ ())
+              Goaljobs.require $lid:gname$
             | _ ->
               failwith (Printf.sprintf "goal '%s' does not take any arguments"
                           $str:name$);
@@ -120,7 +120,7 @@ let generate_let_goal _loc (r : rec_flag) (lets : binding) =
       StSem (_loc, stmt, publish_name)
   ) stmts !autopublish
 
-(* Rewrite 'require (name args...)' as 'require (goal_name args)'.
+(* Rewrite 'require (name args...)' as 'require (fun () -> goal_name args)'.
  * 'expr' is a function call.
  *)
 let generate_require _loc expr =
@@ -137,7 +137,7 @@ let generate_require _loc expr =
       locfail _loc "require (...) expression must contain a call to a goal"
   in
   let expr = rewrite expr in
-  <:expr< Goaljobs.require ($expr$) >>
+  <:expr< Goaljobs.require (fun () -> $expr$) >>
 
 ;;
 
-- 
1.8.3.1