let merge_current ~degenerate =
let superposed = lazy (Current_table.states current_table) in
Current_table.merge_db_table superposed;
if not degenerate &&
((not (Db.Value.Record_Value_Callbacks.is_empty ())) ||
(not (Db.Value.Record_Value_Superposition_Callbacks.is_empty ())) ||
(not (Db.Value.Record_Value_After_Callbacks.is_empty ())))
then begin
let stack_for_callbacks = for_callbacks_stack () in
if not (Db.Value.Record_Value_Superposition_Callbacks.is_empty ())
then begin
let current_superpositions =
Current_table.superpositions current_table
in
Value_parameters.feedback
"now calling Record_Value_Superposition callbacks";
Db.Value.Record_Value_Superposition_Callbacks.apply
(stack_for_callbacks, current_superpositions);
end ;
if not (Db.Value.Record_Value_Callbacks.is_empty ())
then begin
Value_parameters.feedback "now calling Record_Value callbacks";
Db.Value.Record_Value_Callbacks.apply
(stack_for_callbacks, Lazy.force superposed)
end;
if not (Db.Value.Record_Value_After_Callbacks.is_empty ())
then begin
Value_parameters.feedback "now calling Record_After_Value callbacks";
let superposed = Lazy.force superposed in
Cil_datatype.Kinstr.Hashtbl.iter
(fun ki state ->
match ki with
| Kglobal -> ()
| Kstmt stmt ->
List.iter
(fun pred ->
if not (store_state_after_during_dataflow pred stmt)
then
try
let cur = Cil_datatype.Stmt.Hashtbl.find
states_after pred in
Cil_datatype.Stmt.Hashtbl.replace
states_after pred
(Relations_type.Model.join state cur)
with Not_found ->
Cil_datatype.Stmt.Hashtbl.add
states_after pred state
)
stmt.preds;
)
superposed;
let ret = Kernel_function.find_return (current_kf ()) in
(try
let s = Cil_datatype.Kinstr.Hashtbl.find superposed (Kstmt ret) in
Cil_datatype.Stmt.Hashtbl.add states_after ret s
with Not_found -> ()
);
Db.Value.Record_Value_After_Callbacks.apply
(stack_for_callbacks, states_after);
end;
end;
Current_table.clear current_table