1 files changed, 7 insertions, 97 deletions
diff --git a/src/tools.ml b/src/tools.ml
index 7f500bf..8481d59 100755
--- a/src/tools.ml
+++ b/src/tools.ml
@@ -298,101 +298,11 @@ module ArrayMap(Ord: COMPARABLE_TYPE) = struct
 
 end
 
-(** Map for any comparable value.
-    This map can bind 'a key -> 'a value as long as the key are comparable.
- *)
-module Map(Ord: COMPARABLE_TYPE) = struct
-
-  type 'a key = 'a Ord.t
-
-  type wrapper = Ex: 'a key * 'a -> wrapper
-
-  type t =
-    | Empty : t
-    | Node : t * 'a key * 'a * t * int -> t
-
-  let singleton x d = Node(Empty, x, d, Empty, 1)
-
-  let empty = Empty
-
-  let is_empty = function
-    | Empty -> true
-    | _ -> false
-
-  let height = function
-    | Empty -> 0
-    | Node(_,_,_,_,h) -> h
-
-  let create l x d r =
-    let hl = height l and hr = height r in
-    Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
-
-  let bal l x d r =
-    let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
-    let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
-    if hl > hr + 2 then begin
-      match l with
-        Empty -> invalid_arg "Map.bal"
-      | Node(ll, lv, ld, lr, _) ->
-          if height ll >= height lr then
-            create ll lv ld (create lr x d r)
-          else begin
-            match lr with
-              Empty -> invalid_arg "Map.bal"
-            | Node(lrl, lrv, lrd, lrr, _)->
-                create (create ll lv ld lrl) lrv lrd (create lrr x d r)
-          end
-    end else if hr > hl + 2 then begin
-      match r with
-        Empty -> invalid_arg "Map.bal"
-      | Node(rl, rv, rd, rr, _) ->
-          if height rr >= height rl then
-            create (create l x d rl) rv rd rr
-          else begin
-            match rl with
-              Empty -> invalid_arg "Map.bal"
-            | Node(rll, rlv, rld, rlr, _) ->
-                create (create l x d rll) rlv rld (create rlr rv rd rr)
-          end
-    end else
-      Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
-
-
-  let rec add: type a. a key -> a -> t -> t = begin fun x data t -> match t with
-    | Empty -> Node(Empty, x, data, Empty, 1)
-    | Node(l, v, d, r, h) ->
-        match Ord.comp x v with
-        | Eq -> Node(l, x, data, r, h)
-        | Lt -> bal (add x data l) v d r
-        | Gt -> bal l v d (add x data r)
-  end
-
-  let rec find: type a. a key -> t -> a = begin fun x t -> match t with
-    | Empty -> raise Not_found
-    | Node(l, k, v, r, _) ->
-        match Ord.comp x k with
-        | Eq -> v
-        | Lt -> find x l
-        | Gt -> find x r
-  end
+let fold_for f a b init =
+  let rec _fold res i = begin
+  if i >= b then res
+  else
+    _fold (f i res) (i + 1)
+  end in
+  (_fold[@tailcall]) init a
 
-  let rec mem: type a. a key -> t -> bool = begin fun  x t -> match t with
-    | Empty -> false
-    | Node(l, k, v, r, _) ->
-        match Ord.comp x k with
-        | Eq -> true
-        | Lt -> mem x l
-        | Gt -> mem x r
-  end
-
-  (*
-  let rec fold: ('a -> wrapper -> 'a) -> 'a -> t -> 'a =
-  begin fun f init t -> match t with
-  | Empty -> init
-  | Node(l, k, v, r, _) ->
-      let res_left = fold f init l in
-      let result = f res_left @@ Ex (k, v) in
-      fold f result r
-  end
-  *)
-end