let propagates_pre_post_constraints_bycase file root =
Hashtbl.clear functions_pre_usecase ;
Hashtbl.clear functions_post_usecase;
spec_modified:=false;
let visitor = new visit_propagating_pre_post_constraints_bycase (Data_for_aorai.getAutomata()) in
Cil.visitCilFile (visitor :> Cil.cilVisitor) file;
(* Refining specification according to use-cases. *)
List.iter
(fun name ->
if name <> root then
begin
let old_pre = (Data_for_aorai.get_func_pre name) in
let old_post = (Data_for_aorai.get_func_post_bycase name) in
let used_pre =
try Hashtbl.find functions_pre_usecase name with Not_found -> (mk_empty_pre_or_post_bycase()) in
let used_post =
try Hashtbl.find functions_post_usecase name with Not_found -> (mk_empty_pre_or_post_bycase()) in
(* Format.printf "\n\nFunction : %s\n" name; *)
(* Format.printf " Observed pre use_case :"; *)
(* debug_display_stmt_all_pre_bycase used_pre; *)
(* Format.printf "\n Observed post_use_case :"; *)
(* debug_display_stmt_all_pre_bycase used_post; *)
(* Format.printf "\n"; *)
(* Reformating usecases of pre and post *)
let used_pre_st,used_pre_tr = pre_flattening used_pre in
let used_pre_st,used_pre_tr = (ref used_pre_st),(ref used_pre_tr) in
let used_post_st,used_post_tr = post_pseudo_flattening used_post in
let used_post_st,used_post_tr = (ref used_post_st),(ref used_post_tr) in
(* (\* If recursive calls, then using it to update used_pre *\) *)
(* begin *)
(* try *)
(* (\* Recursive calls are stored in another table *\) *)
(* let rec_pre = *)
(* Hashtbl.find functions_pre_usecase_Recursive name *)
(* in *)
(* (\* Reflexive and transitive closure on recursive calls in order to update used_pre *\) *)
(* (\* DEBUG TRACES !!!*\) *)
(* (\* Format.printf "\n\nFunction : %s\n" name; *\) *)
(* (\* Format.printf " Observed pre use_case :"; *\) *)
(* (\* debug_display_stmt_all_pre (!used_pre_st,!used_pre_tr); *\) *)
(* (\* Format.printf "\n Observed special recursion calls :"; *\) *)
(* (\* debug_display_stmt_all_pre_bycase rec_pre; *\) *)
(* (\* Format.printf "\n"; *\) *)
(* (\* END DEBUG TRACES !!!*\) *)
(* (\* Recursive calls are considered as use_case only if external calls are done with the same starting state *\) *)
(* (\* For each state used for calling, extending used_pre according to recursive extensions *\) *)
(* let oneMoreTime = ref true in *)
(* while !oneMoreTime do *)
(* oneMoreTime:=false; *)
(* Array.iteri *)
(* (fun st value -> *)
(* if value then begin *)
(* let tmp_st=bool_array_or !used_pre_st (fst rec_pre).(st) in *)
(* let tmp_tr=bool_array_or !used_pre_tr (snd rec_pre).(st) in *)
(* if not (double_bool_array_eq (!used_pre_st,!used_pre_tr) (tmp_st,tmp_tr)) then oneMoreTime:=true; *)
(* used_pre_st:= tmp_st; *)
(* used_pre_tr:= tmp_tr *)
(* end *)
(* ) *)
(* !used_pre_st; *)
(* done; *)
(* (\* DEBUG TRACES !!!*\) *)
(* (\* Format.printf " Updated pre use_case :"; *\) *)
(* (\* debug_display_stmt_all_pre (!used_pre_st,!used_pre_tr); *\) *)
(* (\* Format.printf "\n"; *\) *)
(* (\* END DEBUG TRACES !!!*\) *)
(* with *)
(* | Not_found -> () *)
(* end; *)
(* (\* If recursive calls, then using it to update used_post *\) *)
(* begin *)
(* try *)
(* (\* Recursive calls are stored in another table *\) *)
(* let rec_post = *)
(* Hashtbl.find functions_post_usecase_Recursive name *)
(* in *)
(* (\* Reflexive and transitive closure on recursive calls in order to update used_pre *\) *)
(* (\* DEBUG TRACES !!!*\) *)
(* (\* Format.printf "\n\nFunction : %s\n" name; *\) *)
(* (\* Format.printf " Observed pre use_case :"; *\) *)
(* (\* debug_display_stmt_all_pre (!used_pre_st,!used_pre_tr); *\) *)
(* (\* Format.printf "\n Observed special recursion calls :"; *\) *)
(* (\* debug_display_stmt_all_pre_bycase rec_pre; *\) *)
(* (\* Format.printf "\n"; *\) *)
(* (\* END DEBUG TRACES !!!*\) *)
(* (\* Recursive calls are considered as use_case only if external calls are done with the same starting state *\) *)
(* (\* For each state used for calling, extending used_post according to recursive extensions *\) *)
(* let oneMoreTime = ref true in *)
(* while !oneMoreTime do *)
(* oneMoreTime:=false; *)
(* Array.iteri *)
(* (fun input_st case_post_st -> *)
(* let case_post_tr = !used_post_tr.(input_st) in *)
(* Array.iteri *)
(* (fun st value -> *)
(* if value then begin *)
(* (\* !!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* !!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* !!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* Ici (fst rec_post).(st) est incorrect. *)
(* Je voudrais dire : *)
(* etant donne un etat sortie de la fonction, quel sont les etats/trans courant qui y mene *)
(* APRES AVOIR SAUVEGARDER CETTE VERSION SANS LE REC_USED_CASE : *)
(* Refaire tout le backarwd propagation en utilisant le bycase suivant : *)
(* exit state -> curstate -> true / false *)
(* Actuellement (adapte pour le FWD propagation) : *)
(* entry state -> curstate -> true / false *)
(* *\) *)
(* let tmp_st=bool_array_or case_post_st (fst rec_post).(st) in *)
(* let tmp_tr=bool_array_or case_post_tr (snd rec_post).(st) in *)
(* (\*!!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* !!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* !!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* !!!!!!!!!!!!!!!!!!!!!!!!!! *)
(* *\) *)
(* if not (double_bool_array_eq (case_post_st,case_post_tr) (tmp_st,tmp_tr)) then oneMoreTime:=true; *)
(* !used_post_st.(input_st) <- tmp_st; *)
(* !used_post_tr.(input_st) <- tmp_tr *)
(* end *)
(* ) *)
(* case_post_st *)
(* ) *)
(* !used_post_st; *)
(* done; *)
(* (\* DEBUG TRACES !!!*\) *)
(* (\* Format.printf " Updated pre use_case :"; *\) *)
(* (\* debug_display_stmt_all_pre (!used_pre_st,!used_pre_tr); *\) *)
(* (\* Format.printf "\n"; *\) *)
(* (\* END DEBUG TRACES !!!*\) *)
(* with *)
(* | Not_found -> () *)
(* end; *)
(* Computing new pre/post *)
let cur_pre = double_bool_array_and (!used_pre_st,!used_pre_tr) old_pre in
let cur_post = double_bool_array_and_bycase (!used_post_st,!used_post_tr) old_post in
if (not (double_bool_array_eq old_pre cur_pre ) )
then begin spec_modified:=true; end;
if (not (double_bool_array_eq_bycase old_post cur_post) )
then begin spec_modified:=true; end;
Data_for_aorai.set_func_pre name cur_pre;
Data_for_aorai.set_func_post_bycase name cur_post
end
)
(Data_for_aorai.getFunctions_from_c ());
!spec_modified