src/cache.ml

   1 let realloc l old_size new_size dummy =
   2   let l' = Array.create new_size dummy in
   3     Array.blit l 0 l' 0 (min old_size new_size);
   4     l'
   5
   6 module Lvl1 =
   7   struct
   8
   9     type 'a t = { mutable line : 'a array;
  10                  dummy : 'a }
  11     let create n a = { line = Array.create n a;
  12                        dummy = a }
  13
  14     let find c i =
  15       let line = c.line in
  16       let len = Array.length line in
  17         if i >= len then c.dummy else line.(i)
  18
  19
  20     let add c i v =
  21       let line = c.line in
  22       let len = Array.length line in
  23         if i >= len then c.line <- realloc line len (i*2+1) c.dummy;
  24         c.line.(i) <- v
  25
  26     let dummy c = c.dummy
  27
  28     let to_array c = c.line
  29   end
  30
  31 include Lvl1
  32
  33 module Lvl2 =
  34   struct
  35     type 'a t = { mutable line : 'a array array;
  36                  dummy : 'a;
  37                  l1_size : int;
  38                  dummy_line1 : 'a array
  39                }
  40
  41     let dummy_line = [| |]
  42
  43     let create ?(l1_size=512) n a =
  44       let dummy_line1 = Array.create l1_size a in
  45       { line = Array.create n dummy_line1;
  46         dummy = a;
  47         l1_size = l1_size;
  48         dummy_line1 = dummy_line1;
  49       }
  50     let find c i j = c.line.(i).(j)
  51     let add c i j v =
  52       let line = c.line in
  53       let len = Array.length line in
  54       if i >= len then c.line <- realloc line len (i*2 + 1) c.dummy_line1;
  55       let line = c.line.(i) in
  56       let line =
  57         if line == c.dummy_line1 then
  58             let nline = Array.copy line (*Array.create c.l1_size c.dummy*) in
  59               c.line.(i) <- nline;
  60               nline
  61           else line
  62         in
  63           line.(j) <- v
  64
  65     let dummy c = c.dummy
  66     let to_array c = c.line
  67     let dummy_line c = c.dummy_line1
  68   end
  69
  70 module Lvl3 =
  71   struct
  72     type 'a t = { mutable line : 'a array array array;
  73                  dummy : 'a;
  74                  l1_size : int;
  75                  l2_size : int;
  76                  dummy_line1 : 'a array array;
  77                  dummy_line2 : 'a array
  78                }
  79     let dummy_line2 = [| |]
  80     let dummy_line1 = [| |]
  81
  82
  83
  84     let create ?(l1_size=512) ?(l2_size=512) n a =
  85       let dummy_line2 = Array.create l2_size a in
  86       let dummy_line1 = Array.create l1_size dummy_line2 in
  87       { line = Array.create n dummy_line1;
  88         dummy = a;
  89         l1_size = l1_size;
  90         l2_size = l2_size;
  91         dummy_line1 = dummy_line1;
  92         dummy_line2 = dummy_line2
  93       }
  94     let find t i j k = t.line.(i).(j).(k)
  95 (*
  96     let find t i j k =
  97       let line = t.line in
  98       let line1 = line.(i) in
  99         if line1 == dummy_line1 then t.dummy else
 100           let line2 = line1.(j) in
 101             if line2 == dummy_line2 then t.dummy else line2.(k)
 102 *)
 103
 104     let add t i j k v =
 105       let line = t.line in
 106       let line1 =
 107         let l1 = line.(i) in
 108           if l1 == t.dummy_line1 then
 109             let l1' = Array.copy l1 in
 110               line.(i) <- l1'; l1'
 111           else l1
 112       in
 113       let line2 =
 114         let l2 = line1.(j) in
 115           if l2 == t.dummy_line2 then
 116             let l2' = Array.copy l2 in
 117               line1.(j) <- l2'; l2'
 118           else l2
 119       in
 120         line2.(k) <- v
 121
 122
 123     let dummy a = a.dummy
 124     let to_array a = a.line
 125   end