Commit 1210b07c authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-06-17 15:42:03 by afrisch] Empty log message

Original author: afrisch
Date: 2005-06-17 15:42:04+00:00
parent 171847b1
...@@ -66,26 +66,25 @@ let rec find_aux t (i : int) low high = ...@@ -66,26 +66,25 @@ let rec find_aux t (i : int) low high =
if (low >= high) then low if (low >= high) then low
else else
let m = ((low + high) lsr 1) lor 1 in let m = ((low + high) lsr 1) lor 1 in
if i < get t m then find_aux t i low (m-2) if i < get t m then find_aux t i low (m-2)
else find_aux t i m high else find_aux t i m high
let find (t : 'a t) i : 'a = let find (t : 'a t) i : 'a =
if t == empty then raise Not_found; if t == empty then raise Not_found;
let j = find_aux t i 1 (get t 0) in let j = find_aux t i 1 (get t 0 - 2) in
if (get t j == i) then (Obj.magic get t (succ j)) if (get t j == i) then (Obj.magic get t (succ j))
else raise Not_found else raise Not_found
let find_default t def i = let find_default t def i =
if t == empty then def if t == empty then def
else else
let j = find_aux t i 1 (get t 0) in let j = find_aux t i 1 (get t 0 - 2) in
if (get t j == i) then (Obj.magic get t (succ j)) if (get t j == i) then (Obj.magic get t (succ j))
else def else def
let find_lower (t : 'a t) i : 'a = let find_lower (t : 'a t) i : 'a =
assert (t != empty); Obj.magic get t (succ (find_aux t i 1 (get t 0 - 2)))
Obj.magic get t (succ (find_aux t i 1 (get t 0)))
let merge (t1 : 'a t) (t2 : 'a t) = let merge (t1 : 'a t) (t2 : 'a t) =
if t1 == empty then t2 else if t2 == empty then t1 if t1 == empty then t2 else if t2 == empty then t1
...@@ -192,7 +191,7 @@ let hash f t = ...@@ -192,7 +191,7 @@ let hash f t =
let remove t i = let remove t i =
if t == empty then t if t == empty then t
else else
let j = find_aux t i 1 (get t 0) in let j = find_aux t i 1 (get t 0 - 2) in
if (get t j != i) then t if (get t j != i) then t
else else
let n = get t 0 - 2 in let n = get t 0 - 2 in
......
...@@ -90,19 +90,29 @@ let get_map (ns,x) m = ...@@ -90,19 +90,29 @@ let get_map (ns,x) m =
module IntSet = module IntSet =
Set.Make(struct type t = int let compare (x:int) y = Pervasives.compare x y end) Set.Make(struct type t = int let compare (x:int) y = Pervasives.compare x y end)
let create def l = match def with
| None ->
(match l with (i,x)::rest -> Imap.create_default x (Array.of_list rest)
| [] -> assert false)
| Some d -> Imap.create_default d (Array.of_list l)
let mk_map l = let mk_map l =
let l = List.filter (fun (t,_) -> not (is_empty t)) l in
if l = [] then Imap.empty
else
let all_ns = ref IntSet.empty in let all_ns = ref IntSet.empty in
let def = ref Imap.create in let def = ref None in
List.iter List.iter
(function (s,x) -> (function (s,x) ->
match get s with match get s with
| `Finite s -> | `Finite s ->
List.iter (fun (ns,_) -> all_ns := IntSet.add ns !all_ns) s List.iter (fun (ns,_) -> all_ns := IntSet.add ns !all_ns) s
| `Cofinite _ -> def := Imap.create_default (Imap.create_default x [||]) | `Cofinite _ -> def := Some (Imap.create_default x [||])
) l; ) l;
let one_ns ns = let one_ns ns =
let def = ref Imap.create in let def = ref None in
let t = let t =
List.fold_left List.fold_left
(fun accu (s, y) -> (fun accu (s, y) ->
...@@ -110,18 +120,12 @@ let mk_map l = ...@@ -110,18 +120,12 @@ let mk_map l =
| SymbolSet.Finite syms -> | SymbolSet.Finite syms ->
List.fold_left (fun accu x -> (x,y)::accu) accu syms List.fold_left (fun accu x -> (x,y)::accu) accu syms
| SymbolSet.Cofinite syms -> | SymbolSet.Cofinite syms ->
def := Imap.create_default y; accu) def := Some y; accu)
[] l in [] l in
(!def) (Array.of_list t) create (!def) t
in in
let t = let t =
List.fold_left (fun accu ns -> (ns, one_ns ns)::accu) [] List.fold_left (fun accu ns -> (ns, one_ns ns)::accu) []
(IntSet.elements !all_ns) in (IntSet.elements !all_ns) in
(!def) (Array.of_list t) create (!def) t
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment