prise en compte des noeuds avec et sans memoire

bin/lustre-mt/main.ml

@@ -83,7 +83,7 @@ let main () =
   let print_task_inits task = 
     fprintf cfile "%s_TASK_type %s_TASK_init() {\n" task.name task.name;
     fprintf cfile "\t%s_TASK_struct* ts = (%s_TASK_struct*)calloc(1, sizeof(%s_TASK_struct));\n" task.name task.name task.name;
-    fprintf cfile "\t%s_ctx_init(&ts->ctx);\n" task.name;
+    if task.memory then fprintf cfile "\t%s_ctx_init(&ts->ctx);\n" task.name;
     fprintf cfile "\tSEM_INIT(ts->sem_start, 0, 1);\n";
     fprintf cfile "\tSEM_INIT(ts->sem_join, 0, 1);\n";
     fprintf cfile "\tpthread_create(&(ts->thr), NULL, %s_runner, ts);\n" task.name;
@@ -94,10 +94,14 @@ let main () =
   
   fprintf cfile "/* task resets */\n";
   let print_task_resets task =
-    fprintf cfile "void %s_TASK_reset(%s_TASK_type tD) {\n" task.name task.name;
-    fprintf cfile "\t%s_TASK_struct* ts = (%s_TASK_struct*) tD;\n" task.name task.name;
-    fprintf cfile "\t%s_ctx_reset(&ts->ctx);\n" task.name;
-    fprintf cfile "}\n\n"
+    if task.memory then 
+      (fprintf cfile "void %s_TASK_reset(%s_TASK_type tD) {\n" task.name task.name;
+      fprintf cfile "\t%s_TASK_struct* ts = (%s_TASK_struct*) tD;\n" task.name task.name;
+      fprintf cfile "\t%s_ctx_reset(&ts->ctx);\n" task.name;
+      fprintf cfile "}\n\n")
+    else
+      (fprintf cfile "void %s_TASK_reset(%s_TASK_type tD) {\n" task.name task.name;
+      fprintf cfile "}\n\n")
   in
   List.iter print_task_resets !tasks; 
 

bin/lustre-mt/parser.ml

@@ -107,6 +107,7 @@ let (save_data_one_task : Types.task -> (string * Yaml.value) -> unit) =
   |"name", `String n -> task.name <- n
   |"var_in" , `A l -> List.iter (save_variables_in task) l
   |"var_out" , `A l -> List.iter (save_variables_out task) l
+  |"memory" , `Bool b -> task.memory <- b
   |_ -> ()
 
 let (save_data_task : Types.task -> (string * Yaml.value) -> unit) = 
@@ -116,7 +117,7 @@ let (save_data_task : Types.task -> (string * Yaml.value) -> unit) =
     |_ -> ()
 
 let (save_data_tasks : Yaml.value -> unit) = fun x ->
-  let task = {name = ""; var_in = []; var_out = []}::[] in
+  let task = {name = ""; var_in = []; var_out = []; memory = true}::[] in
   match x with
   |`O l -> 
     List.iter (save_data_task (List.hd task)) l;

bin/lustre-mt/types.ml

@@ -37,4 +37,5 @@ type task = {
   mutable name: string;
   mutable var_in: variable list;
   mutable var_out: variable list;
+  mutable memory: bool;
 }

lib/soc2yaml.ml

@@ -74,14 +74,23 @@ let (f : Soc.key -> Soc.tbl -> string -> unit) = fun sk stbl basename ->
     s
   in
 
+  let (memory2string : bool -> string) = fun mem ->
+    match mem with
+    | true -> "true"
+    | false -> "false"
+  in
+
   let (tasks2yaml : task_type -> unit) = fun task ->
     let name = String.concat "_" (Str.split (Str.regexp "::") task.name) in
     let s_vi = String.concat "" (List.map var2yaml task.var_in) in
     let s_vo = String.concat "" (List.map var2yaml task.var_out) in
+    let mem = memory2string task.memory in
     let s = "  - task: "
     ^ "\n      name: " ^ name
     ^ "\n      var_in:\n" ^ s_vi
     ^ "      var_out:\n" ^ s_vo
+    ^ "      memory: " ^ mem
+    ^ "\n"
     in
     fprintf yaml_file "%s" s
   in

lib/socNameC.ml

@@ -25,7 +25,8 @@ type instance_type = {
 type task_type = {
   name: string;
   var_in: Soc.var list;
-  var_out: Soc.var list
+  var_out: Soc.var list;
+  memory : bool
 }
 
 let get_filename : Soc.t -> string = fun soc ->
@@ -178,7 +179,25 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
   (* List.iter print_instance_type res; *)
   res
   
-  let get_all_soc : Soc.t -> Soc.tbl -> Soc.t list = fun soc stbl -> (*bon j'ai bien tout mais mon remove duplicata marche pas*)
+  (*let get_literally_all_socs : Soc.t -> Soc.tbl -> Soc.t list = fun soc stbl ->
+    let gaol = get_gaol soc in 
+    let rec find_soc = function
+    | Case(_, id_gaol_l, _) -> id_gaol_l |> List.map (fun (_, gaol2) -> List.map find_soc gaol2) |>
+    List.flatten |> List.flatten
+    | Call(_, Method((_, sk), _, _), _, _)
+    | Call(_, Procedure(sk, _, _), _, _) ->
+          let new_soc = (SocUtils.find (Lxm.dummy "aeaea") sk stbl) in
+          let new_gaol = get_gaol new_soc in
+          if ((List.length new_gaol) = 0) then []
+          else
+            [new_soc] @ (List.flatten (List.map find_soc new_gaol))
+            | Call(_, _, _, _) -> []
+          in
+    let socs = List.map find_soc gaol in
+      let x = (socs |> List.flatten) in (*supprimer les duplicatas*)
+      x*)
+
+  let get_all_soc : Soc.t -> Soc.tbl -> Soc.t list = fun soc stbl ->
   let gaol = get_gaol soc in 
   let rec find_soc = function
   | Case(_, id_gaol_l, _) -> id_gaol_l |> List.map (fun (_, gaol2) -> List.map find_soc gaol2) |>
@@ -225,15 +244,41 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
     let soc = List.find (compare_name name) socs in
     let (var_in, var_out):Soc.var list * Soc.var list = soc.profile in
     (var_in, var_out)
+  
+  (*let memory_soc : Soc.t -> unit = fun soc ->
+    let (x, _, _) = soc.key in
+    match soc.memory with
+    | No_mem -> Printf.printf "aeaeaea %s\n" x
+    | Mem _ -> Printf.printf "A clamitous disaster indeed %s\n" x (*uniquement dans les lustre pre : trouver si un lustre pre quelque part dans le soc pour dire mem = true*)
+    | Mem_hidden -> Printf.printf "It's wizard time %s\n" x (*idée : ne pas explorer les méthodes/procédures, juste regarder le nom pour trouver un pre ?*)
+*)
+  let find_memory_soc : Soc.t -> bool = fun soc ->
+    let gaol = get_gaol soc in
+    let gao_has_memory = fun gao ->
+      match gao with
+      | Call(_,Assign,_,_) -> assert false
+      | Call(_, Method((_, sk), _, _), _, _)
+      | Call(_, Procedure (sk, _, _), _, _) -> 
+        let (name, _, _) = sk in
+        (String.equal "Lustre::pre" name) || (String.equal "Lustre::arrow" name)
+      | Case(_, _, _) -> assert false
+    in
+    List.exists (fun x -> x = true) (List.map gao_has_memory gaol)
+
+  let has_memory : string -> Soc.t list -> bool = fun name socs ->
+    let soc = List.find (compare_name name) socs in
+    let has_mem = find_memory_soc soc in
+    has_mem
     
   let get_tasks : Soc.tbl -> Soc.t -> Soc.t -> task_type list = fun stbl main_soc soc ->
     let gaol = get_gaol soc in
+    (*let socs_all = (get_literally_all_socs main_soc stbl) @ [main_soc] in*)
     (*let all_vars = (get_inputs_assoc soc) @ (get_outputs_assoc soc) @ (get_variables_assoc soc) in*)
     let (gao_to_tasks: gao -> task_type option) = fun gao ->
       match gao with
       | Call(_,Assign,_,_) -> assert false
       | Call(_, Method(_, _, task), _, _)
-      | Call(_, Procedure (_, _, task)     , _, _) -> 
+      | Call(_, Procedure (_, _, task), _, _) -> 
         begin
           match task with
         | None -> let t : task_type option = None in t
@@ -242,11 +287,13 @@ let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) =
           let name_task = (*List.nth x ((List.length x)-1)*) n in
           let socs = (get_all_soc main_soc stbl) @ [main_soc] in
           let (var_ins, var_outs) = get_task_profile name_task socs in
+          let mem = has_memory name_task socs in
           let t =
         {
           name = name_task;
           var_in = var_ins; (*List.map (var_expr_to_index all_vars) args_in;*)
-          var_out = var_outs (*List.map (var_expr_to_index all_vars) args_out*)
+          var_out = var_outs; (*List.map (var_expr_to_index all_vars) args_out*)
+          memory = mem
         } in
         Some t
       end