X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=exercises%2Fch01%2Ftree.ml;fp=exercises%2Fch01%2Ftree.ml;h=7cc7d8cc4bcf92eea8610d8f3ae20ea5f4ed92a0;hb=f76c63f8cff09c1de6619d49e0a761e3bb6c8618;hp=0000000000000000000000000000000000000000;hpb=ba1409d14bb13a8a0d63246fa0323e0dc4a801aa;p=tiger.ml.git

diff --git a/exercises/ch01/tree.ml b/exercises/ch01/tree.ml
new file mode 100644
index 0000000..7cc7d8c
--- /dev/null
+++ b/exercises/ch01/tree.ml
@@ -0,0 +1,42 @@
+module Array = ArrayLabels
+
+module type TREE = sig
+  type 'a t
+
+  val empty : 'a t
+
+  val add : 'a t -> 'a -> 'a t
+
+  val member : 'a t -> 'a -> bool
+end
+
+module BinaryTree : TREE = struct
+  type 'a t =
+    | Node of 'a * 'a t * 'a t
+    | Leaf
+
+  let empty = Leaf
+
+  let rec add t x =
+    match t with
+    | Leaf -> Node (x, Leaf, Leaf)
+    | Node (x', left, right) when x < x' -> Node (x', add left x, right)
+    | Node (x', left, right) when x > x' -> Node (x', left, add right x)
+    | (Node _) as t' -> t'
+
+  let rec member t x =
+    match t with
+    | Leaf -> false
+    | Node (x', left, _) when x < x' -> member left x
+    | Node (x', _, right) when x > x' -> member right x
+    | Node _ -> true
+end
+
+let () =
+  let tree =
+    Array.fold_left
+      (Sys.argv)
+      ~init:BinaryTree.empty
+      ~f:(fun t str -> BinaryTree.add t str)
+  in
+  Printf.printf "%B\n" (BinaryTree.member tree "a")