jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

replaced mapfold with callgraph_mapfold. And the fixes to compile.

Browse source
This commit is contained in:
Léonard Gérard 2010-08-26 13:55:29 +02:00
parent aef39b8036
commit 9eaafe9736
5 changed files with 314 additions and 438 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
compiler/main/hept2mls.ml
View file

@ -381,8 +381,7 @@ let node
n_equs = l_eqs;
n_loc = loc ;
n_params = params;
n_params_constraints = params_constr;
n_params_instances = []; }
n_params_constraints = params_constr }
let typedec
{Heptagon.t_name = n; Heptagon.t_desc = tdesc; Heptagon.t_loc = loc} =

4
compiler/minils/main/mls2seq.ml
View file

@ -60,10 +60,10 @@ let generate_target p s =
let o = Mls2obc.program p in
convert_fun o
| Minils_no_params convert_fun ->
let p_list = Callgraph_mapfold.program p in
let p_list = Callgraph.program p in
List.iter convert_fun p_list
| Obc_no_params convert_fun ->
let p_list = Callgraph_mapfold.program p in
let p_list = Callgraph.program p in
let o_list = List.map Mls2obc.program p_list in
print_unfolded p_list;
if !Misc.verbose then

8
compiler/minils/minils.ml
View file

@ -111,9 +111,8 @@ type node_dec = {
n_local : var_dec list;
n_equs : eq list;
n_loc : location;
n_params : param list; (** TODO CP mettre des petits commentaires *)
n_params_constraints : size_constraint list;
n_params_instances : (static_exp list) list }
n_params : param list;
n_params_constraints : size_constraint list }
type const_dec = {
c_name : name;
@ -151,8 +150,7 @@ let mk_node
n_equs = eq;
n_loc = loc;
n_params = param;
n_params_constraints = constraints;
n_params_instances = pinst; }
n_params_constraints = constraints }
let mk_type_dec ?(type_desc = Type_abs) ?(loc = no_location) name =
{ t_name = name; t_desc = type_desc; t_loc = loc }

412
compiler/minils/transformations/callgraph.ml
View file

@ -1,121 +1,325 @@
open Misc
open Minils
open Names
open Idents
open Format
open Types
open Misc
open Location
open Format
open Static
open Signature
open Modules
open Static
open Global_mapfold
open Mls_mapfold
open Minils
let nodes_instances = ref NamesEnv.empty
let global_env = ref NamesEnv.empty
module Error =
struct
type error =
| Enode_unbound of longname
| Epartial_instanciation of static_exp
let rec string_of_int_list = function
| [] -> ""
| [n] -> (string_of_int n)
| n::l -> (string_of_int n)^", "^(string_of_int_list l)
let message loc kind =
begin match kind with
| Enode_unbound ln ->
Format.eprintf "%aUnknown node '%s'@."
print_location loc
(fullname ln)
| Epartial_instanciation se ->
Format.eprintf "%aUnable to fully instanciate the static exp '%a'@."
print_location se.se_loc
print_static_exp se
end;
raise Misc.Error
end
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
else
nodes_instances := NamesEnv.add n [params] !nodes_instances
module Param_instances :
sig
type key = private static_exp (** Fully instantiated param *)
type env = key NamesEnv.t
val instantiate: env -> static_exp list -> key list
val get_node_instances : LongNameEnv.key -> key list list
val add_node_instance : LongNameEnv.key -> key list -> unit
val build : env -> param list -> key list -> env
module Instantiate :
sig
val program : program -> program
end
end =
struct
type key = static_exp
type env = key NamesEnv.t
let rec node_by_name s = function
| [] -> raise Not_found
| n::l ->
if n.n_name = s then
n
else
node_by_name s l
(** An instance is a list of instantiated params *)
type instance = key list
(** two instances are equal if the desc of keys are equal *)
let compare_instances =
let compare se1 se2 = compare se1.se_desc se2.se_desc in
Misc.make_list_compare compare
let build 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
module S = (** Instances set *)
Set.Make(
struct
type t = instance
let compare = compare_instances
end)
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
| 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, _) ->
collect_exp nodes env e
| Evar _ | Econstvar _ | Econst _ -> ()
| Estruct(f_e_list) ->
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 *)
| Ecall( { op_name = ln; op_params = params; op_kind = _ },
e_list, _) ->
List.iter (collect_exp nodes env) e_list;
let params = List.map (int_of_static_exp env) params in
call_node_instance nodes ln params
| Earray_op op ->
collect_array_exp nodes env op
module M = (** Map instance to its instantiated node *)
Map.Make(
struct
type t = longname * instance
let compare (l1,i1) (l2,i2) =
let cl = compare l1 l2 in
if cl = 0 then compare_instances i1 i2 else cl
end)
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_static_exp env) params in
call_node_instance nodes ln params
(** Maps a couple (node name, params) to the name of the instantiated node *)
let nodes_names = ref M.empty
and collect_eqs nodes env eq =
collect_exp nodes env eq.eq_rhs
(** Maps a node to its list of instances *)
let nodes_instances = ref LongNameEnv.empty
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
(** create a params instance *)
let instantiate m se =
try List.map (eval m) se
with Partial_instanciation se ->
Error.message no_location (Error.Epartial_instanciation se)
and node_call nodes n params =
match params with
| [] ->
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
(** @return the name of the node corresponding to the instance of
[ln] with the static parameters [params]. *)
let node_for_params_call ln params = match params with
| [] -> ln
| _ -> let ln = M.find (ln,params) !nodes_names in ln
let node n =
let inst =
if NamesEnv.mem n.n_name !nodes_instances then
NamesEnv.find n.n_name !nodes_instances
else
[] in
{ n with n_params_instances = inst }
(** Generates a fresh name for the the instance of
[ln] with the static parameters [params] and stores it. *)
let generate_new_name ln params = match params with
| [] -> nodes_names := M.add (ln, params) ln !nodes_names
| _ -> (match ln with
| Modname { qual = q; id = id } ->
let new_ln = Modname { qual = q;
(* TODO ??? c'est quoi ce nom ??? *)
(* l'utilite de fresh n'est vrai que si toute les fonctions
sont touchees.. ce qui n'est pas vrai cf main_nodes *)
(* TODO mettre les valeurs des params dans le nom *)
id = id^(Idents.name (Idents.fresh "")) } in
nodes_names := M.add (ln, params) new_ln !nodes_names
| _ -> assert false)
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
(** Adds an instance of a node. *)
let add_node_instance ln params =
(* get the already defined instances *)
let instances = try LongNameEnv.find ln !nodes_instances
with Not_found -> S.empty in
if S.mem params instances then () (* nothing to do *)
else ( (* it's a new instance *)
let instances = S.add params instances in
nodes_instances := LongNameEnv.add ln instances !nodes_instances;
generate_new_name ln params )
(** @return the list of instances of a node. *)
let get_node_instances ln =
let instances_set =
try LongNameEnv.find ln !nodes_instances
with Not_found -> S.empty in
S.elements instances_set
(** Build an environment by instantiating the passed params *)
let build env params_names params_values =
List.fold_left2 (fun m { p_name = n } v -> NamesEnv.add n v m)
env params_names (instantiate env params_values)
(** This module creates an instance of a node with a given
list of static parameters. *)
module Instantiate =
struct
(** Replaces static parameters with their value in the instance. *)
let static_exp funs m se =
let se, _ = Global_mapfold.static_exp funs m se in
let se = match se.se_desc with
| Svar ln ->
(match ln with
| Name n ->
(try NamesEnv.find n m
with Not_found -> (* It should then be in the global env *)
se)
| Modname _ -> se)
| _ -> se in
se, m
(** Replaces nodes call with the call to the correct instance. *)
let edesc funs m ed =
let ed, _ = Mls_mapfold.edesc funs m ed in
let ed = match ed with
| Eapp ({ a_op = Efun ln; a_params = params } as app, e_list, r) ->
let op = Efun (node_for_params_call ln (instantiate m params)) in
Eapp ({ app with a_op = op; a_params = [] }, e_list, r)
| Eapp ({ a_op = Enode ln; a_params = params } as app, e_list, r) ->
let op = Enode (node_for_params_call ln (instantiate m params)) in
Eapp ({ app with a_op = op; a_params = [] }, e_list, r)
| Eiterator(it, ({ a_op = Efun ln; a_params = params } as app),
n, e_list, r) ->
let op = Efun (node_for_params_call ln (instantiate m params)) in
Eiterator(it, {app with a_op = op; a_params = [] }, n, e_list, r)
| Eiterator(it, ({ a_op = Enode ln; a_params = params } as app),
n, e_list, r) ->
let op = Enode (node_for_params_call ln (instantiate m params)) in
Eiterator(it,{app with a_op = op; a_params = [] }, n, e_list, r)
| _ -> ed
in ed, m
let node_dec_instance modname n params =
let global_funs =
{ Global_mapfold.defaults with static_exp = static_exp } in
let funs =
{ Mls_mapfold.defaults with edesc = edesc;
global_funs = global_funs } in
let m = build NamesEnv.empty n.n_params params in
let n, _ = Mls_mapfold.node_dec_it funs m n in
(* Add to the global environment the signature of the new instance *)
let ln = Modname { qual = modname; id = n.n_name } in
let { info = node_sig } = find_value ln in
let node_sig, _ = Global_mapfold.node_it global_funs m node_sig in
let node_sig = { node_sig with node_params = [];
node_params_constraints = [] } in
(* Find the name that was associated to this instance *)
let ln = node_for_params_call ln params in
Modules.add_value_by_longname ln node_sig;
{ n with n_name = shortname ln; n_params = []; n_params_constraints = [];}
let node_dec modname n =
let ln = Modname { qual = modname; id = n.n_name } in
List.map (node_dec_instance modname n) (get_node_instances ln)
let program p =
{ p
with p_nodes = List.flatten (List.map (node_dec p.p_modname) p.p_nodes)}
end
end
open Param_instances
type info =
{ mutable opened : program NamesEnv.t;
mutable called_nodes : ((longname * static_exp list) list) LongNameEnv.t; }
let info =
{ (** opened programs*)
opened = NamesEnv.empty;
(** Maps a node to the list of (node name, params) it calls *)
called_nodes = LongNameEnv.empty }
(** Loads the modname.epo file. *)
let load_object_file modname =
Modules.open_module modname;
let name = String.uncapitalize modname in
try
let filename = Modules.findfile (name ^ ".epo") in
let ic = open_in_bin filename in
try
let p:program = input_value ic in
if p.p_format_version <> minils_format_version then (
Format.eprintf "The file %s was compiled with \
an older version of the compiler.\n \
Please recompile %s.ept first.\n" filename name;
raise Error
);
close_in ic;
info.opened <- NamesEnv.add p.p_modname p info.opened
with
| End_of_file | Failure _ ->
close_in ic;
Format.eprintf "Corrupted object file %s.\n\
Please recompile %s.ept first.\n" filename name;
raise Error
with
| Modules.Cannot_find_file(filename) ->
Format.eprintf "Cannot find the object file '%s'.\n"
filename;
raise Error
(** @return the node with name [ln], loading the corresponding
object file if necessary. *)
let node_by_longname ln =
match ln with
| Modname { qual = q; id = id } ->
if not (NamesEnv.mem q info.opened) then
load_object_file q;
(try
let p = NamesEnv.find q info.opened in
List.find (fun n -> n.n_name = id) p.p_nodes
with
Not_found -> Error.message no_location (Error.Enode_unbound ln))
| _ -> assert false
(** @return the list of nodes called by the node named [ln], with the
corresponding params (static parameters appear as free variables). *)
let collect_node_calls ln =
let add_called_node ln params acc =
match params with
| [] -> acc
| _ ->
(match ln with
| Modname { qual = "Pervasives" } -> acc
| _ -> (ln, params)::acc)
in
let edesc funs acc ed = match ed with
| Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) ->
ed, add_called_node ln params acc
| Eiterator(_, { a_op = (Enode ln | Efun ln); a_params = params },
_, _, _) ->
ed, add_called_node ln params acc
| _ -> raise Misc.Fallback
in
let funs = { Mls_mapfold.defaults with edesc = edesc } in
let n = node_by_longname ln in
let _, acc = Mls_mapfold.node_dec funs [] n in
acc
(** @return the list of nodes called by the node named [ln]. This list is
computed lazily the first time it is needed. *)
let called_nodes ln =
if not (LongNameEnv.mem ln info.called_nodes) then (
let called = collect_node_calls ln in
info.called_nodes <- LongNameEnv.add ln called info.called_nodes;
called
) else
LongNameEnv.find ln info.called_nodes
(*
(** Checks that a static expression does not contain any static parameter. *)
let check_no_static_var se =
let static_exp_desc funs acc sed = match sed with
| Svar (Name n) -> Error.message se.se_loc (Error.Evar_unbound n)
| _ -> raise Misc.Fallback
in
let funs = { Global_mapfold.defaults with
static_exp_desc = static_exp_desc } in
ignore (Global_mapfold.static_exp_it funs false se)
*)
(** Generates the list of instances of nodes needed to call
[ln] with static parameters [params]. *)
let rec call_node (ln, params) =
(* First, add the instance for this node *)
let n = node_by_longname ln in
let m = build NamesEnv.empty n.n_params params in
(* List.iter check_no_static_var params; *)
add_node_instance ln params;
(* Recursively generate instances for called nodes. *)
let call_list = called_nodes ln in
let call_list =
List.map (fun (ln, p) -> ln, instantiate m p) call_list in
List.iter call_node call_list
let program p =
let try_call_node n =
match n.n_params with
| [] -> node_call p.p_nodes n []
| _ -> ()
in
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 }
(* Find the nodes without static parameters *)
let main_nodes = List.filter (fun n -> is_empty n.n_params) p.p_nodes in
let main_nodes = List.map (fun n -> (longname n.n_name, [])) main_nodes in
info.opened <- NamesEnv.add p.p_modname p NamesEnv.empty;
(* Creates the list of instances starting from these nodes *)
List.iter call_node main_nodes;
let p_list = NamesEnv.fold (fun _ p l -> p::l) info.opened [] in
(* Generate all the needed instances *)
List.map Param_instances.Instantiate.program p_list

325
compiler/minils/transformations/callgraph_mapfold.ml
View file

@ -1,325 +0,0 @@
open Names
open Types
open Misc
open Location
open Signature
open Modules
open Static
open Global_mapfold
open Mls_mapfold
open Minils
module Error =
struct
type error =
| Enode_unbound of longname
| Epartial_instanciation of static_exp
let message loc kind =
begin match kind with
| Enode_unbound ln ->
Format.eprintf "%aUnknown node '%s'@."
print_location loc
(fullname ln)
| Epartial_instanciation se ->
Format.eprintf "%aUnable to fully instanciate the static exp '%a'@."
print_location se.se_loc
print_static_exp se
end;
raise Misc.Error
end
module Param_instances :
sig
type key = private static_exp (** Fully instantiated param *)
type env = key NamesEnv.t
val instantiate: env -> static_exp list -> key list
val get_node_instances : LongNameEnv.key -> key list list
val add_node_instance : LongNameEnv.key -> key list -> unit
val build : env -> param list -> key list -> env
module Instantiate :
sig
val program : program -> program
end
end =
struct
type key = static_exp
type env = key NamesEnv.t
(** An instance is a list of instantiated params *)
type instance = key list
(** two instances are equal if the desc of keys are equal *)
let compare_instances =
let compare se1 se2 = compare se1.se_desc se2.se_desc in
Misc.make_list_compare compare
module S = (** Instances set *)
Set.Make(
struct
type t = instance
let compare = compare_instances
end)
module M = (** Map instance to its instantiated node *)
Map.Make(
struct
type t = longname * instance
let compare (l1,i1) (l2,i2) =
let cl = compare l1 l2 in
if cl = 0 then compare_instances i1 i2 else cl
end)
(** Maps a couple (node name, params) to the name of the instantiated node *)
let nodes_names = ref M.empty
(** Maps a node to its list of instances *)
let nodes_instances = ref LongNameEnv.empty
(** create a params instance *)
let instantiate m se =
try List.map (eval m) se
with Partial_instanciation se ->
Error.message no_location (Error.Epartial_instanciation se)
(** @return the name of the node corresponding to the instance of
[ln] with the static parameters [params]. *)
let node_for_params_call ln params = match params with
| [] -> ln
| _ -> let ln = M.find (ln,params) !nodes_names in ln
(** Generates a fresh name for the the instance of
[ln] with the static parameters [params] and stores it. *)
let generate_new_name ln params = match params with
| [] -> nodes_names := M.add (ln, params) ln !nodes_names
| _ -> (match ln with
| Modname { qual = q; id = id } ->
let new_ln = Modname { qual = q;
(* TODO ??? c'est quoi ce nom ??? *)
(* l'utilite de fresh n'est vrai que si toute les fonctions
sont touchees.. ce qui n'est pas vrai cf main_nodes *)
(* TODO mettre les valeurs des params dans le nom *)
id = id^(Idents.name (Idents.fresh "")) } in
nodes_names := M.add (ln, params) new_ln !nodes_names
| _ -> assert false)
(** Adds an instance of a node. *)
let add_node_instance ln params =
(* get the already defined instances *)
let instances = try LongNameEnv.find ln !nodes_instances
with Not_found -> S.empty in
if S.mem params instances then () (* nothing to do *)
else ( (* it's a new instance *)
let instances = S.add params instances in
nodes_instances := LongNameEnv.add ln instances !nodes_instances;
generate_new_name ln params )
(** @return the list of instances of a node. *)
let get_node_instances ln =
let instances_set =
try LongNameEnv.find ln !nodes_instances
with Not_found -> S.empty in
S.elements instances_set
(** Build an environment by instantiating the passed params *)
let build env params_names params_values =
List.fold_left2 (fun m { p_name = n } v -> NamesEnv.add n v m)
env params_names (instantiate env params_values)
(** This module creates an instance of a node with a given
list of static parameters. *)
module Instantiate =
struct
(** Replaces static parameters with their value in the instance. *)
let static_exp funs m se =
let se, _ = Global_mapfold.static_exp funs m se in
let se = match se.se_desc with
| Svar ln ->
(match ln with
| Name n ->
(try NamesEnv.find n m
with Not_found -> (* It should then be in the global env *)
se)
| Modname _ -> se)
| _ -> se in
se, m
(** Replaces nodes call with the call to the correct instance. *)
let edesc funs m ed =
let ed, _ = Mls_mapfold.edesc funs m ed in
let ed = match ed with
| Eapp ({ a_op = Efun ln; a_params = params } as app, e_list, r) ->
let op = Efun (node_for_params_call ln (instantiate m params)) in
Eapp ({ app with a_op = op; a_params = [] }, e_list, r)
| Eapp ({ a_op = Enode ln; a_params = params } as app, e_list, r) ->
let op = Enode (node_for_params_call ln (instantiate m params)) in
Eapp ({ app with a_op = op; a_params = [] }, e_list, r)
| Eiterator(it, ({ a_op = Efun ln; a_params = params } as app),
n, e_list, r) ->
let op = Efun (node_for_params_call ln (instantiate m params)) in
Eiterator(it, {app with a_op = op; a_params = [] }, n, e_list, r)
| Eiterator(it, ({ a_op = Enode ln; a_params = params } as app),
n, e_list, r) ->
let op = Enode (node_for_params_call ln (instantiate m params)) in
Eiterator(it,{app with a_op = op; a_params = [] }, n, e_list, r)
| _ -> ed
in ed, m
let node_dec_instance modname n params =
let global_funs =
{ Global_mapfold.defaults with static_exp = static_exp } in
let funs =
{ Mls_mapfold.defaults with edesc = edesc;
global_funs = global_funs } in
let m = build NamesEnv.empty n.n_params params in
let n, _ = Mls_mapfold.node_dec_it funs m n in
(* Add to the global environment the signature of the new instance *)
let ln = Modname { qual = modname; id = n.n_name } in
let { info = node_sig } = find_value ln in
let node_sig, _ = Global_mapfold.node_it global_funs m node_sig in
let node_sig = { node_sig with node_params = [];
node_params_constraints = [] } in
(* Find the name that was associated to this instance *)
let ln = node_for_params_call ln params in
Modules.add_value_by_longname ln node_sig;
{ n with n_name = shortname ln; n_params = []; n_params_constraints = [];}
let node_dec modname n =
let ln = Modname { qual = modname; id = n.n_name } in
List.map (node_dec_instance modname n) (get_node_instances ln)
let program p =
{ p
with p_nodes = List.flatten (List.map (node_dec p.p_modname) p.p_nodes)}
end
end
open Param_instances
type info =
{ mutable opened : program NamesEnv.t;
mutable called_nodes : ((longname * static_exp list) list) LongNameEnv.t; }
let info =
{ (** opened programs*)
opened = NamesEnv.empty;
(** Maps a node to the list of (node name, params) it calls *)
called_nodes = LongNameEnv.empty }
(** Loads the modname.epo file. *)
let load_object_file modname =
Modules.open_module modname;
let name = String.uncapitalize modname in
try
let filename = Modules.findfile (name ^ ".epo") in
let ic = open_in_bin filename in
try
let p:program = input_value ic in
if p.p_format_version <> minils_format_version then (
Format.eprintf "The file %s was compiled with \
an older version of the compiler.\n \
Please recompile %s.ept first.\n" filename name;
raise Error
);
close_in ic;
info.opened <- NamesEnv.add p.p_modname p info.opened
with
| End_of_file | Failure _ ->
close_in ic;
Format.eprintf "Corrupted object file %s.\n\
Please recompile %s.ept first.\n" filename name;
raise Error
with
| Modules.Cannot_find_file(filename) ->
Format.eprintf "Cannot find the object file '%s'.\n"
filename;
raise Error
(** @return the node with name [ln], loading the corresponding
object file if necessary. *)
let node_by_longname ln =
match ln with
| Modname { qual = q; id = id } ->
if not (NamesEnv.mem q info.opened) then
load_object_file q;
(try
let p = NamesEnv.find q info.opened in
List.find (fun n -> n.n_name = id) p.p_nodes
with
Not_found -> Error.message no_location (Error.Enode_unbound ln))
| _ -> assert false
(** @return the list of nodes called by the node named [ln], with the
corresponding params (static parameters appear as free variables). *)
let collect_node_calls ln =
let add_called_node ln params acc =
match params with
| [] -> acc
| _ ->
(match ln with
| Modname { qual = "Pervasives" } -> acc
| _ -> (ln, params)::acc)
in
let edesc funs acc ed = match ed with
| Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) ->
ed, add_called_node ln params acc
| Eiterator(_, { a_op = (Enode ln | Efun ln); a_params = params },
_, _, _) ->
ed, add_called_node ln params acc
| _ -> raise Misc.Fallback
in
let funs = { Mls_mapfold.defaults with edesc = edesc } in
let n = node_by_longname ln in
let _, acc = Mls_mapfold.node_dec funs [] n in
acc
(** @return the list of nodes called by the node named [ln]. This list is
computed lazily the first time it is needed. *)
let called_nodes ln =
if not (LongNameEnv.mem ln info.called_nodes) then (
let called = collect_node_calls ln in
info.called_nodes <- LongNameEnv.add ln called info.called_nodes;
called
) else
LongNameEnv.find ln info.called_nodes
(*
(** Checks that a static expression does not contain any static parameter. *)
let check_no_static_var se =
let static_exp_desc funs acc sed = match sed with
| Svar (Name n) -> Error.message se.se_loc (Error.Evar_unbound n)
| _ -> raise Misc.Fallback
in
let funs = { Global_mapfold.defaults with
static_exp_desc = static_exp_desc } in
ignore (Global_mapfold.static_exp_it funs false se)
*)
(** Generates the list of instances of nodes needed to call
[ln] with static parameters [params]. *)
let rec call_node (ln, params) =
(* First, add the instance for this node *)
let n = node_by_longname ln in
let m = build NamesEnv.empty n.n_params params in
(* List.iter check_no_static_var params; *)
add_node_instance ln params;
(* Recursively generate instances for called nodes. *)
let call_list = called_nodes ln in
let call_list =
List.map (fun (ln, p) -> ln, instantiate m p) call_list in
List.iter call_node call_list
let program p =
(* Find the nodes without static parameters *)
let main_nodes = List.filter (fun n -> is_empty n.n_params) p.p_nodes in
let main_nodes = List.map (fun n -> (longname n.n_name, [])) main_nodes in
info.opened <- NamesEnv.add p.p_modname p NamesEnv.empty;
(* Creates the list of instances starting from these nodes *)
List.iter call_node main_nodes;
let p_list = NamesEnv.fold (fun _ p l -> p::l) info.opened [] in
(* Generate all the needed instances *)
List.map Param_instances.Instantiate.program p_list