mauve generator: first shot

include/arrow.hpp

@@ -2,6 +2,7 @@
 #ifndef _ARROW_CPP
 #define _ARROW_CPP
 
+#include <stdint.h>
 #include <stdlib.h>
 
 struct _arrow_mem {

src/_tags

@@ -9,3 +9,4 @@
 <*.ml{,i}>: package(ocamlgraph)
 <*.ml{,i}>: use_str
 <*.ml{,i}>: use_unix
+

src/backends/C/c_backend.ml

@@ -10,6 +10,7 @@
 (********************************************************************)
 
 open Format
+open C_backend_mauve
 (********************************************************************************************)
 (*                         Translation function                                             *)
 (********************************************************************************************)
@@ -65,6 +66,33 @@ let gen_files funs basename prog machines dependencies =
     end
   ));
 
+  (match !Options.mauve with
+  | "" ->  ()
+  | mauve -> (
+    (* looking for the main node *)
+    match Machine_code.get_machine_opt mauve machines with
+    | None -> begin
+      Global.main_node := mauve;
+      Format.eprintf "Code generation error: %a@." Corelang.pp_error LustreSpec.Main_not_found;
+      raise (Corelang.Error (Location.dummy_loc, LustreSpec.Main_not_found))
+    end
+    | Some m -> begin
+      let source_mauve_file = destname ^ "_mauve.hpp" in
+      let source_mauve_out = open_out source_mauve_file in
+      let source_mauve_fmt = formatter_of_out_channel source_mauve_out in
+      (* Header *)
+      print_mauve_header source_mauve_fmt m basename prog machines dependencies;
+      (* Shell *)
+      print_mauve_shell source_mauve_fmt m basename prog machines dependencies;
+      (* Core *)
+      print_mauve_core source_mauve_fmt m basename prog machines dependencies;
+      (* FSM *)
+      print_mauve_fsm source_mauve_fmt m basename prog machines dependencies;
+
+      close_out source_mauve_out;
+    end
+  ));
+
 
   (* Makefiles:
      - for the moment two cases

src/backends/C/c_backend_common.ml

@@ -125,7 +125,7 @@ let is_basic_c_type t =
   | _                                       -> false
 
 let pp_c_basic_type_desc t_dsec =
-  match (t_dsec) with
+  match t_dsec with
   | Types.Tbool when !Options.cpp  -> "bool"
   | Types.Tbool                    -> "_Bool"
   | Types.Tint                     -> !Options.int_type

src/backends/C/c_backend_mauve.ml

+open LustreSpec
+open Corelang
+open Machine_code
+open Format
+open C_backend_common
+open Utils
+
+(* module type MODIFIERS_MAINSRC =
+sig
+end
+
+module EmptyMod =
+struct
+end
+
+module Mauve = functor (Mod: MODIFIERS_MAINSRC) -> 
+struct
+end
+ *)
+(********************************************************************************************)
+(*                         Main related functions                                           *)
+(********************************************************************************************)
+
+let mauve_default_value v =
+  let v_name = v.var_id in
+  let v_type = (Types.repr v.var_type).Types.tdesc in
+  match v_type with
+  | Types.Tbool -> "false"
+  | Types.Tint  -> "0"
+  | Types.Treal -> "0.0"
+  | _ -> assert false
+
+let shell_name node = node ^ "Shell"
+let core_name  node = node ^ "Core"
+let fsm_name   node = node ^ "FSM"
+
+let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) =
+  fprintf fmt "#include \"mauve/runtime.hpp\"@.";
+  print_import_alloc_prototype fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
+  pp_print_newline fmt ();
+  pp_print_newline fmt ()
+
+
+let print_mauve_shell fmt mauve_machine basename prog machines _ (*dependencies*) =
+  let node_name = mauve_machine.mname.node_id in
+  
+  fprintf fmt "/*@.";
+  fprintf fmt " *          SHELL@.";
+  fprintf fmt " */@.";
+
+  fprintf fmt "struct %s: public Shell {@." (shell_name node_name);
+
+  (* in ports *)
+  fprintf fmt "\t// InputPorts@.";
+  List.iter
+    (fun v ->
+      let v_name = v.var_id in
+      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+      let default = mauve_default_value v in
+      fprintf fmt "\tReadPort<%s> port_%s = mk_readPort<%s>(\"%s\", %s);@." v_type v_name v_type v_name default;
+    ) mauve_machine.mstep.step_inputs;
+  (* out ports *)
+  fprintf fmt "\t// OutputPorts@.";
+  List.iter
+    (fun v ->
+      let v_name = v.var_id in
+      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+      fprintf fmt "\tWritePort<%s> port_%s = mk_writePort<%s>(\"%s\");@." v_type v_name v_type v_name;
+    ) mauve_machine.mstep.step_outputs;
+
+  fprintf fmt "};@.";
+
+  pp_print_newline fmt ()
+
+let print_mauve_step fmt node_name mauve_machine =
+  fprintf fmt "\t\t%s_step(" node_name;
+  List.iter
+    (fun v ->
+      let v_name = v.var_id in
+      fprintf fmt "%s, " v_name;
+    ) mauve_machine.mstep.step_inputs;
+  List.iter
+    (fun v ->
+      let v_name = v.var_id in
+      fprintf fmt "&%s, " v_name;
+    ) mauve_machine.mstep.step_outputs;
+  fprintf fmt "node";
+  fprintf fmt ");@."
+
+let print_mauve_core fmt mauve_machine basename prog machines _ (*dependencies*) =
+  let node_name = mauve_machine.mname.node_id in
+
+  fprintf fmt "/*@.";
+  fprintf fmt " *          CORE@.";
+  fprintf fmt " */@.";
+
+  fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name) (shell_name node_name);
+
+  (* Attribute *)
+  fprintf fmt "\tstruct %s_mem * node;@." node_name;
+  pp_print_newline fmt ();
+  (* Update *)
+  fprintf fmt "\tvoid update() {@.";
+  List.iter
+    (fun v ->
+      let v_name = v.var_id in
+      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+      fprintf fmt "\t\t%s %s = port_%s.read();@." v_type v_name v_name;
+    ) mauve_machine.mstep.step_inputs;
+  List.iter
+    (fun v ->
+      let v_name = v.var_id in
+      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+      fprintf fmt "\t\t%s %s;@." v_type v_name;
+    ) mauve_machine.mstep.step_outputs;
+  print_mauve_step fmt node_name mauve_machine;
+  List.iter
+    (fun v ->
+      let v_name = v.var_id in
+      fprintf fmt "\t\tport_%s.write(%s);@." v_name v_name;
+    ) mauve_machine.mstep.step_outputs;
+  fprintf fmt "\t}@.";
+  pp_print_newline fmt ();
+  (* Configure *)
+  fprintf fmt "\tbool configure_hook() override {@.";
+  fprintf fmt "\t\tnode = %s_alloc();@." node_name;
+  fprintf fmt "\t\t%s_reset(node);@." node_name;
+  fprintf fmt "\t\treturn true;@.";
+  fprintf fmt "\t}@.";
+  pp_print_newline fmt ();
+  (* Cleanup *)
+  fprintf fmt "\tvoid cleanup_hook() override {@.";
+  fprintf fmt "\t\t%s_reset(node);@." node_name;
+  fprintf fmt "\t\tfree(node);@.";
+  fprintf fmt "\t}@.";
+  fprintf fmt "};@.";
+  pp_print_newline fmt ()
+
+
+let print_mauve_fsm fmt mauve_machine basename prog machines _ (*dependencies*) =
+  let node_name = mauve_machine.mname.node_id in
+
+  fprintf fmt "/*@.";
+  fprintf fmt " *          FSM@.";
+  fprintf fmt " */@.";
+
+  fprintf fmt "struct %s: public FiniteStateMachine<%s, %s> {@." (fsm_name node_name) (shell_name node_name) (core_name node_name);
+
+  (* Attribute *)
+  fprintf fmt "\tExecState<%s>    & update  = mk_execution      (\"Update\" , &%s::update);@." (core_name node_name) (core_name node_name);
+  fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", ms_to_ns(100));@." (core_name node_name);
+  pp_print_newline fmt ();
+  (* Configure *)
+  fprintf fmt "\tbool configure_hook() override {@.";
+  fprintf fmt "\t\tset_initial(update);@.";
+  fprintf fmt "\t\tset_next(update, synchro);@.";
+  fprintf fmt "\t\tset_next(synchro, update);@.";
+  fprintf fmt "\t\treturn true;@.";
+  fprintf fmt "\t}@.";
+  pp_print_newline fmt ();
+  (* Cleanup *)
+  fprintf fmt "\tvoid cleanup_hook() override {@.";
+  fprintf fmt "\t}@.";
+  fprintf fmt "};@.";
+  pp_print_newline fmt ()
+
+(* Local Variables: *)
+(* compile-command:"make -C ../../.." *)
+(* End: *)

src/options.ml

@@ -55,6 +55,8 @@ let cpp       = ref false
 let int_type  = ref "int"
 let real_type = ref "double"
 
+let mauve = ref ""
+
 let sfunction = ref ""
 
 let set_mpfr prec =
@@ -98,6 +100,8 @@ let options =
     "-c++" , Arg.Set        cpp      , "c++ backend";
     "-int" , Arg.Set_string int_type , "specifies the integer type (default=\"int\")";
     "-real", Arg.Set_string real_type, "specifies the real type (default=\"double\" without mpfr option)";
+
+    "-mauve", Arg.String (fun node -> mauve := node; cpp := true; static_mem := false), "generates the mauve code";
 ]