[cprint] add a main function

src/ast_to_c.ml

@@ -310,9 +310,10 @@ let ast_to_c verbose debug prog =
   verbose "Computation of the node_states";
   let prog_st_types = make_state_types prog in
   debug (Format.asprintf "%a" dump_var_locations prog_st_types);
-  let prog: i_nodelist = ast_to_intermediate_ast prog prog_st_types in
-  Format.printf "%a\n\n%a\n\n/* Nodes: */\n%a"
+  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"
     cp_includes (Config.c_includes)
     cp_state_types prog_st_types
-    cp_nodes (prog, prog_st_types)
+    cp_nodes (iprog, prog_st_types)
+    cp_main_fn (prog, prog_st_types)
 

src/config.ml

@@ -3,4 +3,4 @@
     * variables. *)
 let maxvar = 100
 
-let c_includes = ["stdbool"; "stdlib"]
+let c_includes = ["stdbool"; "stdlib"; "stdio"; "string"]

src/cprint.ml

@@ -218,3 +218,129 @@ and cp_expression fmt (expr, hloc) =
         p;
       prefix_  := p
 
+
+
+(** [cp_main] tries to print a main function to the C code.
+  * 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) =
+  let rec cp_array fmt (vl: t_var list): unit =
+    match vl with
+    | [] -> ()
+    | v :: vl ->
+      let typ, name =
+        match v with
+        | IVar s -> ("int", s)
+        | RVar s -> ("double", s)
+        | BVar s ->
+            Format.fprintf fmt "\tchar _char_of_%s;\n" s;
+            ("bool", s)
+        in
+      Format.fprintf fmt "\t%s %s;\n%a" typ name
+      cp_array vl
+  in
+  let rec cp_inputs fmt (f, l) =
+    match f, l with
+    | _,  [] -> ()
+    | true, h :: t ->
+      Format.fprintf fmt ", %s%a"
+        (Utils.name_of_var h)
+        cp_inputs (true, t)
+    | false, h :: t ->
+      Format.fprintf fmt "%s%a"
+        (Utils.name_of_var h)
+        cp_inputs (true, t)
+  in
+  let cp_scanf fmt vl =
+    let rec cp_scanf_str fmt (b, vl) =
+      match b, vl with
+      | _, [] -> ()
+      | true, h :: t ->
+        Format.fprintf fmt " %s%a"
+        (match h with
+        | IVar _ -> "%d"
+        | BVar _ -> "%c"
+        | RVar _ -> "%lf")
+        cp_scanf_str (true, t)
+      | false, h :: t ->
+        Format.fprintf fmt "%s%a"
+        (match h with
+        | IVar _ -> "%d"
+        | BVar _ -> "%c"
+        | RVar _ -> "%lf")
+        cp_scanf_str (true, t)
+    in
+    let rec cp_scanf_args fmt vl =
+      match vl with
+      | [] -> ()
+      | RVar s :: vl | IVar s :: vl ->
+        Format.fprintf fmt ", &%s%a" s cp_scanf_args vl
+      | BVar s :: vl ->
+        Format.fprintf fmt ", &%s%a" (Format.sprintf "_char_of_%s" s)
+          cp_scanf_args  vl
+    in
+    Format.fprintf fmt "\"%a\"%a"
+      cp_scanf_str (false, vl)
+      cp_scanf_args vl
+  in
+  let cp_printf fmt vl =
+    let rec cp_printf_str fmt (b, vl) =
+      match b, vl with
+      | _, [] -> ()
+      | true, h :: t ->
+        Format.fprintf fmt " %s%a"
+        (match h with
+        | IVar _ -> "%d"
+        | BVar _ -> "%c"
+        | RVar _ -> "%f")
+        cp_printf_str (true, t)
+      | false, h :: t ->
+        Format.fprintf fmt "%s%a"
+        (match h with
+        | IVar _ -> "%d"
+        | BVar _ -> "%c"
+        | RVar _ -> "%f")
+        cp_printf_str (true, t)
+    in
+    let rec cp_printf_arg fmt (h, i) =
+      match Hashtbl.find_opt h i with
+      | None -> ()
+      | Some (s, i) ->
+        Format.fprintf fmt ", state.%s[%d]%a"
+          s i cp_printf_arg (h, i+1)
+    in
+    Format.fprintf fmt "\"%a\"%a"
+      cp_printf_str (false, vl)
+      cp_printf_arg ((Hashtbl.find sts "main").nt_output_map, 0)
+  in
+  let rec cp_char_to_bool fmt vl =
+    match vl with
+    | [] -> ()
+    | RVar _ :: vl | IVar _ :: vl -> Format.fprintf fmt "%a" cp_char_to_bool vl
+    | BVar s :: vl ->
+      Format.fprintf fmt "\t\t%s = (%s == 't') ? true : false;\n%a"
+        s (Format.sprintf "_char_of_%s" s)
+        cp_char_to_bool vl
+  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\
+        \twhile(true) {\n\
+          \t\tscanf(\"%%s\", _buffer);\n\
+          \t\tif(!strcmp(_buffer, \"exit\")) { exit (EXIT_SUCCESS); }\n\
+          \t\tsscanf(_buffer, %a);\n%a\
+          \t\tfn_main(&state, %a);\n\
+          \t\tprintf(%a);\n\
+        \t}\n\
+        \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)

src/test.node

@@ -1,15 +1,5 @@
-node id (a: bool) returns (o: bool);
+node main (i: int) returns (a, b: int);
 let
-  o = a;
+  (a, b) = (i, i);
 tel
 
-node test_merge_tuples (a, b: bool) returns (o: bool);
-var t: bool;
-let
-  (o, t) = if a and b then (true, false) else (false, true);
-tel
-
-node my_and (a, b: bool) returns (o: bool);
-let
-  o = if a then b else id(false -> a);
-tel