From 3fc21123232bea1d4f881c71a172e15fa0aa1f5c Mon Sep 17 00:00:00 2001
From: Pierre Villemot <pierre.villemot@ocamlpro.com>
Date: Tue, 11 Jun 2024 16:00:16 +0200
Subject: [PATCH] Factorize the code of `split_enum` and `split_best`

---
 src/lib/reasoners/adt_rel.ml | 69 ++++++++++++++----------------------
 1 file changed, 27 insertions(+), 42 deletions(-)

diff --git a/src/lib/reasoners/adt_rel.ml b/src/lib/reasoners/adt_rel.ml
index e85d243c4..612a31cac 100644
--- a/src/lib/reasoners/adt_rel.ml
+++ b/src/lib/reasoners/adt_rel.ml
@@ -538,7 +538,7 @@ let remove_redundancies la =
        end
     ) la
 
-(* Update the counter of case-split size in [env]. *)
+(* Update the counter of case split size in [env]. *)
 let count_splits env la =
   List.fold_left
     (fun nb (_, _, _, i) ->
@@ -608,7 +608,7 @@ let can_split env n =
 
 let (let*) = Option.bind
 
-(* Do a cases-plit by choosing a semantic value [r] and constructor [c]
+(* Do a case split by choosing a semantic value [r] and constructor [c]
    for which there are delayed destructor applications and propagate the
    literal [(not (_ is c) r)]. *)
 let split_delayed_destructor env =
@@ -630,27 +630,26 @@ let split_delayed_destructor env =
 (* Pick a constructor in a tracked domain with minimal cardinal.
    Returns [None] if there is no such constructor. *)
 let pick_best ds =
-  let* _, r, c =
-    Domains.fold
-      (fun r d best ->
-         let cd = Domain.cardinal d in
-         match Th.embed r, best with
-         | Constr _, _ -> best
-         | _, Some (n, _, _) when n <= cd -> best
-         | _ ->
-           let c = Domain.choose d in
-           Some (cd, r, c)
-      ) ds None
-  in
-  Some (r, c)
+  Domains.fold
+    (fun r d best ->
+       let cd = Domain.cardinal d in
+       match Th.embed r, best with
+       | Constr _, _ -> best
+       | _, Some (n, _, _) when n <= cd -> best
+       | _ ->
+         let c = Domain.choose d in
+         Some (cd, r, c)
+    ) ds None
 
-let pick_enum ds uf =
+(* Pick a constructor in a tracked domain whose the domain is of minimal
+   cardinal among tracked domains of enum types. Returns [None] if there is no
+   such constructor. *)
+let pick_enum ds =
   Domains.fold_enums
     (fun r best ->
-       let rr, _ = Uf.find_r uf r in
        let d = Domains.get r ds in
        let cd = Domain.cardinal d in
-       match Th.embed rr, best with
+       match Th.embed r, best with
        | Constr _, _ -> best
        | _, Some (n, _, _) when n <= cd -> best
        | _ ->
@@ -658,11 +657,15 @@ let pick_enum ds uf =
          Some (cd, r, c)
     ) ds None
 
-let split_enum env uf =
+let pick_domain ~for_model uf =
   let ds = Uf.(GlobalDomains.find (module Domains) @@ domains uf) in
-  let* n, r, c = pick_enum ds uf in
-  let n = Numbers.Q.from_int n in
-  if can_split env n then
+  match pick_enum ds with
+  | None when for_model -> pick_best ds
+  | r -> r
+
+let split_domain ~for_model env uf =
+  let* cd, r, c = pick_domain ~for_model uf in
+  if for_model || can_split env (Numbers.Q.from_int cd) then
     let _, cons = Option.get @@ build_constr_eq r c in
     let nr, ctx = X.make cons in
     (* In the current implementation of `X.make`, we produce
@@ -674,28 +677,10 @@ let split_enum env uf =
   else
     None
 
-let split_best_domain ~for_model uf =
-  if not for_model then
-    None
-  else
-    let ds = Uf.(GlobalDomains.find (module Domains) @@ domains uf) in
-    let* r, c = pick_best ds in
-    let _, cons = Option.get @@ build_constr_eq r c in
-    let nr, ctx = X.make cons in
-    (* In the current implementation of `X.make`, we produce
-       a nonempty context only for interpreted semantic values
-       of the `Arith` and `Records` theories. The semantic
-       values `cons` never involves such values. *)
-    assert (Lists.is_empty ctx);
-    Some (LR.mkv_eq r nr)
-
 let next_case_split ~for_model env uf =
   match split_delayed_destructor env with
-  | Some _ as r -> r
-  | None ->
-    match split_enum env uf with
-    | Some _ as r -> r
-    | None -> split_best_domain ~for_model uf
+  | None -> split_domain ~for_model env uf
+  | r -> r
 
 let case_split env uf ~for_model =
   if Options.get_disable_adts () then