Summary: Bug fix: generate ref to _I functions in xml.tasks only when needed.

git-svn-id: https://svn.onera.fr/Prelude/Prelude/trunk@876 49f62630-d767-4ccd-930e-b3f5589f52e1

src/c_exports.ml

@@ -142,7 +142,7 @@ let pp_task_params out_f task =
         fprintf out_f "NULL, "
       else
         fprintf out_f "%s, " (fun_name_R task.task_id);
-      let needs_idx, needs_sidx = C_task_functions.needs_idxs task in
+      let needs_idx, needs_sidx = needs_idxs task in
       if task.task_kind <> CstTask && (needs_idx || needs_sidx) then
         fprintf out_f "%s" (fun_name_init task.task_id)
       else

src/c_task_functions.ml

@@ -27,26 +27,6 @@ open Task_set
 open C_names
 open Format  
 
-let array_collapse_threshold = 4
-
-let would_collapse array =
-  let (last_v, c, res) =
-    Array.fold_left
-      (fun (prec_v, cpt, res) v ->
-        match res,prec_v with
-        | true,_ -> prec_v,cpt,true
-        | _,None -> Some v, 1, res
-        | _,Some pv ->
-          if pv = v then
-              Some v, cpt+1, res
-          else
-              Some v, 1, res || cpt >= array_collapse_threshold)
-      (None,0,false) array
-  in
-  match last_v with
-  | None -> res
-  | Some lv -> res || (c >= array_collapse_threshold)
-
 let collapse_array array =
   let (last_v,cpt,l) =
     Array.fold_left
@@ -65,32 +45,6 @@ let collapse_array array =
   | None ->  List.rev l
   | Some lv -> List.rev ((lv,cpt)::l)
 
-let any_uses_read_proto inputs = List.exists (fun (_,_,x) -> uses_read_protocol x) inputs
-
-let any_uses_write_proto outputs trace_instances =
-  List.exists
-    (fun (_,x) -> uses_write_protocol x)
-    (List.concat (List.map (fun (_,x) -> x) outputs)) ||
-    (trace_instances && Options.trace_instances ())
-
-let needs_idxs task =
-  let needs_idxr = any_uses_read_proto task.task_inputs in
-  let needs_idxw = any_uses_write_proto task.task_outputs false in
-  let needs_idx = needs_idxr || needs_idxw in
-  let protos =
-    List.map
-      (fun (_,_,p) -> [p.change_pat;p.change_pref])
-      task.task_inputs
-    @
-    List.map
-      (fun (_,p) -> [p.write_pat;p.write_pref])
-      (List.concat (List.map (fun (_,x) -> x) task.task_outputs))
-    |>
-    List.concat
-  in
-  let needs_sidx = List.exists would_collapse protos in
-  needs_idx, needs_sidx
-
 let pp_array_slice printer out_f (v,repeat) =
   if repeat < array_collapse_threshold then
     begin

src/task_set.ml

@@ -161,6 +161,52 @@ let uses_write_protocol proto =
   (Array.length proto.write_pref > 1) ||
   (Array.length proto.write_pat > 1)
 
+let any_uses_read_proto inputs = List.exists (fun (_,_,x) -> uses_read_protocol x) inputs
+
+let any_uses_write_proto outputs trace_instances =
+  List.exists
+    (fun (_,x) -> uses_write_protocol x)
+    (List.concat (List.map (fun (_,x) -> x) outputs)) ||
+    (trace_instances && Options.trace_instances ())
+
+let array_collapse_threshold = 4
+
+let would_collapse array =
+  let (last_v, c, res) =
+    Array.fold_left
+      (fun (prec_v, cpt, res) v ->
+        match res,prec_v with
+        | true,_ -> prec_v,cpt,true
+        | _,None -> Some v, 1, res
+        | _,Some pv ->
+          if pv = v then
+              Some v, cpt+1, res
+          else
+              Some v, 1, res || cpt >= array_collapse_threshold)
+      (None,0,false) array
+  in
+  match last_v with
+  | None -> res
+  | Some lv -> res || (c >= array_collapse_threshold)
+      
+let needs_idxs task =
+  let needs_idxr = any_uses_read_proto task.task_inputs in
+  let needs_idxw = any_uses_write_proto task.task_outputs false in
+  let needs_idx = needs_idxr || needs_idxw in
+  let protos =
+    List.map
+      (fun (_,_,p) -> [p.change_pat;p.change_pref])
+      task.task_inputs
+    @
+    List.map
+      (fun (_,p) -> [p.write_pat;p.write_pref])
+      (List.concat (List.map (fun (_,x) -> x) task.task_outputs))
+    |>
+    List.concat
+  in
+  let needs_sidx = List.exists would_collapse protos in
+  needs_idx, needs_sidx
+    
 (* Complexity is quite poor (due to searching for read_proto) *)
 let coms_list task_set =
   let read_proto tid vid =

src/xml_wcc.ml

@@ -32,9 +32,13 @@ let pp_task t out_f =
   if t.task_kind <> CstTask then
     begin
       let period = t.task_period in
+      let needs_idx, needs_sidx = needs_idxs t in
+      if (t.task_kind <> CstTask) && (needs_idx || needs_sidx) then
+        begin
           fprintf out_f  "\t\t\t<entrypoint>@.";
           fprintf out_f  "\t\t\t<function>%s</function>@." (fun_name_init t.task_id);
-      fprintf out_f  "\t\t\t</entrypoint>@.";
+          fprintf out_f  "\t\t\t</entrypoint>@."
+        end;
       if (t.task_kind <> Sensor) then
           begin
             fprintf out_f  "\t\t\t<entrypoint>@.";