From 0435a2420d18d70b440acaeb48b144d2d4d9c808 Mon Sep 17 00:00:00 2001
From: Adrien Guatto <adrien@guatto.org>
Date: Fri, 12 Oct 2018 15:25:01 +0200
Subject: [PATCH] Fix miscompilation of Pervasives.xor to C

---
 compiler/obc/c/cgen.ml | 57 ++++++++++++++++++++++++++++--------------
 test/good/t20.ept      |  9 +++++++
 2 files changed, 47 insertions(+), 19 deletions(-)
 create mode 100644 test/good/t20.ept

diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml
index 4d8932f..9277b74 100644
--- a/compiler/obc/c/cgen.ml
+++ b/compiler/obc/c/cgen.ml
@@ -122,15 +122,39 @@ let rec ctype_of_otype oty =
     | Tprod _ -> assert false
     | Tinvalid -> assert false
 
-let copname = function
-  | "="  -> "==" | "<>" -> "!=" | "&"  -> "&&" | "or" -> "||" | "+" -> "+"
-  | "-" -> "-" | "*" -> "*" | "/" -> "/" | "*." -> "*" | "/." -> "/"
-  | "+." -> "+" | "-." -> "-" | "<"  -> "<" | ">"  -> ">" | "<=" -> "<="
-  | ">=" -> ">=" | "<=." -> "<=" | "<." -> "<" | ">=." -> ">=" | ">." -> ">"
-  | "~-" -> "-" | "not" -> "!" | "%" -> "%"
-  | ">>>" -> ">>" | "<<<" -> "<<" | "&&&" -> "&" | "|||" -> "|"
-  | op   -> op
+let (has_native_c_op, native_c_op_of) =
+  let assl =
+    [
+      (["~-"; "~-."], "-");
+      (["~~"], "~");
+      (["not"], "!");
 
+      (["="], "==");
+      (["<>"], "!=");
+      (["&"], "&&");
+      (["or"], "||");
+      (["xor"], "^");
+
+      (["+"; "+."], "+");
+      (["-"; "-."], "-");
+      (["*"; "*."], "*");
+      (["/"; "/."], "/");
+      (["%"], "%");
+
+      (["<"; "<."], "<");
+      (["<="; "<="], "<=");
+      ([">"; ">."], ">");
+      ([">="; ">=."], ">=");
+
+      ([">>>"], ">>");
+      (["<<<"], "<<");
+      (["&&&"], "&");
+      (["|||"], "|");
+    ]
+  in
+  let ht = Hashtbl.create (List.length assl) in
+  List.iter (fun (xl, y) -> List.iter (fun x -> Hashtbl.add ht x y) xl) assl;
+  Hashtbl.mem ht, Hashtbl.find ht
 
 let cformat_of_format s =
   let aux m = match m with
@@ -301,19 +325,14 @@ and cexprs_of_exps out_env var_env exps =
 and cop_of_op_aux op_name cexps = match op_name with
     | { qual = Pervasives; name = op } ->
         begin match op,cexps with
-          | ("~-" | "~-."), [e] -> Cuop ("-", e)
-          | ("~~"), [e] -> Cuop ("~", e)
-          | "not", [e] -> Cuop ("!", e)
-          | (
-              "=" | "<>"
-            | "&" | "or"
-            | "+" | "-" | "*" | "/"
-            | "*." | "/." | "+." | "-." | "%" | "<<<" | ">>>" | "&&&" | "|||"
-            | "<" | ">" | "<=" | ">=" | "<=." | "<." | ">=." | ">."), [el;er] ->
-             Cbop (copname op, el, er)
           | "=>", [el;er] ->
              Cbop ("||", (Cuop("!",el)), er)
-          | _ -> Cfun_call(op, cexps)
+          | uop, [e] when has_native_c_op op ->
+             Cuop (native_c_op_of uop, e)
+          | bop, [el;er] when has_native_c_op op ->
+             Cbop (native_c_op_of bop, el, er)
+          | _ ->
+             Cfun_call (op, cexps)
         end
     | { qual = Module "Iostream"; name = "printf" } ->
       let s, args = assert_1min cexps in
diff --git a/test/good/t20.ept b/test/good/t20.ept
new file mode 100644
index 0000000..7e44d6e
--- /dev/null
+++ b/test/good/t20.ept
@@ -0,0 +1,9 @@
+fun test(x, y : bool) returns (o : bool)
+let
+  o = x xor y;
+tel
+
+node main() returns (ok : bool)
+let
+  ok = test(true, true) = test(true, false) = test(false, true);
+tel