From 0d9a35a8b653113c46b0d0e3ae56bb63d902a386 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Tue, 13 Jul 2010 15:37:29 +0200 Subject: [PATCH] Fixed Callgraph_mapfold --- compiler/global/modules.ml | 10 +++-- compiler/minils/main/mls2seq.ml | 42 +++++++++---------- .../transformations/callgraph_mapfold.ml | 19 +++++---- compiler/utilities/global/compiler_utils.ml | 4 +- 4 files changed, 41 insertions(+), 34 deletions(-) diff --git a/compiler/global/modules.ml b/compiler/global/modules.ml index 54b902d..e1b5779 100644 --- a/compiler/global/modules.ml +++ b/compiler/global/modules.ml @@ -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) diff --git a/compiler/minils/main/mls2seq.ml b/compiler/minils/main/mls2seq.ml index ca1235d..6251103 100644 --- a/compiler/minils/main/mls2seq.ml +++ b/compiler/minils/main/mls2seq.ml @@ -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 *) diff --git a/compiler/minils/transformations/callgraph_mapfold.ml b/compiler/minils/transformations/callgraph_mapfold.ml index 6e7d65e..97a1abe 100644 --- a/compiler/minils/transformations/callgraph_mapfold.ml +++ b/compiler/minils/transformations/callgraph_mapfold.ml @@ -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 = diff --git a/compiler/utilities/global/compiler_utils.ml b/compiler/utilities/global/compiler_utils.ml index a7e9cba..3ff7bc4 100644 --- a/compiler/utilities/global/compiler_utils.ml +++ b/compiler/utilities/global/compiler_utils.ml @@ -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