ocaml/utils/tbl.ml

85 lines
2.4 KiB
OCaml

(***********************************************************************)
(* *)
(* Caml Special Light *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1995 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
type ('a, 'b) t =
Empty
| Node of ('a, 'b) t * 'a * 'b * ('a, 'b) t * int
let empty = Empty
let height = function
Empty -> 0
| Node(_,_,_,_,h) -> h
let new l x d r =
let hl = height l and hr = height r in
Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
let bal l x d r =
let hl = height l and hr = height r in
if hl > hr + 1 then
let (Node(ll, lv, ld, lr, _)) = l in
if height ll >= height lr then
new ll lv ld (new lr x d r)
else
let (Node(lrl, lrv, lrd, lrr, _)) = lr in
new (new ll lv ld lrl) lrv lrd (new lrr x d r)
else if hr > hl + 1 then
let (Node(rl, rv, rd, rr, _)) = r in
if height rr >= height rl then
new (new l x d rl) rv rd rr
else
let (Node(rll, rlv, rld, rlr, _)) = rl in
new (new l x d rll) rlv rld (new rlr rv rd rr)
else
new l x d r
let rec add x data = function
Empty ->
Node(Empty, x, data, Empty, 1)
| Node(l, v, d, r, h) as t ->
let c = compare x v in
if c = 0 then
Node(l, x, data, r, h)
else if c < 0 then
bal (add x data l) v d r
else
bal l v d (add x data r)
let rec find x = function
Empty ->
raise Not_found
| Node(l, v, d, r, _) ->
let c = compare x v in
if c = 0 then d
else find x (if c < 0 then l else r)
let rec iter f = function
Empty -> ()
| Node(l, v, d, r, _) ->
iter f l; f v d; iter f r
open Format
let print print_key print_data tbl =
open_hvbox 2;
print_string "[[";
iter (fun k d ->
open_hovbox 2;
print_key k; print_string " ->"; print_space();
print_data d; print_string ";";
close_box(); print_space())
tbl;
print_string "]]";
close_box()