From 36addab3cc3a657aa544b3e9c8d74757d50b1795 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Mon, 13 Sep 2010 09:03:15 +0200 Subject: [PATCH] Use qualnames in Obc too --- compiler/main/mls2obc.ml | 6 +++--- compiler/obc/c/cmain.ml | 32 +++++++++++++++++--------------- compiler/obc/obc.ml | 6 +++--- compiler/obc/obc_printer.ml | 12 ++++++------ 4 files changed, 29 insertions(+), 27 deletions(-) diff --git a/compiler/main/mls2obc.ml b/compiler/main/mls2obc.ml index 85a41d9..ec324aa 100644 --- a/compiler/main/mls2obc.ml +++ b/compiler/main/mls2obc.ml @@ -480,7 +480,7 @@ let translate_node let resetm = { m_name = Mreset; m_inputs = []; m_outputs = []; m_body = mk_block si } in - { cd_name = shortname f; cd_mems = m; cd_params = params; + { cd_name = f; cd_mems = m; cd_params = params; cd_objs = j; cd_methods = [stepm; resetm]; cd_loc = loc } @@ -493,11 +493,11 @@ let translate_ty_def { Minils.t_name = name; Minils.t_desc = tdesc; Type_enum (List.map shortname tag_name_list) | Minils.Type_struct field_ty_list -> Type_struct field_ty_list in - { t_name = shortname name; t_desc = tdesc; t_loc = loc } + { t_name = name; t_desc = tdesc; t_loc = loc } let translate_const_def { Minils.c_name = name; Minils.c_value = se; Minils.c_type = ty; Minils.c_loc = loc } = - { c_name = shortname name; + { c_name = name; c_value = se; c_type = ty; c_loc = loc } diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml index a1d4931..c6bd383 100644 --- a/compiler/obc/c/cmain.ml +++ b/compiler/obc/c/cmain.ml @@ -32,23 +32,24 @@ let assert_node_res cd = let stepm = find_step_method cd in if List.length stepm.m_inputs > 0 then (Format.eprintf "Cannot generate run-time check for node %s with inputs.@." - cd.cd_name; + (cname_of_qn cd.cd_name); exit 1); if (match stepm.m_outputs with | [{ v_type = Tid nbool; }] when nbool = Initial.pbool -> false | _ -> true) then (Format.eprintf "Cannot generate run-time check for node %s with non-boolean output.@." - cd.cd_name; + (cname_of_qn cd.cd_name); exit 1); + let name = cname_of_qn cd.cd_name in let mem = - (name (Idents.fresh ("mem_for_" ^ cd.cd_name)), - Cty_id (cd.cd_name ^ "_mem")) + (Idents.name (Idents.fresh ("mem_for_" ^ name)), + Cty_id (name ^ "_mem")) and out = - (name (Idents.fresh ("out_for_" ^ cd.cd_name)), - Cty_id (cd.cd_name ^ "_out")) in + (Idents.name (Idents.fresh ("out_for_" ^ name)), + Cty_id (name ^ "_out")) in let reset_i = - Cfun_call (cd.cd_name ^ "_reset", [Caddrof (Cvar (fst mem))]) in + Cfun_call (name ^ "_reset", [Caddrof (Cvar (fst mem))]) in let step_i = (* step(&out, &mem); @@ -62,15 +63,15 @@ let assert_node_res cd = { var_decls = []; block_body = [ - Csexpr (Cfun_call (cd.cd_name ^ "_step", + Csexpr (Cfun_call (name ^ "_step", [Caddrof (Cvar (fst out)); Caddrof (Cvar (fst mem))])); Cif (Cuop ("!", Clhs (Cfield (Cvar (fst out), outn))), [Csexpr (Cfun_call ("printf", - [Cconst (Cstrlit ("Node \\\"" ^ cd.cd_name + [Cconst (Cstrlit ("Node \\\"" ^ name ^ "\\\" failed at step" ^ " %d.\\n")); - Clhs (Cvar (name step_counter))])); + Clhs (Cvar (Idents.name step_counter))])); Creturn (Cconst (Ccint 1))], []); ]; @@ -176,10 +177,10 @@ let main_def_of_class_def cd = let printf_calls = List.concat printf_calls in let cinp = cvarlist_of_ovarlist stepm.m_inputs in - let cout = ["res", (Cty_id (cd.cd_name ^ "_out"))] in + let cout = ["res", (Cty_id ((cname_of_qn cd.cd_name) ^ "_out"))] in let varlist = - ("mem", Cty_id (cd.cd_name ^ "_mem")) + ("mem", Cty_id ((cname_of_qn cd.cd_name) ^ "_mem")) :: cinp @ cout @ concat scanf_decls @@ -192,7 +193,7 @@ let main_def_of_class_def cd = let args = map (fun vd -> Clhs (Cvar (name vd.v_ident))) stepm.m_inputs @ [Caddrof (Cvar "res"); Caddrof (Cvar "mem")] in - Cfun_call (cd.cd_name ^ "_step", args) in + Cfun_call ((cname_of_qn cd.cd_name) ^ "_step", args) in concat scanf_calls @ [Csexpr funcall] @ printf_calls @@ -201,7 +202,8 @@ let main_def_of_class_def cd = (** Do not forget to initialize memory via reset. *) let rst_i = - Csexpr (Cfun_call (cd.cd_name ^ "_reset", [Caddrof (Cvar "mem")])) in + Csexpr (Cfun_call ((cname_of_qn cd.cd_name) ^ "_reset", + [Caddrof (Cvar "mem")])) in (varlist, rst_i, step_l) @@ -254,7 +256,7 @@ let mk_main name p = match (!Misc.simulation_node, !Misc.assert_nodes) with | (None, []) -> [] | (_, n_names) -> let find_class n = - try List.find (fun cd -> cd.cd_name = n) p.p_defs + try List.find (fun cd -> cd.cd_name.name = n) p.p_defs with Not_found -> Format.eprintf "Unknown node %s.\n" n; exit 1 in diff --git a/compiler/obc/obc.ml b/compiler/obc/obc.ml index a661732..305243b 100644 --- a/compiler/obc/obc.ml +++ b/compiler/obc/obc.ml @@ -15,13 +15,13 @@ open Types open Signature open Location -type class_name = name +type class_name = qualname type instance_name = qualname type obj_name = name type op_name = qualname type type_dec = - { t_name : name; + { t_name : qualname; t_desc : tdesc; t_loc : location } @@ -32,7 +32,7 @@ and tdesc = | Type_struct of structure type const_dec = { - c_name : name; + c_name : qualname; c_value : static_exp; c_type : ty; c_loc : location } diff --git a/compiler/obc/obc_printer.ml b/compiler/obc/obc_printer.ml index 83d5b9f..7e655cc 100644 --- a/compiler/obc/obc_printer.ml +++ b/compiler/obc/obc_printer.ml @@ -139,7 +139,7 @@ let print_method ff md = let print_class_def ff { cd_name = id; cd_mems = mem; cd_objs = objs; cd_methods = m_list } = - fprintf ff "@[machine "; print_name ff id; fprintf ff " =@,"; + fprintf ff "@[machine "; print_qualname ff id; fprintf ff " =@,"; if mem <> [] then begin fprintf ff "@[var "; print_list_r print_vd "" ";" "" ff mem; @@ -156,15 +156,15 @@ let print_class_def ff let print_type_def ff { t_name = name; t_desc = tdesc } = match tdesc with - | Type_abs -> fprintf ff "@[type %s@\n@]" name + | Type_abs -> fprintf ff "@[type %a@\n@]" print_qualname name | Type_alias ty -> - fprintf ff "@[type %s@ = %a@\n@]" name print_type ty + fprintf ff "@[type %a@ = %a@\n@]" print_qualname name print_type ty | Type_enum(tag_name_list) -> - fprintf ff "@[type %s = " name; + fprintf ff "@[type %a = " print_qualname name; print_list_r print_name "" "|" "" ff tag_name_list; fprintf ff "@\n@]" | Type_struct(f_ty_list) -> - fprintf ff "@[type %s = " name; + fprintf ff "@[type %a = " print_qualname name; fprintf ff "@["; print_list (fun ff { Signature.f_name = field; Signature.f_type = ty } -> @@ -179,7 +179,7 @@ let print_open_module ff name = fprintf ff "@.@]" let print_const_dec ff c = - fprintf ff "const %a = %a@." print_name c.c_name + fprintf ff "const %a = %a@." print_qualname c.c_name print_static_exp c.c_value let print_prog ff { p_opened = modules; p_types = types;