From 1491e279f7a5a8bcac284e2abebdc5d838e5da0e Mon Sep 17 00:00:00 2001
From: dsac <arnaud@dabyseesaram.info>
Date: Sun, 18 Dec 2022 13:38:40 +0100
Subject: [PATCH] [ast2C] printer: ok.

---
 src/ast_to_c.ml     | 21 ++++++++++++++-------
 src/cprint.ml       | 26 +++++++++++++++-----------
 src/ctranslation.ml | 29 +++++++++++++++++++++++++----
 src/test2.node      |  6 ++++--
 4 files changed, 58 insertions(+), 24 deletions(-)

diff --git a/src/ast_to_c.ml b/src/ast_to_c.ml
index 37f8f4e..12c7f1e 100644
--- a/src/ast_to_c.ml
+++ b/src/ast_to_c.ml
@@ -2,6 +2,7 @@ open Ast
 open Intermediate_ast
 open Intermediate_utils
 open Cprint
+open Cast
 open Utils
 open Ctranslation
 
@@ -254,13 +255,19 @@ let cp_init_aux_nodes fmt (node, h) =
 
 
 (** [cp_equations] prints the node equations. *)
-let rec cp_equations fmt (eqs, hloc, h) =
-  match eqs with
-  | [] -> ()
-  | eq :: eqs ->
-    Format.fprintf fmt "%a%a"
-      cp_expression (equation_to_expression (hloc, h, eq), hloc.nt_map)
-      cp_equations (eqs, hloc, h)
+let cp_equations fmt (eqs, hloc, h) =
+  (** [main_block] is modified through some optimization passes, eg:
+    * - merge two CIf blocks using the same condition
+    * - replace [if (! c) { b1 } else {b2 }] by [if(c) { b2 } else { b1 }]
+    *
+    *  These passes are defined in [ctranslation.ml]
+      *)
+  let main_block: c_block =
+    List.map (fun eq -> equation_to_expression (hloc, h, eq)) eqs in
+  let main_block = remove_ifnot main_block in
+  let main_block = merge_neighbour_ifs main_block in
+  Format.fprintf fmt "\t/*Main code :*/\n%a"
+    cp_block (main_block, hloc.nt_map)
 
 (** [cp_node] prints a single node *)
 let cp_node fmt (node, h) =
diff --git a/src/cprint.ml b/src/cprint.ml
index 43767da..eab8edb 100644
--- a/src/cprint.ml
+++ b/src/cprint.ml
@@ -151,12 +151,13 @@ let prefix_ = ref "\t"
 
 (** The following function prints one transformed equation of the program into a
   * set of instruction ending in assignments. *)
-let rec cp_expression fmt (expr, hloc) =
+let rec cp_block fmt (b, hloc) =
+  match b with
+  | [] -> ()
+  | e :: b ->
+    Format.fprintf fmt "%a%a" cp_expression (e, hloc) cp_block (b, hloc)
+and cp_expression fmt (expr, hloc) =
   let prefix = !prefix_ in
-  let rec cp_block fmt = function
-    | [] -> ()
-    | e :: b -> Format.fprintf fmt "%a%a" cp_expression (e, hloc) cp_block b
-  in
   match expr with
   | CAssign (CVStored (arr, idx), value) ->
     begin
@@ -195,15 +196,18 @@ let rec cp_expression fmt (expr, hloc) =
       Format.fprintf fmt "%sif (%a) {\n%a%s}\n"
         p
         cp_value (v, hloc)
-        cp_block b1
+        cp_block (b1, hloc)
         p;
         prefix_ := p
   | CIf (v, b1, b2) ->
+      let p = prefix in
+      prefix_ := prefix^"\t";
       Format.fprintf fmt "%sif (%a) {\n%a%s} else {\n%a%s}\n"
-        prefix
+        p
         cp_value (v, hloc)
-        cp_block b1
-        prefix
-        cp_block b2
-        prefix
+        cp_block (b1, hloc)
+        p
+        cp_block (b2, hloc)
+        p;
+      prefix_  := p
 
diff --git a/src/ctranslation.ml b/src/ctranslation.ml
index 5433596..bc8959b 100644
--- a/src/ctranslation.ml
+++ b/src/ctranslation.ml
@@ -74,8 +74,29 @@ let rec equation_to_expression (node_st, node_sts, (vl, expr)) =
             [equation_to_expression (node_st, node_sts, (vl, expr))],
             [])
     end
-  (*TODO!
-  | IETriOp of triop * i_expression * i_expression * i_expression
-  | IEReset of i_expression * i_expression*)
-  | _ -> failwith "[ctranslation.ml] TODO!"
+  | IETriOp (TOp_if, _, _, _) ->
+      failwith "[ctranslation.ml] A pass should have turned conditionnals into merges."
+  | IETriOp (TOp_merge, c, e, e') ->
+      CIf (iexpression_to_cvalue c,
+        [equation_to_expression (node_st, node_sts, (vl, e))],
+        [equation_to_expression (node_st, node_sts, (vl, e'))])
+  | IEReset _ -> failwith "[ctranslation.ml] A pass should have removed resets."
 
+
+
+let rec remove_ifnot = function
+  | [] -> []
+  | CIf (CMonOp (MOp_not, c), bh :: bt, b'h :: b't) :: block ->
+      (CIf (c, b'h :: b't, bh :: bt)) :: (remove_ifnot block )
+  | stmt :: block ->
+      stmt :: (remove_ifnot block)
+
+let rec merge_neighbour_ifs = function
+  | [] -> []
+  | [stmt] -> [stmt]
+  | CIf (c, e1, e2) :: CIf (c', e'1, e'2) :: b ->
+      if c = c'
+        then merge_neighbour_ifs (CIf (c, e1 @ e'1, e2 @ e'2) :: b)
+        else (CIf (c, e1, e2)) :: merge_neighbour_ifs (CIf (c', e'1, e'2) :: b)
+  | stmt :: stmt' :: b ->
+      stmt :: merge_neighbour_ifs (stmt' :: b)
diff --git a/src/test2.node b/src/test2.node
index a88c1e6..ac054f7 100644
--- a/src/test2.node
+++ b/src/test2.node
@@ -5,9 +5,11 @@ let
 tel
 
 node n (i: int) returns (o1, o2: int);
-var t1, t2: int; c: bool;
+var u1, u2, t1, t2: int; c: bool;
 let
   c = true -> not pre c;
   (t1, t2) = aux (i) when c;
-  (o1, o2) = aux (i);
+  (u1, u2) = aux (i) when (not c);
+  o1 = merge c t1 u1;
+  o2 = merge c t2 u2;
 tel