[ast2C] support for some basic operations (exemple in test.node)

src/ast_to_c.ml

@@ -14,7 +14,7 @@ let ast_to_intermediate_ast (nodes: t_nodelist) (h: node_states): i_nodelist =
   let rec ast_to_intermediate_ast_expr hloc = function
     | EVar   (_, v) ->
         begin
-        match Hashtbl.find_opt hloc (v, false) with
+        match Hashtbl.find_opt hloc (Utils.name_of_var v, false) with
         | None -> IEVar (CVInput (name_of_var v))
         | Some (s, i) -> IEVar (CVStored (s, i))
         end
@@ -77,8 +77,10 @@ let make_state_types nodes: node_states =
         (snd (varlist_concat (varlist_concat node.n_inputs node.n_outputs) node.n_local_vars)) in
     let pre_vars =
       List.filter (fun v -> List.mem v pv) all_vars in
+    let vars = List.map Utils.name_of_var vars in
+    let pre_vars = List.map Utils.name_of_var pre_vars in
     let nb = (List.length vars) + (List.length pre_vars) in
-    let tyh = Hashtbl.create nb in
+    let tyh: (ident * bool, int) Hashtbl.t = Hashtbl.create nb in
     let i =
       List.fold_left
         (fun i v -> let () = Hashtbl.add tyh (v, false) i in i + 1) 0 vars in
@@ -162,14 +164,14 @@ let make_state_types nodes: node_states =
         let () = List.iteri
           (fun n (v: t_var) ->
             match v with
-            | IVar _ ->
+            | IVar s ->
-                let i = Hashtbl.find h_int (v, false) in
+                let i = Hashtbl.find h_int (s, false) in
                 Hashtbl.add h_out n ("ivars", i)
-            | BVar _ ->
+            | BVar s ->
-                let i = Hashtbl.find h_bool (v, false) in
+                let i = Hashtbl.find h_bool (s, false) in
                 Hashtbl.add h_out n ("bvars", i)
-            | RVar _ ->
+            | RVar s ->
-                let i = Hashtbl.find h_real (v, false) in
+                let i = Hashtbl.find h_real (s, false) in
                 Hashtbl.add h_out n ("rvars", i))
           (snd node.n_outputs) in
         let () = Hashtbl.add h node_name
@@ -217,9 +219,9 @@ let cp_prevars fmt (node, h) =
           | None -> 
             let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in
             Format.fprintf fmt "\t%s[%d] = %s;\n"
-              dst_array dst_idx (Utils.name_of_var v)
+              dst_array dst_idx v
           )
-        l
+        (List.map Utils.name_of_var l)
 
 
 
@@ -257,7 +259,7 @@ let rec cp_equations fmt (eqs, hloc) =
   | [] -> ()
   | eq :: eqs ->
     Format.fprintf fmt "%a%a"
-      cp_expression (equation_to_expression (hloc.nt_map, eq), hloc)
+      cp_expression (equation_to_expression (hloc.nt_map, eq), hloc.nt_map)
       cp_equations (eqs, hloc)
 
 (** [cp_node] prints a single node *)
@@ -284,20 +286,10 @@ let dump_var_locations (st: node_states) =
     (fun n st ->
       Format.printf "\n\n\tNODE: %s\n" n;
     Hashtbl.iter
-    (fun ((v: t_var), (ispre: bool)) ((arr: string), (idx: int)) ->
+    (fun (s, (ispre: bool)) ((arr: string), (idx: int)) ->
-      match v, ispre with
+      match ispre with
-      | IVar s, true -> Format.printf "PRE Variable (int) %s stored as %s[%d]\n"
+      | true -> Format.printf "PRE Variable %s stored as %s[%d]\n" s arr idx
-                          s arr idx
+      | false -> Format.printf "    Variable %s stored as %s[%d]\n" s arr idx)
-      | BVar s, true -> Format.printf "PRE Variable (bool) %s stored as %s[%d]\n"
-                          s arr idx
-      | RVar s, true -> Format.printf "PRE Variable (real) %s stored as %s[%d]\n"
-                          s arr idx
-      | IVar s, false -> Format.printf "Variable (int) %s stored as %s[%d]\n"
-                          s arr idx
-      | BVar s, false -> Format.printf "Variable (bool) %s stored as %s[%d]\n"
-                          s arr idx
-      | RVar s, false -> Format.printf "Variable (real) %s stored as %s[%d]\n"
-                          s arr idx)
     st.nt_map)
     st;
     Format.printf "\n\n"

src/cprint.ml

@@ -79,23 +79,35 @@ let rec cp_prototypes fmt ((nodes, h): i_nodelist * node_states) =
 
 
 
-let cp_value fmt value =
+let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) =
   match value with
   | CVariable (CVInput s) -> Format.fprintf fmt "%s" s
-  | CVariable (CVStored (arr, idx)) ->
+  | CVariable (CVStored (arr, idx)) -> Format.fprintf fmt "%s[%d]" arr idx
-      Format.fprintf fmt "%s[%d]" arr idx
   | CConst (CInt i) -> Format.fprintf fmt "%d" i
   | CConst (CBool true) -> Format.fprintf fmt "true"
   | CConst (CBool false) -> Format.fprintf fmt "false"
   | CConst (CReal r) -> Format.fprintf fmt "%f" r
-  (**| CMonOp of monop * c_value
+  | CMonOp (MOp_not, v) -> Format.fprintf fmt "! (%a)" cp_value (v, hloc)
-  | CBinOp of binop * c_value * c_value
+  | CMonOp (MOp_minus, v) -> Format.fprintf fmt "- (%a)" cp_value (v, hloc)
-  | CComp of compop * c_value * c_value*)
+  | CMonOp (MOp_pre, (CVariable v)) ->
+      let varname = (match v with
+                    | CVStored (arr, idx) ->
+                      begin
+                        match find_varname hloc (arr, idx) with
+                        | None -> failwith "[cprint.ml] This varname should be defined."
+                        | Some (n, _) -> n
+                      end
+                    | CVInput n -> n) in
+      let (arr, idx) = Hashtbl.find hloc (varname, true) in
+      Format.fprintf fmt "%s[%d]" arr idx
+  | CBinOp (BOp_add, v, v') ->
+      Format.fprintf fmt "(%a) + (%a)"
+        cp_value (v, hloc) cp_value (v', hloc)
+  (**| CComp of compop * c_value * c_value*)
   | _ -> failwith "[cprint.ml] TODO!"
 
 
 
-
 (** The following function prints one transformed equation of the program into a
   * set of instruction ending in assignments. *)
 let cp_expression fmt (expr, hloc) =
@@ -104,7 +116,7 @@ let cp_expression fmt (expr, hloc) =
   | CAssign (CVStored (arr, idx), value) ->
     begin
       Format.fprintf fmt "%s%s[%d] = %a;\n"
-        prefix arr idx cp_value value
+        prefix arr idx cp_value (value, hloc)
     end
   | CAssign (CVInput _, _) -> failwith "should not happend."
   (*| CSeq of c_expression * c_expression

src/ctranslation.ml

@@ -2,14 +2,27 @@ open Ast
 open Intermediate_ast
 open Cast
 
-let iexpression_to_cvalue e = ()
+let rec iexpression_to_cvalue e =
+  match e with
+  | IEVar   v -> CVariable v
+  | IEMonOp (op, e) -> CMonOp (op, iexpression_to_cvalue e)
+  | IEBinOp (op, e, e') ->
+      CBinOp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
+  | IEComp  (op, e, e') ->
+      CComp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
+  | IEConst c -> CConst c
+  | IEWhen  _
+  | IEReset _
+  | IETuple _
+  | IEApp   _
+  | IETriOp _ -> failwith "[ctranslation.ml] Should not happened."
 
-let equation_to_expression (hloc, ((vl, expr): i_equation)) : c_expression =
+let equation_to_expression ((hloc: (ident * bool, string * int)Hashtbl.t), ((vl, expr): i_equation)) : c_expression =
   let fetch_unique_var () =
     match vl with
     | [v] ->
       begin
-        match Hashtbl.find_opt hloc (v, false) with
+        match Hashtbl.find_opt hloc (Utils.name_of_var v, false) with
         | None -> CVInput (Utils.name_of_var v)
         | Some (arr, idx) -> CVStored (arr, idx)
       end
@@ -22,11 +35,13 @@ let equation_to_expression (hloc, ((vl, expr): i_equation)) : c_expression =
       CAssign (fetch_unique_var (), CVariable v)
   | IEConst c ->
       CAssign (fetch_unique_var (), CConst c)
-  (*| IEMonOp (op, e) ->
+  | IEMonOp (op, e) ->
-      CMonOp (op, iexpression_to_cvalue e)
+      CAssign (fetch_unique_var (),
+                CMonOp (op, iexpression_to_cvalue e))
   | IEBinOp (op, e, e') ->
-      CBinOp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
+      CAssign (fetch_unique_var (),
-  | IEComp  (op, e, e') ->
+                CBinOp (op, iexpression_to_cvalue e, iexpression_to_cvalue e'))
+  (*| IEComp  (op, e, e') ->
       CComp (op, iexpression_to_cvalue e, iexpression_to_cvalue e')
   | IEConst c -> CConst c
   TODO!

src/intermediate_ast.ml

@@ -29,10 +29,10 @@ type node_state =
     nt_nb_int : int;
     nt_nb_real: int;
     nt_nb_bool: int;
-    nt_map_int: (t_var * bool, int) Hashtbl.t;
+    nt_map_int: (ident * bool, int) Hashtbl.t;
-    nt_map_bool: (t_var * bool, int) Hashtbl.t;
+    nt_map_bool: (ident * bool, int) Hashtbl.t;
-    nt_map_real: (t_var * bool, int) Hashtbl.t;
+    nt_map_real: (ident * bool, int) Hashtbl.t;
-    nt_map: (t_var * bool, string * int) Hashtbl.t;
+    nt_map: (ident * bool, string * int) Hashtbl.t;
     nt_output_map: (int, string * int) Hashtbl.t;
     nt_prevars: t_var list;
     nt_count_app: int;

src/intermediate_utils.ml

@@ -40,3 +40,11 @@ let rec find_app_opt eqs i =
     match find_app_expr_opt i expr with
     | None -> find_app_opt eqs i
     | Some n -> Some n
+
+let find_varname h v =
+  Hashtbl.fold
+    (fun s e acc ->
+      match acc with
+      | None -> if e = v then Some s else None
+      | Some _ -> acc)
+    h None

src/test.node

@@ -0,0 +1,7 @@
+node n (i: int) returns (o: int);
+var v, t: int;
+let
+  o = 1;
+  v = pre o;
+  t = o + pre i;
+tel