Commit 832da45c authored by Maximilien Colange's avatar Maximilien Colange

Optimize array cells storage in VarContext.

parent 23353de9
......@@ -552,10 +552,6 @@ handle_declaration(variable_t &var, value proc, const std::map<symbol_t, express
cb_array = caml_callback(cb_array, proc);
cb_cell = caml_callback(cb_cell, proc);
// first, register array name
caml_callback(cb_array,
caml_copy_string(var.uid.getName().c_str()));
// if varType.getSub() is itself an array type, this makes arrays of arrays
// to handle the general case, we need to retrieve all dimensions, say in a vector
// BEWARE of the order: top-most in the type = right-most in the declaration
......@@ -576,6 +572,18 @@ handle_declaration(variable_t &var, value proc, const std::map<symbol_t, express
currentType = currentType.getSub();
}
indices = caml_callback(*caml_named_value("cb_empty_list"), Val_unit);
for (auto it = multiSize.rbegin(); it != multiSize.rend(); ++it)
{
indices = caml_callback2(*caml_named_value("cb_build_list"),
Val_int(*it),
indices);
}
// first, register array name with its full dimension
caml_callback2(cb_array,
caml_copy_string(var.uid.getName().c_str()),
indices);
std::vector<int> index(multiSize.size(), 0);
bool index_is_zero = true;
do
......
......@@ -42,6 +42,47 @@ sig
val iter : t -> (var_t -> int -> unit) -> unit
end
(**
* a custom type to store array cells
*)
module ArrayCell =
struct
type arr = Leaf of int array | Node of arr array
let rec make_array = function
| [] -> failwith "an array cannot be empty"
| [n] -> Leaf (Array.make n 0)
| n::l -> Node (Array.init n (fun _ -> make_array l))
let rec get_leaf = function
| Leaf a -> begin function
| [n] -> a.(n)
| _ -> failwith "wrong array dimension"
end
| Node a -> begin function
| n::l -> get_leaf a.(n) l
| _ -> failwith "wrong array dimension"
end
let rec set_leaf value = function
| Leaf a -> begin function
| [n] -> a.(n) <- value
| _ -> failwith "wrong array dimension"
end
| Node a -> begin function
| n::l -> set_leaf value a.(n) l
| _ -> failwith "wrong array dimension"
end
let rec _get_cells = function
| Leaf a -> Array.to_list a
| Node a -> Array.fold_left (fun acc x -> acc @ (_get_cells x)) [] a
let get_cells x =
List.sort Pervasives.compare (_get_cells x)
end
module VarContextFunctor =
functor (Vars : sig type var_t type array_t val cell2var : array_t -> int list -> var_t end) ->
struct
......@@ -56,7 +97,7 @@ struct
index2array : (int,arr_t) Hashtbl.t;
array2index : (arr_t,int) Hashtbl.t;
cells2vars : (int * int list, int) Hashtbl.t;
mutable cells2vars : ArrayCell.arr array;
mutable nextVarIndex : int;
mutable nextArrayIndex : int;
......@@ -70,7 +111,7 @@ struct
index2array = Hashtbl.create 16;
array2index = Hashtbl.create 16;
cells2vars = Hashtbl.create 16;
cells2vars = [||];
nextVarIndex = 0;
nextArrayIndex = 0;
......@@ -91,7 +132,7 @@ struct
Hashtbl.mem vc.array2index arr
let index_of_cell vc arrayId indices =
Hashtbl.find vc.cells2vars (arrayId,indices)
ArrayCell.get_leaf vc.cells2vars.(arrayId) indices
let add vc varName =
if (Hashtbl.mem vc.var2index varName) then (
......@@ -103,20 +144,21 @@ struct
Hashtbl.add vc.var2index varName index;
index
let add_array vc arrayName =
let add_array vc arrayName dims =
if (Hashtbl.mem vc.array2index arrayName) then (
raise Var_already_defined
);
let index = vc.nextArrayIndex in
vc.nextArrayIndex <- vc.nextArrayIndex + 1;
Hashtbl.add vc.index2array index arrayName;
Hashtbl.add vc.array2index arrayName index
Hashtbl.add vc.array2index arrayName index;
vc.cells2vars <- Array.append vc.cells2vars [|ArrayCell.make_array dims|]
let add_cell vc arrayName indices =
let arrayIndex = Hashtbl.find vc.array2index arrayName in
let cellVar = Vars.cell2var arrayName indices in
let cellIndex = add vc cellVar in
Hashtbl.add vc.cells2vars (arrayIndex,indices) cellIndex;
ArrayCell.set_leaf cellIndex vc.cells2vars.(arrayIndex) indices;
cellIndex
let size vc = Hashtbl.length vc.var2index
......@@ -174,7 +216,7 @@ struct
let arrList =
List.sort compare
(Hashtbl.fold (fun (p,v) index acc -> (index, prep v p)::acc) svc.array2index []) in
List.iter (fun (_,name) -> VarContext.add_array result name) arrList;
List.iter (fun (_,name) -> VarContext.add_array result name [0]) arrList;
(* Do not forget the mapping from cells to vars *)
{ result with VarContext.cells2vars = svc.cells2vars }
......
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