Use qualnames in Obc too
This commit is contained in:
parent
fd4d0942f4
commit
36addab3cc
|
@ -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,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
|
||||||
|
|
|
@ -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 }
|
||||||
|
|
|
@ -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;
|
||||||
|
|
Loading…
Reference in a new issue