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
  12   let create n a = { line = Array.create n a;
  13                      dummy = a }
  14
  15   let find c i =
  16     let line = c.line in
  17     let len = Array.length line in
  18     if i >= len then c.dummy else line.(i)
  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
  51   let find c i j = c.line.(i).(j)
  52
  53   let add c i j v =
  54     let line = c.line in
  55     let len = Array.length line in
  56     if i >= len then
  57       c.line <- realloc line len (i*2 + 1) c.dummy_line1;
  58     let line = c.line.(i) in
  59     let line =
  60       if line == c.dummy_line1 then
  61         let nline = Array.copy line in
  62         c.line.(i) <- nline;
  63         nline
  64       else line
  65     in
  66     line.(j) <- v
  67
  68   let dummy c = c.dummy
  69   let to_array c = c.line
  70   let dummy_line c = c.dummy_line1
  71 end
  72
  73 module Lvl3 =
  74 struct
  75   type 'a t =
  76       { mutable line : 'a array array array;
  77         dummy : 'a;
  78         l1_size : int;
  79         l2_size : int;
  80         dummy_line1 : 'a array array;
  81         dummy_line2 : 'a array }
  82
  83   let dummy_line2 = [| |]
  84   let dummy_line1 = [| |]
  85
  86   let create ?(l1_size=512) ?(l2_size=512) n a =
  87     let dummy_line2 = Array.create l2_size a in
  88     let dummy_line1 = Array.create l1_size dummy_line2 in
  89     { line = Array.create n dummy_line1;
  90       dummy = a;
  91       l1_size = l1_size;
  92       l2_size = l2_size;
  93       dummy_line1 = dummy_line1;
  94       dummy_line2 = dummy_line2
  95     }
  96   let find t i j k = t.line.(i).(j).(k)
  97
  98   let add t i j k v =
  99     let line = t.line in
 100     let line1 =
 101       let l1 = line.(i) in
 102       if l1 == t.dummy_line1 then
 103         let l1' = Array.copy l1 in
 104         line.(i) <- l1'; l1'
 105       else l1
 106     in
 107     let line2 =
 108       let l2 = line1.(j) in
 109       if l2 == t.dummy_line2 then
 110         let l2' = Array.copy l2 in
 111         line1.(j) <- l2'; l2'
 112       else l2
 113     in
 114     line2.(k) <- v
 115
 116   let dummy a = a.dummy
 117   let to_array a = a.line
 118 end