[C] malloc->calloc + conditions merged in free_state_*

src/ast_to_c.ml

@@ -236,11 +236,15 @@ let cp_init_aux_nodes fmt (node, h) =
     | None -> () (** All auxiliary nodes have been initialized *)
     | Some n ->
       begin
-      Format.fprintf fmt "%a\t\tstate->aux_states[%d] = malloc (sizeof (%s));\n\
+      Format.fprintf fmt "%a\t\tif(!state->is_reset) {\n\
-          \t\t((%s*)(state->aux_states[%d]))->is_init = true;\n"
+          \t\t\tstate->aux_states[%d] = calloc (1, sizeof (%s));\n\
+          \t\t}\n\
+          \t\t((%s*)(state->aux_states[%d]))->is_init = true;\n\
+          \t\t((%s*)(state->aux_states[%d]))->is_reset = state->is_reset;\n"
         aux (node, nst, i-1)
         (i-1) (Format.asprintf "t_state_%s" n.n_name)
         (Format.asprintf "t_state_%s" n.n_name) (i-1)
+        (Format.asprintf "t_state_%s" n.n_name) (i-1)
       end
   in
   let nst = Hashtbl.find h node.in_name in
@@ -311,9 +315,10 @@ let ast_to_c verbose debug prog =
   let prog_st_types = make_state_types prog in
   debug (Format.asprintf "%a" dump_var_locations prog_st_types);
   let iprog: i_nodelist = ast_to_intermediate_ast prog prog_st_types in
-  Format.printf "%a\n\n%a\n\n/* Nodes: */\n%a%a\n"
+  Format.printf "%a\n\n%a\n\n%a\n\n/* Nodes: */\n%a%a\n"
     cp_includes (Config.c_includes)
     cp_state_types prog_st_types
+    cp_state_frees (iprog, prog_st_types)
     cp_nodes (iprog, prog_st_types)
     cp_main_fn (prog, prog_st_types)
 

src/cprint.ml

@@ -19,7 +19,7 @@ let cp_node_state fmt (st: node_state) =
   if st.nt_count_app = 0
     then
       Format.fprintf fmt "typedef struct {%a%a%a\n\
-            \tbool is_init;\n\
+            \tbool is_init, is_reset;\n\
             } %s;\n\n"
         print_if_any ("int", st.nt_nb_int, "ivars")
         print_if_any ("bool", st.nt_nb_bool, "bvars")
@@ -27,7 +27,7 @@ let cp_node_state fmt (st: node_state) =
         st.nt_name
     else
       Format.fprintf fmt "typedef struct {%a%a%a\n\
-            \tbool is_init;\n\
+            \tbool is_init, is_reset;\n\
             \tvoid* aux_states[%d]; /* stores the states of auxiliary nodes */\n\
             } %s;\n\n"
         print_if_any ("int", st.nt_nb_int, "ivars")
@@ -40,6 +40,89 @@ let cp_state_types fmt (h: (ident, node_state) Hashtbl.t): unit =
     Format.fprintf fmt "/* Struct holding states of the node %s: */\n%a" n
       cp_node_state nst) h
 
+
+
+(** [cp_state_frees] prints the required code to recursively free the node
+  * states. *)
+let cp_state_frees fmt (iprog, sts) =
+  let rec find_callee (i: int) (f: i_node) =
+    let rec aux_expr = function
+      | IETuple [] | IEVar   _ | IEConst _ -> None
+      | IEMonOp (_, e) -> aux_expr e
+      | IEWhen  (e, e')
+      | IEReset (e, e')
+      | IEComp  (_, e, e')
+      | IEBinOp (_, e, e') ->
+        begin
+          match aux_expr e with
+          | None -> aux_expr e'
+          | Some res -> Some res
+        end
+      | IETriOp (_, e, e', e'') ->
+        begin
+          match aux_expr e with
+          | None ->
+            (match aux_expr e' with
+            | None -> aux_expr e''
+            | Some res -> Some res)
+          | Some res -> Some res
+        end
+      | IETuple (h :: t) ->
+        begin
+          match aux_expr h with
+          | None -> aux_expr (IETuple t)
+          | Some res -> Some res
+        end
+      | IEApp   (j, n, e) ->
+          if i = j
+            then Some n.n_name
+            else aux_expr e
+    in
+    List.fold_right
+      (fun (_, expr) acc ->
+        match acc with
+        | Some _ -> acc
+        | None -> aux_expr expr)
+      f.in_equations None
+  in
+  let rec cp_free_aux fmt (i, caller_name) =
+    let idx = i - 1 in
+    match find_callee i (List.find (fun n -> n.in_name = caller_name) iprog)with
+    | None -> ()
+    | Some callee_name ->
+      let callee_st = Hashtbl.find sts callee_name in
+      if callee_st.nt_count_app > 0
+        then
+          Format.fprintf fmt "\tif (st->aux_states[%d]) {\n\
+            \t\tfree_state_%s((t_state_%s*)(st->aux_states[%d]));\n\
+            \t\tfree (st->aux_state[%d]);\n\t}\n%a"
+            idx callee_name callee_name idx
+            idx cp_free_aux (i+1, caller_name)
+        else Format.fprintf fmt "\tif (st->aux_states[%d])\n\
+            \t\tfree(st->aux_states[%d]);\n%a"
+            idx idx cp_free_aux (i+1, caller_name)
+  in
+  Hashtbl.iter
+    (fun node_name node_st ->
+      if node_st.nt_count_app = 0
+        then () (** Nothing to free for the node [node_name]. *)
+        else
+          Format.fprintf fmt "void free_state_%s(t_state_%s *);\n"
+            node_name node_name) sts;
+  Hashtbl.iter
+    (fun node_name node_st ->
+      if node_st.nt_count_app = 0
+        then () (** Nothing to free for the node [node_name]. *)
+        else
+          Format.fprintf fmt "void free_state_%s(t_state_%s *st)\n\
+            {\n\
+              %a\
+            }\n"
+            node_name node_name
+            cp_free_aux (1, node_name)) sts
+
+
+
 let cp_var' fmt = function
   | CVStored (arr, idx) -> Format.fprintf fmt "state->%s[%d]" arr idx
   | CVInput s -> Format.fprintf fmt "%s" s
@@ -75,6 +158,13 @@ let rec cp_varlist fmt vl =
     print_if_any vl
     cp_varlist vl
 
+
+
+(** [cp_prototype] prints functions prototypes (without the «;»). It is only
+  * used to write the beginning of functions right now. If we later allow to
+  * use auxiliary nodes before their definition, it might be useful to declare
+  * all the prototypes at the beginning of the file (Cf. [cp_prototypes] below.
+  *)
 let cp_prototype fmt (node, h): unit =
   match Hashtbl.find_opt h node.in_name with
   | None -> failwith "This should not happened!"
@@ -96,6 +186,10 @@ let rec cp_prototypes fmt ((nodes, h): i_nodelist * node_states) =
 
 
 
+(** [cp_value] prints values, that is unary or binary operations which can be
+  * inlined in the final code without requiring many manipulations.
+  * It uses a lot of parenthesis at the moment. An improvement would be to
+  * remove useless ones at some point. *)
 let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) =
   let string_of_binop = function
     | BOp_add -> "+"
@@ -146,6 +240,8 @@ let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) =
   | CMonOp (MOp_pre, _) ->
       failwith "The linearization should have removed this case."
 
+
+
 let prefix_ = ref "\t"
 
 (** The following function prints one transformed equation of the program into a
@@ -191,10 +287,16 @@ and cp_expression fmt (expr, hloc) =
     end
   | CReset (node_name, i, v, b) ->
     begin
-      Format.fprintf fmt "\tif (%a) {\n\t\t((t_state_%s*)(state->aux_states[%d]))->is_init = true;\n\t}\n%a\n"
+      Format.fprintf fmt "\tif (%a) {\n\
+        \t\t((t_state_%s*)(state->aux_states[%d]))->is_init = true;\n\
+        \t\t((t_state_%s*)(state->aux_states[%d]))->is_reset = true;\n\
+        \t}\n\
+        %a\n"
         cp_value (v, hloc)
         node_name
         (i - 1)
+        node_name
+        (i - 1)
         cp_block (b, hloc)
     end
   | CIf (v, b1, []) ->
@@ -220,8 +322,8 @@ and cp_expression fmt (expr, hloc) =
 
 
 
-(** [cp_main] tries to print a main function to the C code.
+(** [cp_main] prints  a main function to the C code if necessary:
-  * If there is a function [main] in the lustre program, it will generate a main
+  * if there is a function [main] in the lustre program, it will generate a main
   * function in the C code, otherwise it does not do anything.
   *)
 let cp_main_fn fmt (prog, sts) =
@@ -298,7 +400,7 @@ let cp_main_fn fmt (prog, sts) =
         Format.fprintf fmt ", state.%s[%d]%a"
           s i cp_printf_arg (h, i+1)
     in
-    Format.fprintf fmt "\"%a\"%a"
+    Format.fprintf fmt "\"%a\\n\"%a"
       cp_printf_str (false, vl)
       cp_printf_arg ((Hashtbl.find sts "main").nt_output_map, 0)
   in
@@ -311,24 +413,34 @@ let cp_main_fn fmt (prog, sts) =
         s (Format.sprintf "_char_of_%s" s)
         cp_char_to_bool vl
   in
+  let cp_free fmt () =
+    let main_st = Hashtbl.find  sts "main" in
+    if main_st.nt_count_app = 0
+      then ()
+      else Format.fprintf fmt "\tfree_state_main(&state);\n"
+  in
   match List.find_opt (fun n -> n.n_name = "main") prog with
   | None -> ()
   | Some node ->
     Format.fprintf fmt "int main (int argc, char **argv)\n\
       {\n%a\n\
         \tchar _buffer[1024];\n\
-        \tt_state_main state; state.is_init = true;\n\
+        \tt_state_main state;\n\
+        \tstate.is_init = true;\n\
+        \tstate.is_reset = false;\n\
         \twhile(true) {\n\
           \t\tscanf(\"%%s\", _buffer);\n\
-          \t\tif(!strcmp(_buffer, \"exit\")) { exit (EXIT_SUCCESS); }\n\
+          \t\tif(!strcmp(_buffer, \"exit\")) { break; }\n\
           \t\tsscanf(_buffer, %a);\n%a\
           \t\tfn_main(&state, %a);\n\
           \t\tprintf(%a);\n\
         \t}\n\
-        \treturn EXIT_SUCCESS;\n\
+        %a\treturn EXIT_SUCCESS;\n\
       }\n"
       cp_array (snd node.n_inputs)
       cp_scanf (snd node.n_inputs)
       cp_char_to_bool (snd node.n_inputs)
       cp_inputs (false, snd node.n_inputs)
       cp_printf (snd node.n_outputs)
+      cp_free ()
+

src/parser.mly

@@ -216,8 +216,8 @@ node_content:
               if vars_distinct e_in e_out (snd $10)
                 then (Hashtbl.add defined_nodes node_name n; n)
                 else raise (MyParsingError
-                            ("There is a conflict between the names of local, input \
+                            ("There is a conflict between the names of local,\
-                            or output variables.",
+                             input or output variables.",
                             current_location()))
           end};
 
@@ -324,22 +324,22 @@ expr:
           "Addition expects both arguments to be (the same kind of) numbers." }
   | expr MINUS expr
       { make_binop_nonbool $1 $3 BOp_sub
-          "You should know better; subtraction hates booleans" }
+          "Substraction expects both arguments to be (the same kind of) numbers." }
   | expr BO_mul expr
       { make_binop_nonbool $1 $3 BOp_mul
-          "You should know better; multiplication hates booleans" }
+          "Multiplication expects both arguments to be (the same kind of) numbers." }
   | expr BO_div expr
       { make_binop_nonbool $1 $3 BOp_div
-          "You should know better; division hates booleans" }
+          "Division expects both arguments to be (the same kind of) numbers." }
   | expr BO_mod expr
       { make_binop_nonbool $1 $3 BOp_mod
-          "You should know better; modulo hates booleans" }
+          "Modulo expects both arguments to be numbers." }
   | expr BO_and expr
       { make_binop_bool $1 $3 BOp_and
-          "You should know better; conjunction hates numbers" }
+          "Conjunction expects both arguments to be booleans." }
   | expr BO_or expr
       { make_binop_bool $1 $3 BOp_or
-          "You should know better; disjunction hates numbers" }
+          "Disjunction expects both arguments to be booleans." }
   | expr BO_arrow expr
       { let e1 = $1 in let t1 = type_exp e1 in
         let e2 = $3 in let t2 = type_exp e2 in

src/test.node

@@ -1,5 +1,18 @@
-node main (i: int) returns (a, b: int);
+node id_int (i: int) returns (o: int);
 let
-  (a, b) = (i, i);
+  o = i -> i;
+tel
+
+node aux (i, j: int) returns (o: int);
+let
+  o = id_int(i) + id_int(j);
+tel
+
+node main (i: int) returns (a, b: int);
+var tmp: int;
+let
+  a = 1;
+  b = aux (i, a);
+  tmp = aux (a+b, i);
 tel