| 1 | module List = ListLabels |
| 2 | |
| 3 | type ('k, 'v) t = |
| 4 | | Node of 'k * 'v * ('k, 'v) t * ('k, 'v) t |
| 5 | | Leaf |
| 6 | |
| 7 | let empty = Leaf |
| 8 | |
| 9 | let rec set t ~k ~v = |
| 10 | match t with |
| 11 | | Leaf -> Node (k, v, Leaf, Leaf) |
| 12 | | Node (k', v', l, r) when k < k' -> Node (k', v', set l ~k ~v, r) |
| 13 | | Node (k', v', l, r) when k > k' -> Node (k', v', l, set r ~k ~v) |
| 14 | | Node (k, _, l, r) -> Node (k, v, l, r) |
| 15 | |
| 16 | let rec get t ~k = |
| 17 | match t with |
| 18 | | Leaf -> None |
| 19 | | Node (k', _, l, _) when k < k' -> get l ~k |
| 20 | | Node (k', _, _, r) when k > k' -> get r ~k |
| 21 | | Node (_, v, _, _) -> Some v |
| 22 | |
| 23 | let rec member t ~k = |
| 24 | match t with |
| 25 | | Leaf -> false |
| 26 | | Node (k', _, l, _) when k < k' -> member l ~k |
| 27 | | Node (k', _, _, r) when k > k' -> member r ~k |
| 28 | | Node _ -> true |
| 29 | |
| 30 | let to_edges t = |
| 31 | let rec to_edges_from k1 t = |
| 32 | match t with |
| 33 | | Leaf -> [] |
| 34 | | Node (k2, _, l, r) -> |
| 35 | (k1, k2) :: ((to_edges_from k2 l) @ (to_edges_from k2 r)) |
| 36 | in |
| 37 | match t with |
| 38 | | Leaf -> [] |
| 39 | | Node (k, _, l, r) -> (to_edges_from k l) @ (to_edges_from k r) |
| 40 | |
| 41 | let to_dot t ~k_to_string = |
| 42 | let (edges, _) = |
| 43 | List.fold_left (to_edges t) |
| 44 | ~init:("", "\n") |
| 45 | ~f:(fun (edges, sep) (k1, k2) -> |
| 46 | let k1, k2 = k_to_string k1, k_to_string k2 in |
| 47 | (Printf.sprintf "%s%s %S -> %S;\n" edges sep k1 k2, "") |
| 48 | ) |
| 49 | in |
| 50 | "digraph G {" ^ edges ^ "}" |