diff --git a/bin/lustre-mt/main.ml b/bin/lustre-mt/main.ml
index cca0ff9f0d2e46a42ba57336b2a9f9ed5f79bacd..637473aab5d592348e2c0f581dcfd8c93cf376cd 100644
--- a/bin/lustre-mt/main.ml
+++ b/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;
diff --git a/bin/lustre-mt/parser.ml b/bin/lustre-mt/parser.ml
index b16937d2d25eff9028000ccedbd764a3716ffcbb..fb8e6981e56bab8bbd4a0448635033c2cd1c2c33 100644
--- a/bin/lustre-mt/parser.ml
+++ b/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;
diff --git a/bin/lustre-mt/types.ml b/bin/lustre-mt/types.ml
index 6309f68bab05be485648be388cdc0e2e52f56fed..9290f1e705a5f9e33d84dbc0d88fdd3d1cacbd18 100644
--- a/bin/lustre-mt/types.ml
+++ b/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;
}
diff --git a/lib/soc2yaml.ml b/lib/soc2yaml.ml
index 899473efac79341b699b714462758025ca9c0f69..252fd0157c1f9435f3736f98bfaa9d17b69f80ce 100644
--- a/lib/soc2yaml.ml
+++ b/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
diff --git a/lib/socNameC.ml b/lib/socNameC.ml
index 4d06de5ba3a8a82c40a2dcad87d0795d4f65f33d..2ada82e50cea2417e6961ab9ba4b7a2b4274bb86 100644
--- a/lib/socNameC.ml
+++ b/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