let realloc l old_size new_size dummy =
let l' = Array.create new_size dummy in
- Array.blit l 0 l' 0 (min old_size new_size);
+ for i = 0 to (min old_size new_size) - 1 do
+ l'.(i) <- l.(i);
+ done;
l'
module Lvl1 =
struct
-
type 'a t = { mutable line : 'a array;
- dummy : 'a }
-
- let create n a = { line = Array.create n a;
- dummy = a }
+ dummy : 'a;
+ mutable offset : int;
+ }
+ let create n a = {
+ line = Array.create 0 a;
+ dummy = a;
+ offset = ~-1;
+
+ }
+
+ let print fmt a =
+ Format.fprintf fmt "{ offset=%i;\n dummy=_;line=%a \n}\n%!"
+ a.offset
+ (Pretty.print_array ~sep:", " (fun fmt x ->
+ if x==a.dummy then
+ Format.fprintf fmt "%s" "D"
+ else
+ Format.fprintf fmt "%s" "E")) a.line
+
+ let add a i v =
+ if a.offset == ~-1 then a.offset <- i;
+ let offset = a.offset in
+ let len = Array.length a.line in
+ if i >= offset && i < offset + len then
+ a.line.(i - offset) <- v
+ else
+ if i < offset then begin (* bottom resize *)
+ let pad = offset - i in
+ let nlen = len + pad in
+ let narray = Array.create nlen a.dummy in
+ for j = 0 to len - 1 do
+ narray.(j+pad) <- a.line.(j)
+ done;
+ a.offset <- i;
+ a.line <- narray;
+ narray.(0) <- v;
+ end else begin (* top resize *)
+ (* preventively allocate the space for the following elements *)
+ let nlen = ((i - offset + 1) lsl 1) + 1 in
+ let narray = Array.create nlen a.dummy in
+ for j = 0 to len - 1 do
+ narray.(j) <- a.line.(j);
+ done;
+ narray.(i - offset) <- v;
+ a.line <- narray
+ end
+
+ let find a i =
+ let offset = a.offset in
+ let len = Array.length a.line in
+ if i >= offset && i < offset + len then a.line.(i - offset)
+ else a.dummy
- let find c i =
- let line = c.line in
- let len = Array.length line in
- if i >= len then c.dummy else line.(i)
+ let dummy a = a.dummy
- let add c i v =
- let line = c.line in
- let len = Array.length line in
- if i >= len then c.line <- realloc line len (i*2+1) c.dummy;
- c.line.(i) <- v
+ let iteri f a =
+ let line = a.line in
+ if a.offset == ~-1 then () else
+ for i = 0 to Array.length line - 1 do
+ let v = line.(i) in
+ f (i+a.offset) v (v==a.dummy)
+ done
- let dummy c = c.dummy
- let to_array c = c.line
end
-include Lvl1
+
module Lvl2 =
struct
- type 'a t = { mutable line : 'a array array;
- dummy : 'a;
- l1_size : int;
- dummy_line1 : 'a array
- }
+ type 'a t = 'a Lvl1.t Lvl1.t
+ let create n a =
+ let dummy1 = Lvl1.create 512 a in
+ { Lvl1.line = Array.create n dummy1;
+ Lvl1.offset = ~-1;
+ Lvl1.dummy = dummy1;
+ }
- let dummy_line = [| |]
- let create ?(l1_size=512) n a =
- let dummy_line1 = Array.create l1_size a in
- { line = Array.create n dummy_line1;
- dummy = a;
- l1_size = l1_size;
- dummy_line1 = dummy_line1;
- }
+ let add a i j v =
+ let line = Lvl1.find a i in
+ if line == a.Lvl1.dummy then
+ let nline = Lvl1.create 0 line.Lvl1.dummy in
+ Lvl1.add a i nline;
+ Lvl1.add nline j v
+ else
+ Lvl1.add line j v
+
+
+ let find a i j =
+ let v = Lvl1.find a i in
+ if v == a.Lvl1.dummy then a.Lvl1.dummy.Lvl1.dummy
+ else Lvl1.find v j
+
+
+ let dummy c = c.Lvl1.dummy.Lvl1.dummy
+
+ let iteri f a =
+ let line = a.Lvl1.line in
+ if a.Lvl1.offset == ~-1 then () else
+ for i = 0 to Array.length line - 1 do
+ Lvl1.iteri (f i) line.(i)
+ done
+
- let find c i j = c.line.(i).(j)
-
- let add c i j v =
- let line = c.line in
- let len = Array.length line in
- if i >= len then
- c.line <- realloc line len (i*2 + 1) c.dummy_line1;
- let line = c.line.(i) in
- let line =
- if line == c.dummy_line1 then
- let nline = Array.copy line in
- c.line.(i) <- nline;
- nline
- else line
- in
- line.(j) <- v
-
- let dummy c = c.dummy
- let to_array c = c.line
- let dummy_line c = c.dummy_line1
end
module Lvl3 =
struct
- type 'a t =
- { mutable line : 'a array array array;
- dummy : 'a;
- l1_size : int;
- l2_size : int;
- dummy_line1 : 'a array array;
- dummy_line2 : 'a array }
-
- let dummy_line2 = [| |]
- let dummy_line1 = [| |]
-
- let create ?(l1_size=512) ?(l2_size=512) n a =
- let dummy_line2 = Array.create l2_size a in
- let dummy_line1 = Array.create l1_size dummy_line2 in
- { line = Array.create n dummy_line1;
- dummy = a;
- l1_size = l1_size;
- l2_size = l2_size;
- dummy_line1 = dummy_line1;
- dummy_line2 = dummy_line2
+ type 'a t = 'a Lvl2.t Lvl1.t
+
+ let create n a =
+ let dummy1 = Lvl2.create 512 a in
+ { Lvl1.line = Array.create n dummy1;
+ Lvl1.offset = ~-1;
+ Lvl1.dummy = dummy1;
}
- let find t i j k = t.line.(i).(j).(k)
-
- let add t i j k v =
- let line = t.line in
- let line1 =
- let l1 = line.(i) in
- if l1 == t.dummy_line1 then
- let l1' = Array.copy l1 in
- line.(i) <- l1'; l1'
- else l1
- in
- let line2 =
- let l2 = line1.(j) in
- if l2 == t.dummy_line2 then
- let l2' = Array.copy l2 in
- line1.(j) <- l2'; l2'
- else l2
- in
- line2.(k) <- v
- let dummy a = a.dummy
- let to_array a = a.line
+ let add a i j k v =
+ let line = Lvl1.find a i in
+ if line == a.Lvl1.dummy then
+ let nline = Lvl1.create 0 line.Lvl1.dummy in
+ Lvl1.add a i nline;
+ Lvl2.add nline j k v
+ else
+ Lvl2.add line j k v
+
+ let find a i j k =
+ let v = Lvl1.find a i in
+ if v == a.Lvl1.dummy then Lvl2.dummy a.Lvl1.dummy
+ else Lvl2.find v j k
+
+
+ let dummy a = Lvl2.dummy a.Lvl1.dummy
+ let iteri f a =
+ let line = a.Lvl1.line in
+ if a.Lvl1.offset == ~-1 then () else
+ for i = 0 to Array.length line - 1 do
+ Lvl2.iteri (f i) line.(i)
+ done
+
end
projects / SXSI / xpathcomp.git / blobdiff