From cbcf8b9ac0678a86377b30fab47295170d54d5ce Mon Sep 17 00:00:00 2001
From: Nicolas Berthier <nicolas.berthier@inria.fr>
Date: Thu, 13 Nov 2014 09:43:05 +0100
Subject: [PATCH] Using unqualified names for string representation of
 constructors in C backend.

+ minor modifications in various places.
---
 compiler/heptagon/ctrln/ctrlNbacAsEpt.ml | 5 ++++-
 compiler/main/mls2obc.ml                 | 4 +---
 compiler/minils/ctrln/ctrlNbacGen.ml     | 2 +-
 compiler/obc/c/cgen.ml                   | 8 ++++----
 4 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml b/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml
index c22a649..508226b 100644
--- a/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml
+++ b/compiler/heptagon/ctrln/ctrlNbacAsEpt.ml
@@ -82,7 +82,10 @@ let symb_typ' gd s = translate_typ gd s (symb_typ gd s)
 
 let translate_label gd l = gd.qname (Symb.to_string (label_symb l))
 
-let ts gd v = SMap.find v gd.var_names
+let ts gd v = try SMap.find v gd.var_names with Not_found ->
+  failwith (Format.asprintf "Variable name `%a' unavailable; \
+                             was it an output of the main node?"
+              Symb.print v)
 
 let pat_of_var gd v = Evarpat (ts gd v)
 
diff --git a/compiler/main/mls2obc.ml b/compiler/main/mls2obc.ml
index 723991e..2a22c43 100644
--- a/compiler/main/mls2obc.ml
+++ b/compiler/main/mls2obc.ml
@@ -66,9 +66,7 @@ let var_from_name map x =
         assert false
   end
 
-let ext_value_exp_from_name map x =
-  let w = ext_value_of_pattern (var_from_name map x) in
-  mk_exp w.w_ty (Eextvalue w)
+let ext_value_exp_from_name map x = exp_of_pattern (var_from_name map x)
 
 (* let lvar_from_name map ty x = mk_pattern ty (Lvar (var_from_name map x)) *)
 
diff --git a/compiler/minils/ctrln/ctrlNbacGen.ml b/compiler/minils/ctrln/ctrlNbacGen.ml
index 6e8c8bd..bf48cf3 100644
--- a/compiler/minils/ctrln/ctrlNbacGen.ml
+++ b/compiler/minils/ctrln/ctrlNbacGen.ml
@@ -397,7 +397,7 @@ let translate_contract ~pref gd
   let gd, ok, locals =                  (* Generate error variable if needed: *)
     if !Compiler_options.nosink
     then (gd, ok, locals)
-    else let sink = gen_var "cn" "error_state" in
+    else let sink = gen_var "cn" "ok" in
          let sink_expr = mk_bref' & pref & mk_symb & name sink in
          let ok = `Bexp (mk_bcond' gd.init_cond tt ok) in
          (add_state_var ~pref gd sink Initial.tbool ok None, sink_expr,
diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml
index eb167e3..d4c01c7 100644
--- a/compiler/obc/c/cgen.ml
+++ b/compiler/obc/c/cgen.ml
@@ -795,9 +795,9 @@ let cdefs_and_cdecls_of_type_decl otd =
               { var_decls = [];
                 block_body =
                   let gen_if t =
-                    let t = cname_of_qn t in
+                    let t = cname_of_qn t and t' = t.name in
                     let funcall = Cfun_call ("strcmp", [Cvar "s";
-                                                        Cconst (Cstrlit t)]) in
+                                                        Cconst (Cstrlit t')]) in
                     let cond = Cbop ("==", funcall, Cconst (Ccint 0)) in
                     Cif (cond, [Creturn (Cconst (Ctag t))], []) in
                   map gen_if nl; }
@@ -810,10 +810,10 @@ let cdefs_and_cdecls_of_type_decl otd =
               { var_decls = [];
                 block_body =
                   let gen_clause t =
-                    let t = cname_of_qn t in
+                    let t = cname_of_qn t and t' = t.name in
                     let fun_call =
                       Cfun_call ("strcpy", [Cvar "buf";
-                                            Cconst (Cstrlit t)]) in
+                                            Cconst (Cstrlit t')]) in
                     (t, [Csexpr fun_call]) in
                   [Cswitch (Cvar "x", map gen_clause nl);
                    Creturn (Cvar "buf")]; }