Use qualnames in Obc too

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 }

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

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 }

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 "@[<v 2>machine "; print_name ff id; fprintf ff " =@,";
+  fprintf ff "@[<v 2>machine "; print_qualname ff id; fprintf ff " =@,";
   if mem <> [] then begin
     fprintf ff "@[<hov 4>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 "@[<v 1>";
         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;