diff --git a/.merlin b/.merlin index 90a8640d..fda86d2d 100644 --- a/.merlin +++ b/.merlin @@ -8,4 +8,4 @@ PKG oUnit PKG bench PKG threads PKG threads.posix -PKG react +PKG lwt diff --git a/Makefile b/Makefile index 326c4083..393b006b 100644 --- a/Makefile +++ b/Makefile @@ -9,17 +9,17 @@ EXAMPLES = examples/mem_size.native examples/collatz.native examples/crawl.nativ OPTIONS = -use-ocamlfind ENABLE_THREAD ?= yes -ENABLE_REACT ?= yes +ENABLE_LWT ?= yes ifeq ($(ENABLE_THREAD), yes) OPTIONS += -tag thread TARGETS_LIB += thread_containers.cmxa thread_containers.cma TARGETS_DOC += thread_containers.docdir/index.html endif -ifeq ($(ENABLE_REACT), yes) - OPTIONS += -package react - TARGETS_LIB += react_containers.cmxa react_containers.cma - TARGETS_DOC += react_containers.docdir/index.html +ifeq ($(ENABLE_LWT), yes) + OPTIONS += -package lwt -package lwt.unix + TARGETS_LIB += lwt_containers.cmxa lwt_containers.cma + TARGETS_DOC += lwt_containers.docdir/index.html endif all: lib diff --git a/_tags b/_tags index e92e8962..79cb867c 100644 --- a/_tags +++ b/_tags @@ -1,3 +1,4 @@ <**/*future.*>: thread : package(batteries), thread, package(unix) +: package(lwt), package(unix) : thread diff --git a/behavior.ml b/behavior.ml index a2c5d69e..dbf1e168 100644 --- a/behavior.ml +++ b/behavior.ml @@ -28,18 +28,16 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {2 Behavior tree} *) type tree = - | Test of bool React.event (* test the next occurrence *) - | TestFun of (unit -> bool) (* call and test value *) - | Wait of unit React.event (* wait for the event to trigger *) - | Timeout of float (* fails after the given timeout *) + | Test of (unit -> bool) (* call and test value *) + | Wait of (unit -> bool Lwt.t) (* wait for the future to complete *) | Do of (unit -> bool) (* perform an action *) - | If of bool React.signal * tree * tree (* switch *) + | If of (unit -> bool) * tree * tree (* switch *) | Sequence of bool * tree list (* yield to subtrees sequentially. bool: loop? *) | Select of select_strategy * tree list (* select one subtree *) | Parallel of parallel_strategy * tree list (* run all subtrees in parallel *) | Closure of (unit -> tree) (* build a tree dynamically *) - | Succeed - | Fail + | Succeed (* always succeed *) + | Fail (* always fail *) (** A behavior tree *) and select_strategy = tree list -> (unit -> tree option) (** How to select a subtree to run. It yields a subtree until it @@ -69,17 +67,17 @@ let succeed = Succeed let fail = Fail -let test e = Test e +let test f = Test f -let test_fun f = TestFun f +let wait fut = Wait (fun () -> fut) -let test_signal s = TestFun (fun () -> React.S.value s) +let wait_ fut = Wait (fun () -> Lwt.bind fut (fun () -> Lwt.return_true)) -let wait e = Wait e +let wait_closure f = Wait f -let timeout f = Sequence (false, [Timeout f; fail]) +let timeout f = Wait (fun () -> Lwt.bind (Lwt_unix.sleep f) (fun () -> Lwt.return_false)) -let delay f = Sequence (false, [Timeout f; succeed]) +let delay f = Wait (fun () -> Lwt.bind (Lwt_unix.sleep f) (fun () -> Lwt.return_true)) let do_ act = Do act @@ -89,7 +87,7 @@ let if_ s then_ else_ = If (s, then_, else_) let when_ s t = if_ s t succeed -let while_ s l = Sequence (true, (test_signal s) :: l) +let while_ f l = Sequence (true, (test f) :: l) let sequence ?(loop=false) l = assert (l <> []); @@ -111,170 +109,36 @@ let parallel ?(strat=PSForall) l = let closure f = Closure f -(** {2 Lightweight futures} *) - -module Fut = struct - type 'a t = 'a fut_cell ref - and 'a fut_cell = - | Waiting of ('a -> unit) list - | Done of 'a - - let create () = - let fut = ref (Waiting []) in - let send x = match !fut with - | Done _ -> raise (Invalid_argument "Behavior.Fut.create: future already set") - | Waiting handlers -> - List.iter (fun f -> f x) handlers; - fut := Done x - in - fut, send - - (* add [h] as a handler that waits for [fut] to complete. May call [h] - immediately *) - let subscribe fut h = - match !fut with - | Done x -> h x - | Waiting l -> fut := Waiting (h :: l) - - let is_set fut = match !fut with - | Done _ -> true - | Waiting _ -> false - - let return x = - ref (Done x) - - let bind fut f = - (* result *) - let result, send = create () in - subscribe fut (fun x -> - (* [fut_f] is what [f] returns. When this completes, [result] will - be updated *) - let fut_f = f x in - subscribe fut_f (fun y -> send y)); - result - - let next e = - let res, send = create () in - let ev = React.E.map send (React.E.once e) in - subscribe res (fun _ -> ignore ev); (* keep reference *) - res - - let wait fut = - let res, set = React.S.create None in - subscribe fut (fun x -> set (Some x)); - ignore (React.S.retain res (fun _ -> ignore fut)); (* keep ref *) - res - - let map f fut = - let res, send = create () in - subscribe fut (fun x -> send (f x)); - subscribe res (fun _ -> ignore fut); (* keep ref *) - res - - let first l = - let res, send = create () in - (* is any of the values set? *) - let any_set = ref false in - (try - List.iter - (fun fut -> match !fut with - | Waiting _ -> () - | Done x -> any_set := true; send x; raise Exit) - l - with Exit -> ()); - (* if no element of [l] is already set, add handlers *) - (if not !any_set then - List.iter - (fun fut -> subscribe fut - (fun x -> if not !any_set then (any_set := true; send x))) - l); - res - - let last l = - let res, send = create () in - let count = ref (List.length l) in - List.iter - (fun fut -> subscribe fut - (fun x -> - decr count; - if !count = 0 then send x)) - l; - res - - let filter p l = - let res, send = create () in - let any_ok = ref false in (* any future succeeded? *) - let count = ref (List.length l) in - List.iter - (fun fut -> subscribe fut - (fun x -> - if !any_ok - then () - else if p x - then (any_ok := true; send (Some x)) - else - (decr count; if !count = 0 then send None))) - l; - res - - (** Get value, which must be present *) - let unsafe_get fut = match !fut with - | Waiting _-> assert false - | Done x -> x - - let l2 f a b = - let res, send = create () in - let count = ref 2 in - let compute () = - let y = f (unsafe_get a) (unsafe_get b) in - send y - in - subscribe a (fun _ -> decr count; if !count = 0 then compute ()); - subscribe b (fun _ -> decr count; if !count = 0 then compute ()); - res -end - (** {2 Run a tree} *) -type result = bool Fut.t +type result = bool Lwt.t -let run ?delay tree = - let open React in +let run tree = + let (>>=) = Lwt.(>>=) in (* run given tree *) let rec run tree = match tree with - | Test e -> Fut.next e - | TestFun f -> Fut.return (f ()) - | Wait e -> Fut.next (E.stamp e true) - | Timeout howlong -> - begin match delay with - | None -> failwith "Behavior.run: not delay function provided" - | Some delay -> - let timeout = delay howlong in - Fut.next (E.stamp timeout true) - end - | Do act -> - let b = act () in - Fut.return b - | If (s, then_, else_) -> (* depends on value of signal *) - if S.value s then run then_ else run else_ + | Test f -> Lwt.return (f ()) + | Wait f -> f () + | Do act -> if act () then Lwt.return_true else Lwt.return_false + | If (s, then_, else_) -> (* depends on value returned by [s] *) + if s () then run then_ else run else_ | Sequence (loop, l) -> run_sequence ~loop l | Select (strat, l) -> run_select ~strat l | Parallel (strat, l) -> run_parallel ~strat l | Closure f -> let tree' = f () in run tree' - | Succeed -> Fut.return true - | Fail -> Fut.return false + | Succeed -> Lwt.return_true + | Fail -> Lwt.return_false and run_sequence ~loop start = let rec process l = match l with | [] when loop -> run_sequence ~loop start - | [] -> Fut.return true (* success *) + | [] -> Lwt.return_true (* success *) | t::l' -> let res_t = run t in - Fut.bind res_t - (fun t_succeeded -> - if t_succeeded - then process l' - else Fut.return false) + res_t >>= fun t_succeeded -> + if t_succeeded + then process l' + else Lwt.return_false in process start and run_select ~strat l = @@ -283,27 +147,18 @@ let run ?delay tree = (* try a subtree *) let rec try_one () = match choose () with - | None -> Fut.return false (* failure *) + | None -> Lwt.return_false (* failure *) | Some t -> - let res_t = run t in - Fut.bind res_t - (fun t_succeeded -> if t_succeeded - then Fut.return true - else try_one ()) + run t >>= fun t_succeeded -> + if t_succeeded + then Lwt.return_true + else try_one () in try_one () and run_parallel ~strat l = let results = List.map run l in match strat with - | PSExists -> - let ok = Fut.filter (fun x -> x) results in - Fut.map - (function | None -> false | Some _ -> true) - ok - | PSForall -> - let failed = Fut.filter (fun x -> not x) results in - Fut.map - (function | None -> true | Some _ -> false) - failed + | PSExists -> Lwt_list.exists_p (fun x -> x) results + | PSForall -> Lwt_list.for_all_p (fun x -> x) results in run tree diff --git a/behavior.mli b/behavior.mli index 34c98af3..18903df5 100644 --- a/behavior.mli +++ b/behavior.mli @@ -23,7 +23,7 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** {1 Behavior Trees for React} *) +(** {1 Behavior Trees for Lwt} *) (** Behavior trees are a modular alternative to state machines for controlling dynamic behavior in time. They are primarily used in video games to @@ -40,7 +40,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. sequence will fail. Here, we build them on top of - {{: http://erratique.ch/software/react/doc/React.html} React}. + {{: http://ocsigen.org/lwt/} Lwt}. Documentation source: {{: http://aigamedev.com/open/article/bt-overview/} aigamedev (and links)} @@ -50,12 +50,10 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** A behavior tree *) type tree = private - | Test of bool React.event (* test the next occurrence *) - | TestFun of (unit -> bool) (* call and test value *) - | Wait of unit React.event (* wait for the event to trigger *) - | Timeout of float (* fails after the given timeout *) + | Test of (unit -> bool) (* call and test value *) + | Wait of (unit -> bool Lwt.t) (* wait for the future to complete *) | Do of (unit -> bool) (* perform an action *) - | If of bool React.signal * tree * tree (* switch *) + | If of (unit -> bool) * tree * tree (* switch *) | Sequence of bool * tree list (* yield to subtrees sequentially. bool: loop? *) | Select of select_strategy * tree list (* select one subtree *) | Parallel of parallel_strategy * tree list (* run all subtrees in parallel *) @@ -84,17 +82,16 @@ val succeed : tree val fail : tree (** Behavior that always fails *) -val test : bool React.event -> tree +val test : (unit -> bool) -> tree (** Fails or succeeds based on the next occurrence of the event *) -val test_fun : (unit -> bool) -> tree - (** Tests that the result of calling this function is true *) +val wait : bool Lwt.t -> tree + (** Returns the same result as the future *) -val test_signal : bool React.signal -> tree - (** Fails or succeeds based on the current signal value *) +val wait_ : unit Lwt.t -> tree + (** Wait for the future to complete, then succeed *) -val wait : unit React.event -> tree - (** Wait for the event to trigger, then succeed *) +val wait_closure : (unit -> bool Lwt.t) -> tree val timeout : float -> tree (** Fails after the given amount of seconds *) @@ -108,13 +105,13 @@ val do_ : (unit -> bool) -> tree val do_succeed : (unit -> unit) -> tree (** Perform an action and succeed (unless it raises an exception) *) -val if_ : bool React.signal -> tree -> tree -> tree +val if_ : (unit -> bool) -> tree -> tree -> tree (** Conditional choice, based on the current value of the signal *) -val when_ : bool React.signal -> tree -> tree +val when_ : (unit -> bool) -> tree -> tree (** Run the given tree if the signal is true, else succeed *) -val while_ : bool React.signal -> tree list -> tree +val while_ : (unit -> bool) -> tree list -> tree (** While the signal is true, run the subtrees *) val sequence : ?loop:bool -> tree list -> tree @@ -136,61 +133,10 @@ val parallel : ?strat:parallel_strategy -> tree list -> tree val closure : (unit -> tree) -> tree (** Produce a tree dynamically, at each call. *) -(** {2 Lightweight futures} *) - -module Fut : sig - type 'a t - (** Future value of type 'a *) - - val create : unit -> 'a t * ('a -> unit) - (** Create a future, and a function that sets its value (if already set, - will raise Invalid_argument) *) - - val subscribe : 'a t -> ('a -> unit) -> unit - (** Get notified exactly once with the value (maybe right now) *) - - val is_set : 'a t -> bool - (** Value already known? *) - - val return : 'a -> 'a t - (** Monadic return (returns immediately) *) - - val bind : 'a t -> ('a -> 'b t) -> 'b t - (** Monadic bind *) - - val next : 'a React.event -> 'a t - (** Next occurrence of the event *) - - val wait : 'a t -> 'a option React.signal - (** The value of the future (None while it's not set) *) - - val map : ('a -> 'b) -> 'a t -> 'b t - (** Simple map *) - - val first : 'a t list -> 'a t - (** First future of the list to be set (or any that is already - set if at least one is set) *) - - val last : 'a t list -> 'a t - (** Last future to be set (or any if they are all already set) *) - - val filter : ('a -> bool) -> 'a t list -> 'a option t - (** Filters out results that do not satisfy the predicate; returns the - first result that satisfy it, or None *) - - val l2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - (** Binary lift *) -end - (** {2 Run a tree} *) -type result = bool Fut.t +type result = bool Lwt.t -val run : ?delay:(float -> unit React.event) -> - tree -> - result +val run : tree -> result (** Run the tree. It returns a {! result}, which wraps - either true (success) or false (failure). - - [delay] is the function to call to get notified after the given amount of - seconds elapsed. *) + either true (success) or false (failure). *) diff --git a/react_containers.mllib b/lwt_containers.mllib similarity index 100% rename from react_containers.mllib rename to lwt_containers.mllib diff --git a/react_containers.odocl b/lwt_containers.odocl similarity index 100% rename from react_containers.odocl rename to lwt_containers.odocl diff --git a/tests/test_Behavior.ml b/tests/test_Behavior.ml index 34ee3b58..7830655d 100644 --- a/tests/test_Behavior.ml +++ b/tests/test_Behavior.ml @@ -3,12 +3,17 @@ open OUnit module B = Behavior +let lwt_get fut = match Lwt.state fut with + | Lwt.Sleep + | Lwt.Fail _ -> None + | Lwt.Return x -> Some x + let test_do () = let r = ref false in let t = B.do_succeed (fun () -> r := true) in let res = B.run t in OUnit.assert_equal true !r; - OUnit.assert_equal (Some true) (React.S.value (B.Fut.wait res)); + OUnit.assert_equal (Some true) (lwt_get res); () let test_seq () = @@ -18,45 +23,50 @@ let test_seq () = let t = B.sequence [ B.do_ (fun () -> add 3; true); B.do_ (fun () -> add 2; true); - B.test_fun (fun () -> List.length !l = 2); + B.test (fun () -> List.length !l = 2); B.do_ (fun () -> add 1; true); ] in let res = B.run t in OUnit.assert_equal [1;2;3] !l; - OUnit.assert_equal (Some true) (React.S.value (B.Fut.wait res)); + OUnit.assert_equal (Some true) (lwt_get res); () let test_wait () = - let e, send_e = React.E.create () in - let t = B.sequence [B.wait e; B.succeed] in - let signal = B.Fut.wait (B.run t) in - OUnit.assert_equal None (React.S.value signal); - send_e (); - OUnit.assert_equal (Some true) (React.S.value signal); + let e, send_e = Lwt.wait () in + let t = B.run (B.sequence [B.wait_ e; B.succeed]) in + OUnit.assert_equal None (lwt_get t); + Lwt.wakeup send_e (); + OUnit.assert_equal (Some true) (lwt_get t); () let test_parallel () = - let e, send_e = React.E.create () in (* forall fails *) + let e, send_e = Lwt.wait () in let t = B.parallel ~strat:B.PSForall - [ B.sequence [B.wait e; B.succeed]; + [ B.sequence [B.wait_ e; B.succeed]; B.fail ] in - let signal = B.Fut.wait (B.run t) in - OUnit.assert_equal (Some false) (React.S.value signal); - send_e (); - OUnit.assert_equal (Some false) (React.S.value signal); + let t = B.run t in + let res = Lwt_main.run + (let open Lwt in + choose [t; Lwt_unix.sleep 0.1 >>= fun () -> (Lwt.wakeup send_e (); return true)]) + in + OUnit.assert_equal false res; (* exists succeeds *) + let e, send_e = Lwt.wait () in let t = B.parallel ~strat:B.PSExists - [ B.sequence [B.wait e; B.succeed]; + [ B.sequence [B.wait_ e; B.succeed]; B.fail ] in - let signal = B.Fut.wait (B.run t) in - OUnit.assert_equal None (React.S.value signal); - send_e (); - OUnit.assert_equal (Some true) (React.S.value signal); + let t = B.run t in + let res = Lwt_main.run + (let open Lwt in + choose [t; Lwt_unix.sleep 0.1 >>= fun () -> (Lwt.wakeup send_e (); + Lwt_unix.sleep 0.1 >>= (fun () -> return true))]) + in + OUnit.assert_equal true res; ()