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

Fixed Callgraph_mapfold

Browse source
This commit is contained in:
Cédric Pasteur 2010-07-13 15:37:29 +02:00
parent dab569d8ad
commit 0d9a35a8b6
4 changed files with 41 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
compiler/global/modules.ml
View file

@ -143,9 +143,13 @@ let add_const f n =
let add_value_by_longname ln signature =
match ln with
| Modname { qual = modname; id = f } ->
let m = NamesEnv.find modname modules.modules in
if NamesEnv.mem f m.values then raise Already_defined;
m.values <- NamesEnv.add f signature m.values
let m =
if modname = current.name then
current
else
NamesEnv.find modname modules.modules in
if not (NamesEnv.mem f m.values) then
m.values <- NamesEnv.add f signature m.values
| Name _ -> raise Not_found
let find_value = find (fun ident m -> NamesEnv.find ident m.values)

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

@ -36,30 +36,28 @@ let write_obc_file p =
Obc_printer.print obc p;
close_out obc
let targets = [ ("obc", (Obc, Obc_fun write_obc_file));
("epo", (Minils, Mls_fun write_object_file));
("c", (Obc_no_params, Obc_fun Cmain.program));
(* ("java", (Obc, Javamain.program));
("vhdl", (Minils_no_params, Vhdl.program)) *)]
let targets = [ "c", (Obc_no_params, Obc_fun Cmain.program);
"obc", (Obc, Obc_fun write_obc_file);
"obc_np", (Obc_no_params, Obc_fun write_obc_file);
"epo", (Minils, Mls_fun write_object_file) ]
let generate_target p s =
try
let source, convert_fun = List.assoc s targets in
match source, convert_fun with
| Minils, Mls_fun convert_fun ->
convert_fun p
| Obc, Obc_fun convert_fun ->
let o = Mls2obc.program p in
convert_fun o
| Minils_no_params, Mls_fun convert_fun ->
let p_list = Callgraph_mapfold.program p in
List.iter convert_fun p_list
| Obc_no_params, Obc_fun convert_fun ->
let p_list = Callgraph_mapfold.program p in
let o_list = List.map Mls2obc.program p_list in
List.iter convert_fun o_list
with
| Not_found -> language_error s
let source, convert_fun =
(try List.assoc s targets
with Not_found -> language_error s; raise Error) in
match source, convert_fun with
| Minils, Mls_fun convert_fun ->
convert_fun p
| Obc, Obc_fun convert_fun ->
let o = Mls2obc.program p in
convert_fun o
| Minils_no_params, Mls_fun convert_fun ->
let p_list = Callgraph_mapfold.program p in
List.iter convert_fun p_list
| Obc_no_params, Obc_fun convert_fun ->
let p_list = Callgraph_mapfold.program p in
let o_list = List.map Mls2obc.program p_list in
List.iter convert_fun o_list
let program p =
(* Translation into dataflow and sequential languages *)

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

@ -42,6 +42,7 @@ let info =
nodes_names = Hashtbl.create 100 }
let load_object_file modname =
Modules.open_module modname;
let name = String.uncapitalize modname in
try
let filename = Modules.findfile (name ^ ".epo") in
@ -83,7 +84,9 @@ let node_by_longname ln =
let collect_node_calls ln =
let edesc funs acc ed = match ed with
| Eapp ({ a_op = (Enode ln | Efun ln); a_params = params }, _, _) ->
ed, (ln, params)::acc
(match ln with
| Modname { qual = "Pervasives" } -> ed, acc
| _ -> ed, (ln, params)::acc)
| _ -> raise Misc.Fallback
in
let funs = { Mls_mapfold.mls_funs_default with
@ -133,15 +136,17 @@ struct
Error.message no_location (Error.Evar_unbound n))
| Modname _ -> se) in
se, m
| _ -> raise Misc.Fallback
| _ -> Global_mapfold.static_exp funs m se
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 params = List.map (simplify m) params in
Eapp ({ app with a_op = Efun (node_for_params_call ln params);
a_params = [] }, e_list, r)
| Eapp ({ a_op = Enode ln; a_params = params } as app, e_list, r) ->
let params = List.map (simplify m) params in
Eapp ({ app with a_op = Enode (node_for_params_call ln params);
a_params = [] }, e_list, r)
| _ -> ed
@ -149,15 +154,14 @@ struct
let generate_new_name ln params =
match params with
| [] -> ln
| [] -> Hashtbl.add info.nodes_names (ln, params) ln
| _ ->
(match ln with
| Modname { qual = q; id = id } ->
let new_ln =
Modname { qual = q;
id = id ^ (Ident.name (Ident.fresh "")) } in
Hashtbl.add info.nodes_names (ln, params) new_ln;
new_ln
Hashtbl.add info.nodes_names (ln, params) new_ln
| _ -> assert false)
let node_dec_instance modname n params =
@ -172,7 +176,7 @@ struct
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 ln = generate_new_name ln params in
let ln = node_for_params_call ln params in
Modules.add_value_by_longname ln node_sig;
n
@ -200,10 +204,11 @@ let rec call_node (ln, params) =
let params = List.map (simplify m) params in
List.iter check_no_static_var params;
add_node_instance ln params;
Instantiate.generate_new_name ln params;
let call_list = called_nodes ln in
let call_list = List.map
(fun (ln, p) -> ln, List.map (static_exp_subst m) p) call_list in
(fun (ln, p) -> ln, List.map (simplify m) p) call_list in
List.iter call_node call_list
let program p =

4
compiler/utilities/global/compiler_utils.ml
View file

@ -19,7 +19,7 @@ let syntax_error loc =
raise Error
let language_error lang =
Printf.eprintf "Unknown language: %s.\n" lang
Printf.eprintf "Unknown language: '%s'.\n" lang
let comment s =
if !verbose then Printf.printf "** %s done **\n" s; flush stdout
@ -51,7 +51,7 @@ let build_path suf =
| Some path -> Filename.concat path suf
let filename_of_name n =
n
String.uncapitalize n
let clean_dir dir =
if Sys.file_exists dir && Sys.is_directory dir