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

Use qualnames in Obc too

This commit is contained in:
Cédric Pasteur 2010-09-13 09:03:15 +02:00
parent fd4d0942f4
commit 36addab3cc
4 changed files with 29 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/main/mls2obc.ml
View File

@ -480,7 +480,7 @@ let translate_node
let resetm = { let resetm = {
m_name = Mreset; m_inputs = []; m_outputs = []; m_name = Mreset; m_inputs = []; m_outputs = [];
m_body = mk_block si } in 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_objs = j; cd_methods = [stepm; resetm];
cd_loc = loc } 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) Type_enum (List.map shortname tag_name_list)
| Minils.Type_struct field_ty_list -> | Minils.Type_struct field_ty_list ->
Type_struct field_ty_list in 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; let translate_const_def { Minils.c_name = name; Minils.c_value = se;
Minils.c_type = ty; Minils.c_loc = loc } = Minils.c_type = ty; Minils.c_loc = loc } =
{ c_name = shortname name; { c_name = name;
c_value = se; c_value = se;
c_type = ty; c_type = ty;
c_loc = loc } c_loc = loc }

32
compiler/obc/c/cmain.ml
View File

@ -32,23 +32,24 @@ let assert_node_res cd =
let stepm = find_step_method cd in let stepm = find_step_method cd in
if List.length stepm.m_inputs > 0 then if List.length stepm.m_inputs > 0 then
(Format.eprintf "Cannot generate run-time check for node %s with inputs.@." (Format.eprintf "Cannot generate run-time check for node %s with inputs.@."
cd.cd_name; (cname_of_qn cd.cd_name);
exit 1); exit 1);
if (match stepm.m_outputs with if (match stepm.m_outputs with
| [{ v_type = Tid nbool; }] when nbool = Initial.pbool -> false | [{ v_type = Tid nbool; }] when nbool = Initial.pbool -> false
| _ -> true) then | _ -> true) then
(Format.eprintf (Format.eprintf
"Cannot generate run-time check for node %s with non-boolean output.@." "Cannot generate run-time check for node %s with non-boolean output.@."
cd.cd_name; (cname_of_qn cd.cd_name);
exit 1); exit 1);
let name = cname_of_qn cd.cd_name in
let mem = let mem =
(name (Idents.fresh ("mem_for_" ^ cd.cd_name)), (Idents.name (Idents.fresh ("mem_for_" ^ name)),
Cty_id (cd.cd_name ^ "_mem")) Cty_id (name ^ "_mem"))
and out = and out =
(name (Idents.fresh ("out_for_" ^ cd.cd_name)), (Idents.name (Idents.fresh ("out_for_" ^ name)),
Cty_id (cd.cd_name ^ "_out")) in Cty_id (name ^ "_out")) in
let reset_i = 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 = let step_i =
(* (*
step(&out, &mem); step(&out, &mem);
@ -62,15 +63,15 @@ let assert_node_res cd =
{ var_decls = []; { var_decls = [];
block_body = block_body =
[ [
Csexpr (Cfun_call (cd.cd_name ^ "_step", Csexpr (Cfun_call (name ^ "_step",
[Caddrof (Cvar (fst out)); [Caddrof (Cvar (fst out));
Caddrof (Cvar (fst mem))])); Caddrof (Cvar (fst mem))]));
Cif (Cuop ("!", Clhs (Cfield (Cvar (fst out), outn))), Cif (Cuop ("!", Clhs (Cfield (Cvar (fst out), outn))),
[Csexpr (Cfun_call ("printf", [Csexpr (Cfun_call ("printf",
[Cconst (Cstrlit ("Node \\\"" ^ cd.cd_name [Cconst (Cstrlit ("Node \\\"" ^ name
^ "\\\" failed at step" ^ ^ "\\\" failed at step" ^
" %d.\\n")); " %d.\\n"));
Clhs (Cvar (name step_counter))])); Clhs (Cvar (Idents.name step_counter))]));
Creturn (Cconst (Ccint 1))], Creturn (Cconst (Ccint 1))],
[]); []);
]; ];
@ -176,10 +177,10 @@ let main_def_of_class_def cd =
let printf_calls = List.concat printf_calls in let printf_calls = List.concat printf_calls in
let cinp = cvarlist_of_ovarlist stepm.m_inputs 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 = let varlist =
("mem", Cty_id (cd.cd_name ^ "_mem")) ("mem", Cty_id ((cname_of_qn cd.cd_name) ^ "_mem"))
:: cinp :: cinp
@ cout @ cout
@ concat scanf_decls @ concat scanf_decls
@ -192,7 +193,7 @@ let main_def_of_class_def cd =
let args = let args =
map (fun vd -> Clhs (Cvar (name vd.v_ident))) stepm.m_inputs map (fun vd -> Clhs (Cvar (name vd.v_ident))) stepm.m_inputs
@ [Caddrof (Cvar "res"); Caddrof (Cvar "mem")] in @ [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 concat scanf_calls
@ [Csexpr funcall] @ [Csexpr funcall]
@ printf_calls @ printf_calls
@ -201,7 +202,8 @@ let main_def_of_class_def cd =
(** Do not forget to initialize memory via reset. *) (** Do not forget to initialize memory via reset. *)
let rst_i = 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) (varlist, rst_i, step_l)
@ -254,7 +256,7 @@ let mk_main name p = match (!Misc.simulation_node, !Misc.assert_nodes) with
| (None, []) -> [] | (None, []) -> []
| (_, n_names) -> | (_, n_names) ->
let find_class n = 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 -> with Not_found ->
Format.eprintf "Unknown node %s.\n" n; Format.eprintf "Unknown node %s.\n" n;
exit 1 in exit 1 in

6
compiler/obc/obc.ml
View File

@ -15,13 +15,13 @@ open Types
open Signature open Signature
open Location open Location
type class_name = name type class_name = qualname
type instance_name = qualname type instance_name = qualname
type obj_name = name type obj_name = name
type op_name = qualname type op_name = qualname
type type_dec = type type_dec =
{ t_name : name; { t_name : qualname;
t_desc : tdesc; t_desc : tdesc;
t_loc : location } t_loc : location }
@ -32,7 +32,7 @@ and tdesc =
| Type_struct of structure | Type_struct of structure
type const_dec = { type const_dec = {
c_name : name; c_name : qualname;
c_value : static_exp; c_value : static_exp;
c_type : ty; c_type : ty;
c_loc : location } c_loc : location }

12
compiler/obc/obc_printer.ml
View File

@ -139,7 +139,7 @@ let print_method ff md =
let print_class_def ff let print_class_def ff
{ cd_name = id; cd_mems = mem; cd_objs = objs; cd_methods = m_list } = { cd_name = id; cd_mems = mem; cd_objs = objs; cd_methods = m_list } =
fprintf ff "@[<v 2>machine "; print_name ff id; fprintf ff " =@,"; fprintf ff "@[<v 2>machine "; print_qualname ff id; fprintf ff " =@,";
if mem <> [] then begin if mem <> [] then begin
fprintf ff "@[<hov 4>var "; fprintf ff "@[<hov 4>var ";
print_list_r print_vd "" ";" "" ff mem; 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 } = let print_type_def ff { t_name = name; t_desc = tdesc } =
match tdesc with match tdesc with
| Type_abs -> fprintf ff "@[type %s@\n@]" name | Type_abs -> fprintf ff "@[type %a@\n@]" print_qualname name
| Type_alias ty -> | 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) -> | 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; print_list_r print_name "" "|" "" ff tag_name_list;
fprintf ff "@\n@]" fprintf ff "@\n@]"
| Type_struct(f_ty_list) -> | Type_struct(f_ty_list) ->
fprintf ff "@[type %s = " name; fprintf ff "@[type %a = " print_qualname name;
fprintf ff "@[<v 1>"; fprintf ff "@[<v 1>";
print_list print_list
(fun ff { Signature.f_name = field; Signature.f_type = ty } -> (fun ff { Signature.f_name = field; Signature.f_type = ty } ->
@ -179,7 +179,7 @@ let print_open_module ff name =
fprintf ff "@.@]" fprintf ff "@.@]"
let print_const_dec ff c = 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 print_static_exp c.c_value
let print_prog ff { p_opened = modules; p_types = types; let print_prog ff { p_opened = modules; p_types = types;