X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fcache.ml;h=abe113ae8ce22f3f1a6c362189fb8837bee562e7;hb=7e27afe6fa006ad355237ccc0695c6493ea57929;hp=f4561af0badd2ae383e05c372f0ab43efd1b6356;hpb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;p=SXSI%2Fxpathcomp.git diff --git a/src/cache.ml b/src/cache.ml index f4561af..abe113a 100644 --- a/src/cache.ml +++ b/src/cache.ml @@ -1,125 +1,152 @@ 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); - l' + for i = 0 to (min old_size new_size) - 1 do + l'.(i) <- l.(i); + done; + l' module Lvl1 = - struct +struct + type 'a t = { mutable line : 'a array; + 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 dummy a = a.dummy + + 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 + + +end - type 'a t = { mutable line : 'a array; - dummy : 'a } - let create n a = { line = Array.create n a; - dummy = a } - let find c i = - let line = c.line in - let len = Array.length line in - if i >= len then c.dummy else line.(i) +module Lvl2 = +struct + 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 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 dummy c = c.dummy + 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 to_array c = c.line - end -include Lvl1 + 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 -module Lvl2 = - struct - type 'a t = { mutable line : 'a array array; - dummy : 'a; - l1_size : int; - dummy_line1 : 'a array - } - - 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 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 (*Array.create c.l1_size c.dummy*) 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 + + 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 + + +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 - } - let find t i j k = t.line.(i).(j).(k) -(* - let find t i j k = - let line = t.line in - let line1 = line.(i) in - if line1 == dummy_line1 then t.dummy else - let line2 = line1.(j) in - if line2 == dummy_line2 then t.dummy else line2.(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 - end +struct + 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 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