From d8b2c9dba18286efc5a5197ccf4e80c3e1a6b975 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= <francois@bobot.eu>
Date: Fri, 18 Jan 2013 14:36:13 +0100
Subject: [PATCH] [Shuffle] move it in util

---
 src/egraph_simple.ml  | 22 +++-------------------
 src/egraph_simple.mli |  3 ---
 src/util/shuffle.ml   | 26 ++++++++++++++++++++++++++
 src/util/shuffle.mli  | 11 +++++++++++
 tests/tests.ml        |  2 +-
 5 files changed, 41 insertions(+), 23 deletions(-)
 create mode 100644 src/util/shuffle.ml
 create mode 100644 src/util/shuffle.mli

diff --git a/src/egraph_simple.ml b/src/egraph_simple.ml
index 45d9f8b78..1ce92c79d 100644
--- a/src/egraph_simple.ml
+++ b/src/egraph_simple.ml
@@ -7,28 +7,12 @@
 *)
 
 open Stdlib
+open Shuffle
 
 let debug = Debug.register_info_flag
   ~desc:"for the simple version of the egraph"
   "egraph_simple"
 
-(** {!shuffle} is used for test. It's used want the swap of two value
-    can give different result
-*)
-let opt_shuffle = ref None
-
-let set_shuffle = function
-  | None -> opt_shuffle := None
-  | Some i -> opt_shuffle := Some (Random.State.make i)
-
-let is_shuffle () = !opt_shuffle <> None
-
-let shuffle ((t1,t2) as p) =
-  match !opt_shuffle with
-  | None -> p
-  | Some rnd when Random.State.bool rnd -> p
-  | _ -> (t2,t1)
-
 module UnionFind (* simple *) :
 sig type t
     val empty: t
@@ -173,7 +157,7 @@ let rec equal_aux queue env t1 t2 =
         end
       else
         begin
-          shuffle (parent, parent')
+          shufflep (parent, parent')
         end
     in
     if p1 != p2 then Queue.push (p1,p2) queue;
@@ -187,7 +171,7 @@ let rec equal_aux queue env t1 t2 =
   end
 
 let equal env t1 t2 =
-  let t1,t2 = shuffle (t1,t2) in
+  let t1,t2 = shufflep (t1,t2) in
   let queue = Queue.create () in
   equal_aux queue env t1 t2
 
diff --git a/src/egraph_simple.mli b/src/egraph_simple.mli
index a955ecae6..979d85711 100644
--- a/src/egraph_simple.mli
+++ b/src/egraph_simple.mli
@@ -1,8 +1,5 @@
 val debug: Debug.flag
 
-val set_shuffle: int array option -> unit
-val is_shuffle: unit -> bool
-
 type env
 
 val empty_env: env
diff --git a/src/util/shuffle.ml b/src/util/shuffle.ml
new file mode 100644
index 000000000..9bdb4b681
--- /dev/null
+++ b/src/util/shuffle.ml
@@ -0,0 +1,26 @@
+(** {!shuffle} is used for test. Used for shuffling input entry *)
+let opt_shuffle = ref None
+
+let set_shuffle = function
+  | None -> opt_shuffle := None
+  | Some i -> opt_shuffle := Some (Random.State.make i)
+
+let is_shuffle () = !opt_shuffle <> None
+
+let shufflep ((t1,t2) as p) =
+  match !opt_shuffle with
+  | None -> p
+  | Some rnd when Random.State.bool rnd -> p
+  | _ -> (t2,t1)
+
+
+let shufflel l =
+  match !opt_shuffle with
+  | None -> l
+  | Some rnd ->
+    let rec aux head tail = function
+      | [] -> List.rev_append head tail
+      | a::l when Random.State.bool rnd -> aux (a::head) tail l
+      | a::l                            -> aux head (a::tail) l in
+    aux [] [] l
+
diff --git a/src/util/shuffle.mli b/src/util/shuffle.mli
new file mode 100644
index 000000000..bf3061791
--- /dev/null
+++ b/src/util/shuffle.mli
@@ -0,0 +1,11 @@
+
+val set_shuffle: int array option -> unit
+(** if None is given shuffling is disable (default) *)
+
+val is_shuffle: unit -> bool
+
+val shufflep: ('a * 'a) -> ('a * 'a)
+(* uniform *)
+
+val shufflel: 'a list -> 'a list
+(* not uniform *)
diff --git a/tests/tests.ml b/tests/tests.ml
index cef2f6767..db9749680 100644
--- a/tests/tests.ml
+++ b/tests/tests.ml
@@ -11,7 +11,7 @@ let rec make_tests acc seed =
   let module Uf = Tests_uf.Tests(Egraph_simple) in
   let test = ((Pp.sprintf "seed %a" print_seed seed) >::: [Uf.tests]) in
   let test = test_decorate
-    (fun f -> (fun () -> Egraph_simple.set_shuffle seed; f ())) test in
+    (fun f -> (fun () -> Shuffle.set_shuffle seed; f ())) test in
   test::acc
 
 let tests =
-- 
GitLab