From 78ff35154b810adbd3da749e650bffb404cd43a9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 15 Dec 2014 10:43:09 +0100 Subject: [PATCH] removed useless Lwt-related module --- README.md | 7 +- _oasis | 12 +-- lwt/behavior.ml | 164 ------------------------------------- lwt/behavior.mli | 142 -------------------------------- tests/lwt/test_Behavior.ml | 79 ------------------ 5 files changed, 3 insertions(+), 401 deletions(-) delete mode 100644 lwt/behavior.ml delete mode 100644 lwt/behavior.mli delete mode 100644 tests/lwt/test_Behavior.ml diff --git a/README.md b/README.md index 7483271d..399654a5 100644 --- a/README.md +++ b/README.md @@ -169,12 +169,7 @@ access to elements by their index. - `Future`, a set of tools for preemptive threading, including a thread pool, monadic futures, and MVars (concurrent boxes) -Some serialisation formats are also implemented, with a streaming, non-blocking -interface that allows the user to feed the input in chunk by chunk (useful -in combination with Lwt/Async). Currently, the modules are: - -- `Bencode`, for the [B-encode format](http://en.wikipedia.org/wiki/Bencode), -- `Sexp`, for S-expressions. +- `containers.lwt` contains [Lwt](http://ocsigen.org/lwt/)-related modules (experimental) There is a QuickCheck-like library called `QCheck` (now in its own repo). diff --git a/_oasis b/_oasis index 5353aa5a..8d94fed6 100644 --- a/_oasis +++ b/_oasis @@ -120,13 +120,13 @@ Library "containers_thread" Library "containers_lwt" Path: lwt - Modules: Behavior, Lwt_automaton, Lwt_actor + Modules: Lwt_automaton, Lwt_actor Pack: true FindlibName: lwt FindlibParent: containers Build$: flag(lwt) && flag(misc) Install$: flag(lwt) && flag(misc) - BuildDepends: containers, lwt, lwt.unix, containers.misc + BuildDepends: containers, lwt, containers.misc Library "containers_cgi" Path: cgi @@ -185,14 +185,6 @@ Executable test_levenshtein MainIs: test_levenshtein.ml BuildDepends: containers,qcheck,containers.string -Executable test_lwt - Path: tests/lwt/ - Install: false - CompiledObject: best - Build$: flag(tests) && flag(lwt) - MainIs: test_Behavior.ml - BuildDepends: containers,lwt,lwt.unix,oUnit,containers.lwt - Executable test_threads Path: tests/lwt/ Install: false diff --git a/lwt/behavior.ml b/lwt/behavior.ml deleted file mode 100644 index dbf1e168..00000000 --- a/lwt/behavior.ml +++ /dev/null @@ -1,164 +0,0 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -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} *) - -(** {2 Behavior tree} *) - -type tree = - | 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 (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 (* 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 - decides to fail *) -and parallel_strategy = - | PSForall (** succeeds when all subtrees succeed *) - | PSExists (** succeeds when some subtree succeeds *) - -let strategy_inorder l = - let cur = ref l in - fun () -> match !cur with - | [] -> None - | t::l' -> - cur := l'; - Some t - -let strategy_random ?(proba_fail=0.05) l = - let a = Array.of_list l in - fun () -> - if Random.float 1. < proba_fail - then None - else (* choose in array *) - let t = a.(Random.int (Array.length a)) in - Some t - -let succeed = Succeed - -let fail = Fail - -let test f = Test f - -let wait fut = Wait (fun () -> fut) - -let wait_ fut = Wait (fun () -> Lwt.bind fut (fun () -> Lwt.return_true)) - -let wait_closure f = Wait f - -let timeout f = Wait (fun () -> Lwt.bind (Lwt_unix.sleep f) (fun () -> Lwt.return_false)) - -let delay f = Wait (fun () -> Lwt.bind (Lwt_unix.sleep f) (fun () -> Lwt.return_true)) - -let do_ act = Do act - -let do_succeed act = Do (fun () -> act (); true) - -let if_ s then_ else_ = If (s, then_, else_) - -let when_ s t = if_ s t succeed - -let while_ f l = Sequence (true, (test f) :: l) - -let sequence ?(loop=false) l = - assert (l <> []); - Sequence (loop, l) - -let repeat t = sequence ~loop:true [t] - -let select ?(strat=strategy_inorder) l = - assert (l <> []); - Select (strat, l) - -let or_else t1 t2 = - select ~strat:strategy_inorder [t1; t2] - -let parallel ?(strat=PSForall) l = - assert (l <> []); - Parallel (strat, l) - -let closure f = - Closure f - -(** {2 Run a tree} *) - -type result = bool Lwt.t - -let run tree = - let (>>=) = Lwt.(>>=) in - (* run given tree *) - let rec run tree = - match tree with - | 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 -> 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 - | [] -> Lwt.return_true (* success *) - | t::l' -> - let res_t = run t in - res_t >>= fun t_succeeded -> - if t_succeeded - then process l' - else Lwt.return_false - in - process start - and run_select ~strat l = - (* choice function *) - let choose = strat l in - (* try a subtree *) - let rec try_one () = - match choose () with - | None -> Lwt.return_false (* failure *) - | Some t -> - 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 -> Lwt_list.exists_p (fun x -> x) results - | PSForall -> Lwt_list.for_all_p (fun x -> x) results - in - run tree diff --git a/lwt/behavior.mli b/lwt/behavior.mli deleted file mode 100644 index 18903df5..00000000 --- a/lwt/behavior.mli +++ /dev/null @@ -1,142 +0,0 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -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 Lwt} *) - -(** Behavior trees are a modular alternative to state machines for controlling - dynamic behavior in time. They are primarily used in video games to - implement non-player AI. - - A tree is composed of basic actions, basic tests, and combinators. During - execution, some subset of the nodes of a tree may be {b running}; at some - point the execution of a given node will terminate with either - {b success} or {b failure}. Depending on the kind of node, this result - may propagate to parent nodes, or set other nodes running. - - For instance, a {i sequence} node runs its subtrees one by one. If a - subtree succeeds, the next one is activated; if it fails, the whole - sequence will fail. - - Here, we build them on top of - {{: http://ocsigen.org/lwt/} Lwt}. - - Documentation source: - {{: http://aigamedev.com/open/article/bt-overview/} aigamedev (and links)} -*) - -(** {2 Behavior tree} *) - -(** A behavior tree *) -type tree = private - | 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 (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 (* always succeed *) - | Fail (* always fail *) - -and select_strategy = tree list -> (unit -> tree option) - (** How to select a subtree to run. It may yield a different result each - time it is called. *) - -and parallel_strategy = - | PSForall (** succeeds when all subtrees succeed *) - | PSExists (** succeeds when some subtree succeeds (kill the others) *) - -val strategy_inorder : select_strategy - (** Select subnodes one after the other, then fails *) - -val strategy_random : ?proba_fail:float -> select_strategy - (** Randomly chooses a subtree. May fail at each point with - a probability of [proba_fail]. *) - -val succeed : tree - (** Behavior that always succeeds *) - -val fail : tree - (** Behavior that always fails *) - -val test : (unit -> bool) -> tree - (** Fails or succeeds based on the next occurrence of the event *) - -val wait : bool Lwt.t -> tree - (** Returns the same result as the future *) - -val wait_ : unit Lwt.t -> tree - (** Wait for the future to complete, then succeed *) - -val wait_closure : (unit -> bool Lwt.t) -> tree - -val timeout : float -> tree - (** Fails after the given amount of seconds *) - -val delay : float -> tree - (** Wait for the given amount of seconds, then succeed *) - -val do_ : (unit -> bool) -> tree - (** Perform an action, then succeed iff it returned true *) - -val do_succeed : (unit -> unit) -> tree - (** Perform an action and succeed (unless it raises an exception) *) - -val if_ : (unit -> bool) -> tree -> tree -> tree - (** Conditional choice, based on the current value of the signal *) - -val when_ : (unit -> bool) -> tree -> tree - (** Run the given tree if the signal is true, else succeed *) - -val while_ : (unit -> bool) -> tree list -> tree - (** While the signal is true, run the subtrees *) - -val sequence : ?loop:bool -> tree list -> tree - (** Sequence of sub-trees to run *) - -val repeat : tree -> tree - (** Repeat the same tree indefinitely *) - -val select : ?strat:select_strategy -> tree list -> tree - (** Choice among the subtrees. The strategy defines in which order subtrees - are tried. *) - -val or_else : tree -> tree -> tree - (** Binary choice, favoring the left one *) - -val parallel : ?strat:parallel_strategy -> tree list -> tree - (** Run subtrees in parallel (default strat: PSForall) *) - -val closure : (unit -> tree) -> tree - (** Produce a tree dynamically, at each call. *) - -(** {2 Run a tree} *) - -type result = bool Lwt.t - -val run : tree -> result - (** Run the tree. It returns a {! result}, which wraps - either true (success) or false (failure). *) diff --git a/tests/lwt/test_Behavior.ml b/tests/lwt/test_Behavior.ml deleted file mode 100644 index 7830655d..00000000 --- a/tests/lwt/test_Behavior.ml +++ /dev/null @@ -1,79 +0,0 @@ - -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) (lwt_get res); - () - -let test_seq () = - let l = ref [] in - (* add int to [l] *) - let add x = l := x :: !l in - let t = B.sequence - [ B.do_ (fun () -> add 3; true); - B.do_ (fun () -> add 2; true); - 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) (lwt_get res); - () - -let test_wait () = - 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 () = - (* forall fails *) - let e, send_e = Lwt.wait () in - let t = - B.parallel ~strat:B.PSForall - [ B.sequence [B.wait_ e; B.succeed]; - B.fail - ] in - 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.fail - ] in - 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; - () - - -let suite = - "test_behavior" >::: - [ "test_do" >:: test_do; - "test_seq" >:: test_seq; - "test_wait" >:: test_wait; - "test_parallel" >:: test_parallel; - ]