# HG changeset patch # User Roman Sokolov # Date 1278961894 -14400 # Node ID ff72a56953ea33e16a79f954535cf0583c3d8bba # Parent 495c553f0c3c50abddb0c07f91af5ba8ccfd3240 exercises from 3 chapter about btrees diff --git a/.hgignore b/.hgignore --- a/.hgignore +++ b/.hgignore @@ -0,0 +1,6 @@ +syntax: glob + +*.out +*.cmo +*.cmi +*~ diff --git a/btrees.ml b/btrees.ml new file mode 100644 --- /dev/null +++ b/btrees.ml @@ -0,0 +1,59 @@ + +(* pipelining *) +let ( |> ) x f = f x +let ( <| ) f x = f x +(* composition *) +let ( << ) f g x = f (g x) +let ( >> ) f g x = g (f x) +(* `right currying` *) +let flip f x y = f y x + +module type SET = +sig + type elem + type set + + val empty : set + val insert : elem -> set -> set + val member : elem -> set -> bool +end + + +module type ORDERED = +sig + type t + + val eq : t -> t -> bool + val lt : t -> t -> bool + val leq : t -> t -> bool +end + + +module UnbalancedSet = + functor (Element: ORDERED) -> + struct + type elem = Element.t + type tree = E | T of (tree * elem * tree) + type set = tree + + let empty = E + + let rec insert x = function + | E -> T (E, x, E) + | T (a, y, b) when (Element.lt x y) -> + T (insert x a, y, b) + | T (a, y, b) when (Element.lt y x) -> + T (a, y, insert x b) + | s -> s + + let rec member x = function + | E -> false + | T (a, y, b) when (Element.lt x y) -> + member x a + | T (a, y, b) when (Element.lt y x) -> + member x b + | _ -> true + + end : SET + +