(* * PMap - Polymorphic maps * Copyright (C) 1996-2003 Xavier Leroy, Nicolas Cannasse, Markus Mottl * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version, * with the special exception on linking described in file LICENSE. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type ('k, 'v) map = | Empty | Node of ('k, 'v) map * 'k * 'v * ('k, 'v) map * int type ('k, 'v) t = { cmp : 'k -> 'k -> int; map : ('k, 'v) map; } let height = function | Node (_, _, _, _, h) -> h | Empty -> 0 let make l k v r = Node (l, k, v, r, max (height l) (height r) + 1) let bal l k v r = let hl = height l in let hr = height r in if hl > hr + 2 then match l with | Node (ll, lk, lv, lr, _) -> if height ll >= height lr then make ll lk lv (make lr k v r) else (match lr with | Node (lrl, lrk, lrv, lrr, _) -> make (make ll lk lv lrl) lrk lrv (make lrr k v r) | Empty -> assert false) | Empty -> assert false else if hr > hl + 2 then match r with | Node (rl, rk, rv, rr, _) -> if height rr >= height rl then make (make l k v rl) rk rv rr else (match rl with | Node (rll, rlk, rlv, rlr, _) -> make (make l k v rll) rlk rlv (make rlr rk rv rr) | Empty -> assert false) | Empty -> assert false else Node (l, k, v, r, max hl hr + 1) let find_min x = let rec loop = function | Node (Empty, k, v, _, _) -> (k, v) | Node (l, _, _, _, _) -> loop l | Empty -> raise Not_found in loop x.map let rec delete_find_min' = function | Node (Empty, k, v, r, _) -> ((k,v),r) | Node (l, k, v, r, _) -> let (b,l') = delete_find_min' l in (b,bal l' k v r) | Empty -> invalid_arg "PMap.delete_find_min" let delete_find_min x = let (b,t) = delete_find_min' x.map in (b, {cmp = x.cmp; map = t}) let rec delete_find_max' = function | Node (l, k, v, Empty, _) -> ((k,v),l) | Node (l, k, v, r, _) -> let (b,r') = delete_find_max' r in (b,bal l k v r') | Empty -> invalid_arg "PMap.delete_find_max" let delete_find_max x = let (b,t) = delete_find_max' x.map in (b, {cmp = x.cmp; map = t}) let merge t1 t2 = match t1, t2 with | Empty, _ -> t2 | _, Empty -> t1 | _ -> let ((k,v),t2') = delete_find_min' t2 in bal t1 k v t2' let create cmp = { cmp = cmp; map = Empty } let empty = { cmp = compare; map = Empty } let is_empty x = x.map = Empty let add x d { cmp = cmp; map = map } = let rec loop = function | Node (l, k, v, r, h) -> let c = cmp x k in if c = 0 then Node (l, x, d, r, h) else if c < 0 then let nl = loop l in bal nl k v r else let nr = loop r in bal l k v nr | Empty -> Node (Empty, x, d, Empty, 1) in { cmp = cmp; map = loop map } let insert_with f x d { cmp = cmp; map = map } = let rec loop = function | Node (l, k, v, r, h) -> let c = cmp x k in if c = 0 then Node (l, x, f d v, r, h) else if c < 0 then let nl = loop l in bal nl k v r else let nr = loop r in bal l k v nr | Empty -> Node (Empty, x, d, Empty, 1) in { cmp = cmp; map = loop map } let find x { cmp = cmp; map = map } = let rec loop = function | Node (l, k, v, r, _) -> let c = cmp x k in if c < 0 then loop l else if c > 0 then loop r else v | Empty -> raise Not_found in loop map let remove x { cmp = cmp; map = map } = let rec loop = function | Node (l, k, v, r, _) -> let c = cmp x k in if c = 0 then merge l r else if c < 0 then bal (loop l) k v r else bal l k v (loop r) | Empty -> Empty in { cmp = cmp; map = loop map } let mem x { cmp = cmp; map = map } = let rec loop = function | Node (l, k, v, r, _) -> let c = cmp x k in c = 0 || loop (if c < 0 then l else r) | Empty -> false in loop map let exists = mem let iter f { map = map } = let rec loop = function | Empty -> () | Node (l, k, v, r, _) -> loop l; f k v; loop r in loop map let map f { cmp = cmp; map = map } = let rec loop = function | Empty -> Empty | Node (l, k, v, r, h) -> let l = loop l in let r = loop r in Node (l, k, f v, r, h) in { cmp = cmp; map = loop map } let mapi f { cmp = cmp; map = map } = let rec loop = function | Empty -> Empty | Node (l, k, v, r, h) -> let l = loop l in let r = loop r in Node (l, k, f k v, r, h) in { cmp = cmp; map = loop map } let fold f { cmp = cmp; map = map } acc = let rec loop acc = function | Empty -> acc | Node (l, k, v, r, _) -> loop (f v (loop acc l)) r in loop acc map let foldi f { cmp = cmp; map = map } acc = let rec loop acc = function | Empty -> acc | Node (l, k, v, r, _) -> loop (f k v (loop acc l)) r in loop acc map (* We don't need enum let rec enum m = let rec make l = let l = ref l in let rec next() = match !l with | [] -> raise Enum.No_more_elements | Empty :: tl -> l := tl; next() | Node (m1, key, data, m2, h) :: tl -> l := m1 :: m2 :: tl; (key, data) in let count() = let n = ref 0 in let r = !l in try while true do ignore (next()); incr n done; assert false with Enum.No_more_elements -> l := r; !n in let clone() = make !l in Enum.make ~next ~count ~clone in make [m.map] let uncurry_add (k, v) m = add k v m let of_enum ?(cmp = compare) e = Enum.fold uncurry_add (create cmp) e *)