diff --git a/sledge/nonstdlib/ocaml/map.ml b/sledge/nonstdlib/ocaml/map.ml index 479f2646e..9fbcd6c31 100644 --- a/sledge/nonstdlib/ocaml/map.ml +++ b/sledge/nonstdlib/ocaml/map.ml @@ -73,6 +73,45 @@ module Make(Ord: OrderedType) = struct Empty | Node of {l:'a t; v:key; d:'a; r:'a t; h:int} + type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration + + let rec cons_enum m e = + match m with + Empty -> e + | Node {l; v; d; r} -> cons_enum l (More(v, d, r, e)) + + let compare cmp m1 m2 = + let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + let c = Ord.compare v1 v2 in + if c <> 0 then c else + let c = cmp d1 d2 in + if c <> 0 then c else + compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + in compare_aux (cons_enum m1 End) (cons_enum m2 End) + + let equal cmp m1 m2 = + let rec equal_aux e1 e2 = + match (e1, e2) with + (End, End) -> true + | (End, _) -> false + | (_, End) -> false + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> + Ord.compare v1 v2 = 0 && cmp d1 d2 && + equal_aux (cons_enum r1 e1) (cons_enum r2 e2) + in equal_aux (cons_enum m1 End) (cons_enum m2 End) + + let rec bindings_aux accu = function + Empty -> accu + | Node {l; v; d; r} -> bindings_aux ((v, d) :: bindings_aux accu r) l + + let bindings s = + bindings_aux [] s + let height = function Empty -> 0 | Node {h} -> h @@ -449,49 +488,10 @@ module Make(Ord: OrderedType) = struct then (join lt v d rt, concat lf rf) else (concat lt rt, join lf v d rf) - type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration - - let rec cons_enum m e = - match m with - Empty -> e - | Node {l; v; d; r} -> cons_enum l (More(v, d, r, e)) - - let compare cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - let c = Ord.compare v1 v2 in - if c <> 0 then c else - let c = cmp d1 d2 in - if c <> 0 then c else - compare_aux (cons_enum r1 e1) (cons_enum r2 e2) - in compare_aux (cons_enum m1 End) (cons_enum m2 End) - - let equal cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - Ord.compare v1 v2 = 0 && cmp d1 d2 && - equal_aux (cons_enum r1 e1) (cons_enum r2 e2) - in equal_aux (cons_enum m1 End) (cons_enum m2 End) - let rec cardinal = function Empty -> 0 | Node {l; r} -> cardinal l + 1 + cardinal r - let rec bindings_aux accu = function - Empty -> accu - | Node {l; v; d; r} -> bindings_aux ((v, d) :: bindings_aux accu r) l - - let bindings s = - bindings_aux [] s - let choose = min_binding let choose_opt = min_binding_opt diff --git a/sledge/nonstdlib/ocaml/set.ml b/sledge/nonstdlib/ocaml/set.ml index d8b8a4595..161876893 100644 --- a/sledge/nonstdlib/ocaml/set.ml +++ b/sledge/nonstdlib/ocaml/set.ml @@ -76,6 +76,37 @@ module Make(Ord: OrderedType) = (* Sets are represented by balanced binary trees (the heights of the children differ by at most 2 *) + type enumeration = End | More of elt * t * enumeration + + let rec cons_enum s e = + match s with + Empty -> e + | Node{l; v; r} -> cons_enum l (More(v, r, e)) + + let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, r1, e1), More(v2, r2, e2)) -> + let c = Ord.compare v1 v2 in + if c <> 0 + then c + else compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + + let compare s1 s2 = + compare_aux (cons_enum s1 End) (cons_enum s2 End) + + let equal s1 s2 = + compare s1 s2 = 0 + + let rec elements_aux accu = function + Empty -> accu + | Node{l; v; r} -> elements_aux (v :: elements_aux accu r) l + + let elements s = + elements_aux [] s + let height = function Empty -> 0 | Node {h} -> h @@ -90,6 +121,27 @@ module Make(Ord: OrderedType) = let hr = match r with Empty -> 0 | Node {h} -> h in Node{l; v; r; h=(if hl >= hr then hl + 1 else hr + 1)} + let of_sorted_list l = + let rec sub n l = + match n, l with + | 0, l -> Empty, l + | 1, x0 :: l -> Node {l=Empty; v=x0; r=Empty; h=1}, l + | 2, x0 :: x1 :: l -> + Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; r=Empty; h=2}, l + | 3, x0 :: x1 :: x2 :: l -> + Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; + r=Node{l=Empty; v=x2; r=Empty; h=1}; h=2}, l + | n, l -> + let nl = n / 2 in + let left, l = sub nl l in + match l with + | [] -> assert false + | mid :: l -> + let right, l = sub (n - nl - 1) l in + create left mid right, l + in + fst (sub (List.length l) l) + (* Same as create, but performs one step of rebalancing if necessary. Assumes l and r balanced and | height l - height r | <= 3. Inline expansion of create for better speed in the most frequent case @@ -333,30 +385,6 @@ module Make(Ord: OrderedType) = | (l2, true, r2) -> concat (diff l1 l2) (diff r1 r2) - type enumeration = End | More of elt * t * enumeration - - let rec cons_enum s e = - match s with - Empty -> e - | Node{l; v; r} -> cons_enum l (More(v, r, e)) - - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, r1, e1), More(v2, r2, e2)) -> - let c = Ord.compare v1 v2 in - if c <> 0 - then c - else compare_aux (cons_enum r1 e1) (cons_enum r2 e2) - - let compare s1 s2 = - compare_aux (cons_enum s1 End) (cons_enum s2 End) - - let equal s1 s2 = - compare s1 s2 = 0 - let rec subset s1 s2 = match (s1, s2) with Empty, _ -> @@ -415,13 +443,6 @@ module Make(Ord: OrderedType) = Empty -> 0 | Node{l; r} -> cardinal l + 1 + cardinal r - let rec elements_aux accu = function - Empty -> accu - | Node{l; v; r} -> elements_aux (v :: elements_aux accu r) l - - let elements s = - elements_aux [] s - let choose = min_elt let choose_opt = min_elt_opt @@ -552,27 +573,6 @@ module Make(Ord: OrderedType) = try_concat l' r' end - let of_sorted_list l = - let rec sub n l = - match n, l with - | 0, l -> Empty, l - | 1, x0 :: l -> Node {l=Empty; v=x0; r=Empty; h=1}, l - | 2, x0 :: x1 :: l -> - Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; r=Empty; h=2}, l - | 3, x0 :: x1 :: x2 :: l -> - Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; - r=Node{l=Empty; v=x2; r=Empty; h=1}; h=2}, l - | n, l -> - let nl = n / 2 in - let left, l = sub nl l in - match l with - | [] -> assert false - | mid :: l -> - let right, l = sub (n - nl - 1) l in - create left mid right, l - in - fst (sub (List.length l) l) - let of_list l = match l with | [] -> empty