aboutsummaryrefslogtreecommitdiff
path: root/src/splay.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2018-01-19 11:24:29 +0100
committerSébastien Dailly <sebastien@chimrod.com>2018-01-25 17:17:15 +0100
commit112ab4b1c396fc2117191297227d8e411f9b9bb3 (patch)
treef6d06ef60c696b43d48e2cd8e2f7f426a03b3706 /src/splay.ml
parent098ac444e731d7674d8910264ae58fb876618a5a (diff)
Better memory management
Diffstat (limited to 'src/splay.ml')
-rw-r--r--src/splay.ml143
1 files changed, 0 insertions, 143 deletions
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