type 'a t = Obj.t array let empty = Obj.magic () (* [| |] does not ensure physical equality with ocamlopt (?) after deserialization. 0 does not work either: the code generator considers registers set to empty as integer-only registers, which is not safe. *) let get = Array.unsafe_get let set = Array.unsafe_set let get_len a : int = Obj.magic (get a 0) let set_len a (i : int) = set a 0 (Obj.repr i) let get_int a i : int = Obj.magic (get a i) let set_int a (i : int) (x : int) = set a i (Obj.repr x) let acreate n = Array.create n (Obj.repr n) let elements (t : 'a t) : (int * 'a) list = if t == empty then [] else let rec aux accu i = if (i > 0) then aux ((get_int t i, Obj.magic (get t (succ i)))::accu) (i - 2) else accu in aux [] (get_len t - 2) let map_elements f t = if t == empty then [] else let rec aux accu i = if (i > 0) then aux (f (get_int t i) (Obj.magic (get t (succ i)))::accu) (i - 2) else accu in aux [] (get_len t - 2) (* TODO: check that the comparison function is necessarily called on a pair of equal elements if such a pair exist. I guess any sort algorithm must do that! *) exception DuplicateKey let sort a = Array.sort (fun (i,_) (j,_) -> if (i == j) then raise DuplicateKey; if (i:int) < j then (-1) else 1) a let real_create a = let n = Array.length a in let m = (n lsl 1) + 1 in let t = acreate m in for i = 1 to n do let j = i lsl 1 in let (idx,v) = a.(pred i) in set_int t (pred j) idx; set t j (Obj.repr v); done; t let create a = if Array.length a = 0 then empty else (sort a; real_create a) let create_default def a = sort a; let l = Array.to_list a in let rec aux i = function | [] -> if (i == max_int) then [] else [(succ i, def)] | ((i1,_) as c)::rest -> if (succ i == i1) then c :: (aux i1 rest) else (succ i, def) :: c :: (aux i1 rest) in let l = match l with | ((i1,_) as c)::rest -> if (i1 == min_int) then c :: (aux i1 rest) else (min_int,def) :: c :: (aux i1 rest) | [] -> [(min_int,def)] in let a = Array.of_list l in real_create a let rec find_aux t (i : int) low high = if (low >= high) then low else let m = ((low + high) lsr 1) lor 1 in if i < get_int t m then find_aux t i low (m-2) else find_aux t i m high let find (t : 'a t) i : 'a = if t == empty then raise Not_found; let j = find_aux t i 1 (get_len t - 2) in if (get_int t j == i) then Obj.magic (get t (succ j)) else raise Not_found let find_default t def i = if t == empty then def else let j = find_aux t i 1 (get_len t - 2) in if (get_int t j == i) then Obj.magic (get t (succ j)) else def let find_lower (t : 'a t) i : 'a = Obj.magic (get t (succ (find_aux t i 1 (get_len t - 2)))) let merge (t1 : 'a t) (t2 : 'a t) = if t1 == empty then t2 else if t2 == empty then t1 else let n1 = get_len t1 and n2 = get_len t2 in let m = pred (n1 + n2) in let t = acreate m in let rec aux i i1 (l1:int) i2 l2 = if l1 == l2 then (set_int t i l1; set t (succ i) (get t2 (pred i2)); let i = i + 2 in if (i1 = n1) then ( let l = n2 - i2 in Array.blit t2 i2 t i l; i + l ) else if (i2 = n2) then ( let l = n1 - i1 in Array.blit t1 i1 t i l; i + l ) else let l1 = get_int t1 i1 and l2 = get_int t2 i2 in let i1 = i1 + 2 and i2 = i2 + 2 in aux i i1 l1 i2 l2) else if l1 < l2 then (set_int t i l1; set t (succ i) (get t1 (pred i1)); let i = i + 2 in if (i1 = n1) then ( let i2 = i2 - 2 in let l = n2 - i2 in Array.blit t2 i2 t i l; i + l ) else let l1 = get_int t1 i1 in let i1 = i1 + 2 in aux i i1 l1 i2 l2) else (set_int t i l2; set t (succ i) (get t2 (pred i2)); let i = i + 2 in if (i2 = n2) then ( let i1 = i1 - 2 in let l = n1 - i1 in Array.blit t1 i1 t i l; i + l ) else let l2 = get_int t2 i2 in let i2 = i2 + 2 in aux i i1 l1 i2 l2) in set_len t (aux 1 3 (get_int t1 1) 3 (get_int t2 1)); t let cardinal t = if t == empty then 0 else (pred (get_len t)) lsr 1 let map f t = if t == empty then empty else let n = get_len t in let t' = acreate n in Array.blit t 0 t' 0 n; let rec aux i = if (i = 0) then t' else (set t' i (Obj.magic (f (Obj.magic (get t i)))); aux (i - 2)) in aux (pred n) let compare f t1 t2 = if (t1 == t2) then 0 else if t1 == empty then (-1) else if t2 == empty then 1 else let n1 = get_len t1 and n2 = get_len t2 in if (n1 < n2) then (-1) else if (n1 > n2) then 1 else let rec aux i = if (i < 0) then 0 else let l1 = get t1 i and l2 = get t2 i in if (l1 < l2) then (-1) else if (l1 > l2) then 1 else let x1 = Obj.magic (get t1 (succ i)) and x2 = Obj.magic (get t2 (succ i)) in let c = f x1 x2 in if c != 0 then c else aux (i - 2) in aux (n1 - 2) let hash f t = if t == empty then 1 else let rec aux accu i = if (i < 0) then accu else aux (accu * 65537 + 257 * (f (Obj.magic (get t (succ i)))) + (get_int t i)) (i - 2) in aux 1 (get_len t - 2) let remove t i = if t == empty then t else let j = find_aux t i 1 (get_len t - 2) in if (get_int t j != i) then t else let n = get_len t - 2 in if (n = 1) then empty else let t' = acreate n in Array.blit t 1 t' 1 (j - 1); Array.blit t (j + 2) t' j (n - j); t' let iter f t = if t == empty then () else let rec aux i = if (i < 0) then () else f (get_int t i) (Obj.magic (get t (succ i))) in aux (get_len t - 2) (* type 'a t = (int * 'a) list let empty = [] let create a = Array.sort (fun (i,_) (j,_) -> assert (i != j); if i < j then (-1) else 1) a; Array.to_list a let create_default def a = let l = create a in let rec aux i = function | [] -> if (i == max_int) then [] else [(succ i, def)] | ((i1,_) as c)::rest -> if (succ i == i1) then c :: (aux i1 rest) else (succ i, def) :: c :: (aux i1 rest) in let l = match l with | ((i1,_) as c)::rest -> if (i1 == min_int) then c :: (aux i1 rest) else (min_int,def) :: c :: (aux i1 rest) | [] -> [(min_int,def)] in l let merge l1 l2 = assert false let find l x = List.assoc x l let rec find_lower l x = match l with | (_,v)::(y,_)::_ when x < y -> v | _::l -> find_lower l x | [] -> assert false let find_default l def x = try find l x with Not_found -> def let cardinal = List.length let elements l = l let map f l = List.map (fun (x,v) -> (x, f v)) l let map_elements f l = List.map (fun (x,v) -> f x v) l let compare _ _ = assert false let hash _ = assert false let remove _ _ = assert false let iter _ _ = assert false *)