fix(solver): in final-check, fixpoint until CC has no merges

src/cc/Sidekick_cc.ml

@@ -260,6 +260,7 @@ module Make (A: CC_ARG)
     mutable on_new_term: ev_on_new_term list;
     mutable on_conflict: ev_on_conflict list;
     mutable on_propagate: ev_on_propagate list;
+    mutable new_merges: bool;
     bitgen: Bits.bitfield_gen;
     field_marked_explain: Bits.field; (* used to mark traversed nodes when looking for a common ancestor *)
     true_ : node lazy_t;
@@ -618,7 +619,9 @@ module Make (A: CC_ARG)
     end
 
   and[@inline] task_combine_ cc acts = function
-    | CT_merge (a,b,e_ab) -> task_merge_ cc acts a b e_ab
+    | CT_merge (a,b,e_ab) ->
+      cc.new_merges <- true;
+      task_merge_ cc acts a b e_ab
 
   (* main CC algo: merge equivalence classes in [st.combine].
      @raise Exn_unsat if merge fails *)
@@ -861,6 +864,7 @@ module Make (A: CC_ARG)
       true_;
       false_;
       stat;
+      new_merges=false;
       field_marked_explain;
       count_conflict=Stat.mk_int stat "cc.conflicts";
       count_props=Stat.mk_int stat "cc.propagations";
@@ -881,8 +885,11 @@ module Make (A: CC_ARG)
 
   let[@inline] check cc acts : unit =
     Log.debug 5 "(cc.check)";
+    cc.new_merges <- false;
     update_tasks cc acts
 
+  let new_merges cc = cc.new_merges
+
   (* model: return all the classes *)
   let get_model (cc:t) : repr Iter.t Iter.t =
     all_classes cc |> Iter.map N.iter_class

src/core/Sidekick_core.ml

@@ -299,6 +299,10 @@ module type CC_S = sig
   (** Perform all pending operations done via {!assert_eq}, {!assert_lit}, etc.
       Will use the {!actions} to propagate literals, declare conflicts, etc. *)
 
+  val new_merges : t -> bool
+  (** Called after {!check}, returns [true] if some pairs of classes
+      were merged. *)
+
   val push_level : t -> unit
   (** Push backtracking level *)
 

src/msat-solver/Sidekick_msat_solver.ml

@@ -299,6 +299,8 @@ module Make(A : ARG)
       CC.pop_levels (cc self) n;
       pop_lvls_ n self.th_states
 
+    exception E_loop_exit
+
     (* handle a literal assumed by the SAT solver *)
     let assert_lits_ ~final (self:t) (acts:actions) (lits:Lit.t Iter.t) : unit =
       Msat.Log.debugf 2
@@ -312,11 +314,17 @@ module Make(A : ARG)
       (* transmit to theories. *)
       CC.check cc acts;
       if final then (
-        for _i = 0 to 1 do
-        List.iter (fun f -> f self acts lits) self.on_final_check;
-        CC.check cc acts;
-      done; (* FIXME *)
-        (* TODO: theory combination until fixpoint *)
+        try
+          while true do
+            (* TODO: theory combination *)
+            List.iter (fun f -> f self acts lits) self.on_final_check;
+            CC.check cc acts;
+            if not @@ CC.new_merges cc then (
+              raise_notrace E_loop_exit
+            );
+          done;
+        with E_loop_exit ->
+          ()
       ) else (
         List.iter (fun f -> f self acts lits) self.on_partial_check;
       );