From: Richard W.M. Jones <rjones@redhat.com>
Date: Wed, 18 Sep 2013 15:21:26 +0000 (+0100)
Subject: Pass a suspension to 'require'.
X-Git-Tag: 0.2~22
X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=5dda93a3b5debe8f10da6cb7868876728d99fe9e;p=goaljobs.git

Pass a suspension to 'require'.
---

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$) >>
 
 ;;