refactor(preprocess): break infinite recursion

src/core/box.ml

@@ -25,9 +25,14 @@ let as_box t =
   | Term.E_const { Const.c_view = Box u; _ } -> Some u
   | _ -> None
 
+let is_box t =
+  match Term.view t with
+  | Term.E_const { Const.c_view = Box _; _ } -> true
+  | _ -> false
+
 let box tst t : Term.t =
   match Term.view t with
-  | Term.E_const { Const.c_view = Box _; _ } -> t
+  | Term.E_const { Const.c_view = _; _ } -> t
   | _ ->
     let c = Const.make (Box t) ~ty:(Term.ty t) ops in
     Term.const tst c

src/core/box.mli

@@ -7,3 +7,4 @@ val box : Term.store -> Term.t -> Term.t
   This way it will be opaque. *)
 
 val as_box : Term.t -> Term.t option
+val is_box : Term.t -> bool

src/smt/preprocess.ml

@@ -89,12 +89,15 @@ let preprocess_term_ (self : t) (t : term) : term =
         match
           CCList.find_map
             (fun f ->
-              f self ~is_sub ~recurse:(preproc_rec_ ~is_sub:true) acts t)
+              f self ~is_sub ~recurse:(preproc_rec_ ~is_sub:true) acts t0)
             self.preprocess
         with
         | Some u ->
-          (* preprocess [u], to achieve fixpoint *)
-          preproc_rec_ ~is_sub u
+          (* only accept a box (with possible side effect: new clauses, etc.) *)
+          Log.debugf 20 (fun k ->
+              k "(@[smt.preprocess.tr@ %a@ :into %a@])" Term.pp t0 Term.pp u);
+          assert (Box.is_box u || Term.is_const u);
+          u
         | None ->
           (* just preprocess subterms *)
           Term.map_shallow self.tst t0 ~f:(fun _inb u ->

src/smt/solver_internal.ml

@@ -121,10 +121,18 @@ let delayed_add_lit (self : t) ?default_pol (lit : Lit.t) : unit =
 let delayed_add_clause (self : t) ~keep (c : Lit.t list) (pr : step_id) : unit =
   Queue.push (DA_add_clause { c; pr; keep }) self.delayed_actions
 
+let add_preprocess_delayed_actions (self : t) : unit =
+  Preprocess.pop_delayed_actions self.preprocess (function
+    | DA_add_clause (c, pr) -> delayed_add_clause self ~keep:true c pr
+    | DA_add_lit { default_pol; lit } -> delayed_add_lit self ?default_pol lit
+    | DA_declare_need_th_combination t ->
+      Th_combination.add_term_needing_combination self.th_comb t)
+
 let push_decision (self : t) (acts : theory_actions) (lit : lit) : unit =
   let (module A) = acts in
   (* make sure the literal is preprocessed *)
   let lit, _ = Preprocess.simplify_and_preproc_lit self.preprocess lit in
+  add_preprocess_delayed_actions self;
   let sign = Lit.sign lit in
   A.add_decision_lit (Lit.abs lit) sign
 
@@ -143,9 +151,11 @@ module Perform_delayed (A : PERFORM_ACTS) = struct
       match act with
       | DA_add_clause { c; pr = pr_c; keep } ->
         let c', pr_c' = Preprocess.preprocess_clause self.preprocess c pr_c in
+        add_preprocess_delayed_actions self;
         A.add_clause self acts ~keep c' pr_c'
       | DA_add_lit { default_pol; lit } ->
         let lit, _ = Preprocess.simplify_and_preproc_lit self.preprocess lit in
+        add_preprocess_delayed_actions self;
         A.add_lit self acts ?default_pol lit
     done
 end
@@ -164,20 +174,28 @@ end)
 let[@inline] preprocess self = self.preprocess
 
 let preprocess_clause self c pr =
-  Preprocess.preprocess_clause self.preprocess c pr
+  let r = Preprocess.preprocess_clause self.preprocess c pr in
+  add_preprocess_delayed_actions self;
+  r
 
 let preprocess_clause_array self c pr =
-  Preprocess.preprocess_clause_array self.preprocess c pr
+  let r = Preprocess.preprocess_clause_array self.preprocess c pr in
+  add_preprocess_delayed_actions self;
+  r
 
 let simplify_and_preproc_lit self lit =
-  Preprocess.simplify_and_preproc_lit self.preprocess lit
+  let r = Preprocess.simplify_and_preproc_lit self.preprocess lit in
+  add_preprocess_delayed_actions self;
+  r
 
 let[@inline] add_clause_temp self _acts c (proof : step_id) : unit =
   let c, proof = Preprocess.preprocess_clause self.preprocess c proof in
+  add_preprocess_delayed_actions self;
   delayed_add_clause self ~keep:false c proof
 
 let[@inline] add_clause_permanent self _acts c (proof : step_id) : unit =
   let c, proof = Preprocess.preprocess_clause self.preprocess c proof in
+  add_preprocess_delayed_actions self;
   delayed_add_clause self ~keep:true c proof
 
 let[@inline] mk_lit self ?sign t : lit = Lit.atom ?sign self.tst t
@@ -194,6 +212,7 @@ let[@inline] add_lit self _acts ?default_pol lit =
 let add_lit_t self _acts ?sign t =
   let lit = Lit.atom ?sign self.tst t in
   let lit, _ = Preprocess.simplify_and_preproc_lit self.preprocess lit in
+  add_preprocess_delayed_actions self;
   delayed_add_lit self lit
 
 let on_final_check self f = self.on_final_check <- f :: self.on_final_check

src/th-data/Sidekick_th_data.ml

@@ -296,7 +296,6 @@ end = struct
   module N_tbl = Backtrackable_tbl.Make (E_node)
 
   type t = {
-    th_id: Sidekick_smt_solver.Theory_id.t;
     tst: Term.store;
     proof: Proof_trace.t;
     cstors: ST_cstors.t; (* repr -> cstor for the class *)
@@ -789,10 +788,9 @@ end = struct
   (* TODO: event/function to declare new datatypes, so we can claim them
      early *)
 
-  let create_and_setup ~id:th_id (solver : SI.t) : t =
+  let create_and_setup ~id:_ (solver : SI.t) : t =
     let self =
       {
-        th_id;
         tst = SI.tst solver;
         proof = SI.proof solver;
         cstors = ST_cstors.create_and_setup ~size:32 (SI.cc solver);