let merge_current ~degenerate =
let treat_instr k record =
let sum = State_set.join_dropping_relations record.superposition in
Db.Value.update_table k sum
in
InstrHashtbl.iter treat_instr current_table;
if not degenerate &&
((not (Db.Value.Record_Value_Callbacks.is_empty ())) ||
(not (Db.Value.Record_Value_Superposition_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 = InstrHashtbl.create 17 in
InstrHashtbl.iter
(fun k record ->
InstrHashtbl.add current_superpositions k record.superposition)
current_table;
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";
let current_states = InstrHashtbl.create 17 in
InstrHashtbl.iter
(fun k record ->
InstrHashtbl.add current_states k
(State_set.join_dropping_relations record.superposition))
current_table;
Db.Value.Record_Value_Callbacks.apply
(stack_for_callbacks, current_states);
end
end;
InstrHashtbl.clear current_table;