From 112ab4b1c396fc2117191297227d8e411f9b9bb3 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 19 Jan 2018 11:24:29 +0100
Subject: Better memory management

---
 src/splay.ml | 143 -----------------------------------------------------------
 1 file changed, 143 deletions(-)
 delete mode 100644 src/splay.ml

(limited to 'src/splay.ml')

diff --git a/src/splay.ml b/src/splay.ml
deleted file mode 100644
index 4bbc3dd..0000000
--- a/src/splay.ml
+++ /dev/null
@@ -1,143 +0,0 @@
-module type KEY = sig
-
-  type 'a t
-
-  (** Parametrized comparator *)
-  val comp: 'a t -> 'b t -> ('a, 'b) Tools.cmp
-
-  val repr: Format.formatter -> 'a t -> unit
-
-end
-
-module Make (El : KEY) = struct
-
-  type 'a elem = 'a El.t
-
-  type leaf (** Fantom type for typing the tree *)
-  type node (** Fantom type for typing the tree *)
-
-  type 'a treeVal =
-    | Leaf : leaf treeVal
-    | Node : _ treeVal * ('a elem * 'a) * _ treeVal -> node treeVal
-
-  type t = T : 'a treeVal ref -> t [@@unboxed]
-
-  let empty = T (ref Leaf)
-
-  let isEmpty (T tree) = match !tree with
-    | Leaf -> true
-    | _ -> false
-
-  let rec splay : type a. a elem -> node treeVal -> node treeVal = fun x t -> begin
-    let Node (l, y, r) = t in
-    begin match El.comp x (fst y)  with
-      | Tools.Eq -> t
-      | Tools.Lt ->
-        begin match l with
-          | Leaf -> t
-          | Node (ll, z, rr) ->
-            begin match El.comp x (fst z)  with
-              | Tools.Eq -> Node (ll, z, Node (rr, y, r))
-              | Tools.Lt ->
-                begin match ll with
-                  | Leaf -> Node (ll, z, Node (rr, y, r))
-                  | Node _ as ll ->
-                    let Node (newL, newV, newR) = splay x ll
-                    in Node (newL, newV, Node (newR, z, Node (rr, y, r)))
-                end
-              | Tools.Gt ->
-                begin match rr with
-                  | Leaf -> Node (ll, z, Node (rr, y, r))
-                  | Node _ as rr ->
-                    let Node (newL, newV, newR) = splay x rr
-                    in Node (Node (ll, z, newL), newV, Node (newR, y, r))
-                end
-            end
-        end
-      | Tools.Gt ->
-        begin match r with
-          | Leaf -> t
-          | Node (ll, z, rr) ->
-            begin match El.comp x (fst z)  with
-              | Tools.Eq -> Node (Node (l, y, ll), z, rr)
-              | Tools.Lt ->
-                begin match ll with
-                  | Leaf -> Node (Node (l, y, ll), z, rr)
-                  | Node _ as ll ->
-                    let Node (newL, newV, newR) = splay x ll
-                    in Node (Node (l, y, newL), newV, Node (newR, z, rr))
-                end
-              | Tools.Gt ->
-                begin match rr with
-                  | Leaf -> Node (Node (l, y, ll), z, rr)
-                  | Node _ as rr ->
-                    let Node (newL, newV, newR) = splay x rr
-                    in Node (Node (Node(l, y, ll), z, newL), newV, newR)
-                end
-            end
-        end
-    end
-  end
-
-  let member: type a. a elem -> t -> bool = fun x (T t) -> match !t with
-    | Leaf -> false
-    | Node _ as root ->
-        let root' = splay x root in
-        t := root';
-        let Node (_, c', _) = root' in
-        begin match El.comp (fst c') x  with
-          | Tools.Eq -> true
-          | _ -> false
-        end
-
-  let find: type a. a elem -> t -> a = fun x (T t) -> match !t with
-    | Leaf -> raise Not_found
-    | Node _ as root ->
-        let root' = splay x root in
-        t := root';
-        let Node (_, c', _) = root' in
-        begin match El.comp (fst c') x with
-          | Tools.Eq -> snd c'
-          | _ -> raise Not_found
-        end
-
-  let add: type a. a elem -> a -> t -> t = fun key value (T t) -> match !t with
-    | Leaf -> T (ref (Node (Leaf, (key, value), Leaf)))
-    | Node _ as root ->
-        let root' = splay key root in
-        let Node (l, y, r) = root' in
-        begin match El.comp key (fst y)  with
-          | Tools.Eq -> T (ref root')
-          | Tools.Lt -> T (ref (Node (l, (key, value), Node (Leaf, y, r))))
-          | Tools.Gt -> T (ref (Node (Node (l, y, Leaf), (key, value), r)))
-        end
-
-  let repr formatter (T t) = begin
-
-    let repr_edge from formatter dest = begin
-      Format.fprintf formatter "\"%a\" -> \"%a\"\n"
-        El.repr from
-        El.repr dest
-    end in
-
-    let rec repr': type a b. a El.t -> Format.formatter -> b treeVal -> unit = fun parent formatter -> function
-    | Leaf -> ()
-    | Node (l, c, r) ->
-        let key = fst c in
-        Format.fprintf formatter "%a%a%a"
-        (repr_edge parent) key
-        (repr' key) l
-        (repr' key) r in
-
-    begin match !t with
-    | Leaf -> Format.fprintf formatter "digraph G {}"
-    | Node (l, c, r) ->
-      let key = fst c in
-      Format.fprintf formatter "digraph G {\n%a%a}"
-        (repr' key) l
-        (repr' key) r
-    end
-
-  end
-
-end
-- 
cgit v1.2.3