Ported Callgraph

This commit is contained in:
Cédric Pasteur 2010-06-18 11:20:35 +02:00
parent 6e29fea1ab
commit 762b881e84

View file

@ -6,21 +6,7 @@ open Format
open Location
open Printf
open Static
module Error =
struct
type error =
| Emain_node_no_params of name
let message loc kind =
begin match kind with
| Emain_node_no_params n ->
eprintf "%aThe main node '%s' cannot have parameters.\n"
output_location loc
n
end;
raise Misc.Error
end
open Signature
let nodes_instances = ref NamesEnv.empty
let global_env = ref NamesEnv.empty
@ -32,7 +18,8 @@ let rec string_of_int_list = function
let add_node_params n params =
if NamesEnv.mem n !nodes_instances then
nodes_instances := NamesEnv.add n (params::(NamesEnv.find n !nodes_instances)) !nodes_instances
nodes_instances := NamesEnv.add n
(params::(NamesEnv.find n !nodes_instances)) !nodes_instances
else
nodes_instances := NamesEnv.add n [params] !nodes_instances
@ -40,69 +27,75 @@ let rec node_by_name s = function
| [] -> raise Not_found
| n::l ->
if n.n_name = s then
n
n
else
node_by_name s l
node_by_name s l
let build env params_names params_values =
List.fold_left2 (fun m n v -> NamesEnv.add n (SConst v) m) env params_names params_values
List.fold_left2 (fun m { p_name = n } v -> NamesEnv.add n (SConst v) m)
env params_names params_values
let rec collect_exp nodes env e =
match e.e_desc with
| Emerge(_, c_e_list) ->
List.iter (fun (_, e) -> collect_exp nodes env e) c_e_list
List.iter (fun (_, e) -> collect_exp nodes env e) c_e_list
| Eifthenelse(e1, e2, e3) ->
collect_exp nodes env e1;
collect_exp nodes env e2;
collect_exp nodes env e3
| Ewhen(e, _, _) | Efby(_, e) | Efield(e, _) | Erepeat (_,e)
| Eselect (_,e) | Eselect_slice (_ , _, e) ->
collect_exp nodes env e
| Etuple e_list | Earray e_list
| Eop(_, _, e_list) ->
List.iter (collect_exp nodes env) e_list
| Evar _ | Econstvar _ | Econst _ | Ereset_mem _ -> ()
collect_exp nodes env e1;
collect_exp nodes env e2;
collect_exp nodes env e3
| Ewhen(e, _, _) | Efby(_, e) | Efield(e, _) ->
collect_exp nodes env e
| Evar _ | Econstvar _ | Econst _ -> ()
| Estruct(f_e_list) ->
List.iter (fun (_, e) -> collect_exp nodes env e) f_e_list
| Eselect_dyn (e_list, _, e1, e2) ->
List.iter (collect_exp nodes env) e_list;
collect_exp nodes env e1;
collect_exp nodes env e2
| Eupdate (_, e1, e2) | Econcat (e1, e2) | Efield_update(_, e1, e2) ->
collect_exp nodes env e1;
collect_exp nodes env e2
List.iter (fun (_, e) -> collect_exp nodes env e) f_e_list
| Etuple e_list | Earray e_list ->
List.iter (collect_exp nodes env) e_list
| Efield_update(_, e1, e2) ->
collect_exp nodes env e1;
collect_exp nodes env e2
(* Do the real work: call node *)
| Eevery(ln, params, e_list, _)
| Eapp(ln, params, e_list) ->
List.iter (collect_exp nodes env) e_list;
let params = List.map (int_of_size_exp env) params in
(match params with
| [] -> ()
| params ->
let n = node_by_name (shortname ln.a_op) nodes in
node_call nodes n params
)
| Eiterator (_, ln, params, _, e_list, _) ->
List.iter (collect_exp nodes env) e_list;
let params = List.map (int_of_size_exp env) params in
(match params with
| [] -> ()
| params ->
let n = node_by_name (shortname ln) nodes in
node_call nodes n params
)
| Ecall( { op_name = ln; op_params = params; op_kind = Eop }, e_list, _) ->
List.iter (collect_exp nodes env) e_list
| Ecall( { op_name = ln; op_params = params; op_kind = Enode }, e_list, _) ->
List.iter (collect_exp nodes env) e_list;
let params = List.map (int_of_size_exp env) params in
call_node_instance nodes ln params
| Earray_op op ->
collect_array_exp nodes env op
and collect_array_exp nodes env = function
| Eselect_dyn (e_list, _, e1, e2) ->
List.iter (collect_exp nodes env) e_list;
collect_exp nodes env e1;
collect_exp nodes env e2
| Eupdate (_, e1, e2) | Econcat (e1, e2) ->
collect_exp nodes env e1;
collect_exp nodes env e2
| Eselect (_,e) | Eselect_slice (_ , _, e) | Erepeat (_,e) ->
collect_exp nodes env e
| Eiterator (_, { op_name = ln; op_params = params }, _, e_list, _) ->
List.iter (collect_exp nodes env) e_list;
let params = List.map (int_of_size_exp env) params in
call_node_instance nodes ln params
and collect_eqs nodes env eq =
collect_exp nodes env eq.eq_rhs
and call_node_instance nodes ln params =
match params with
| [] -> ()
| params ->
let n = node_by_name (shortname ln) nodes in
node_call nodes n params
and node_call nodes n params =
match params with
| [] ->
List.iter (collect_eqs nodes !global_env) n.n_equs
List.iter (collect_eqs nodes !global_env) n.n_equs
| params ->
add_node_params n.n_name params;
let env = build !global_env n.n_params params in
List.iter (collect_eqs nodes env) n.n_equs
add_node_params n.n_name params;
let env = build !global_env n.n_params params in
List.iter (collect_eqs nodes env) n.n_equs
let node n =
let inst =
@ -113,7 +106,9 @@ let node n =
{ n with n_params_instances = inst }
let build_const_env cd_list =
List.fold_left (fun env cd -> NamesEnv.add cd.Minils.c_name cd.Minils.c_value env) NamesEnv.empty cd_list
List.fold_left (fun env cd -> NamesEnv.add
cd.Minils.c_name cd.Minils.c_value env)
NamesEnv.empty cd_list
let program p =
let try_call_node n =
@ -124,4 +119,4 @@ let program p =
global_env := build_const_env p.p_consts;
List.iter try_call_node p.p_nodes;
{ p with p_nodes = List.map node p.p_nodes }