fix: Bool disequality propagation in grind (#7781)

This PR adds a new propagation rule for `Bool` disequalities to `grind`.
It now propagates `x = true` (`x = false`) from the disequality `x =
false` (`x = true`). It ensures we don't have to perform case analysis
on `x` to learn this fact. See tests.

src/Init/Grind/Lemmas.lean

@@ -113,6 +113,9 @@ theorem Bool.not_eq_of_eq_false {a : Bool} (h : a = false) : (!a) = true := by s
 theorem Bool.eq_false_of_not_eq_true {a : Bool} (h : (!a) = true) : a = false := by simp_all
 theorem Bool.eq_true_of_not_eq_false {a : Bool} (h : (!a) = false) : a = true := by simp_all
 
+theorem Bool.eq_false_of_not_eq_true' {a : Bool} (h : ¬ a = true) : a = false := by simp_all
+theorem Bool.eq_true_of_not_eq_false' {a : Bool} (h : ¬ a = false) : a = true := by simp_all
+
 theorem Bool.false_of_not_eq_self {a : Bool} (h : (!a) = a) : False := by
   by_cases a <;> simp_all
 

src/Lean/Meta/Tactic/Grind/Propagate.lean

@@ -119,15 +119,25 @@ builtin_grind_propagator propagateNotDown ↓Not := fun e => do
   else if (← isEqv e a) then
     closeGoal <| mkApp2 (mkConst ``Grind.false_of_not_eq_self) a (← mkEqProof e a)
 
+def propagateBoolDiseq (a : Expr) : GoalM Unit := do
+  if let some h ← mkDiseqProof? a (← getBoolFalseExpr) then
+    pushEqBoolTrue a <| mkApp2 (mkConst ``Grind.Bool.eq_true_of_not_eq_false') a h
+  if let some h ← mkDiseqProof? a (← getBoolTrueExpr) then
+    pushEqBoolFalse a <| mkApp2 (mkConst ``Grind.Bool.eq_false_of_not_eq_true') a h
+
 /-- Propagates `Eq` upwards -/
 builtin_grind_propagator propagateEqUp ↑Eq := fun e => do
-  let_expr Eq _ a b := e | return ()
+  let_expr Eq α a b := e | return ()
   if (← isEqTrue a) then
     pushEq e b <| mkApp3 (mkConst ``Grind.eq_eq_of_eq_true_left) a b (← mkEqTrueProof a)
   else if (← isEqTrue b) then
     pushEq e a <| mkApp3 (mkConst ``Grind.eq_eq_of_eq_true_right) a b (← mkEqTrueProof b)
   else if (← isEqv a b) then
     pushEqTrue e <| mkEqTrueCore e (← mkEqProof a b)
+  if α.isConstOf ``Bool then
+    if (← isEqFalse e) then
+      propagateBoolDiseq a
+      propagateBoolDiseq b
   let aRoot ← getRootENode a
   let bRoot ← getRootENode b
   if aRoot.ctor && bRoot.ctor && aRoot.self.getAppFn != bRoot.self.getAppFn then
@@ -146,6 +156,9 @@ builtin_grind_propagator propagateEqDown ↓Eq := fun e => do
     pushEq a b <| mkOfEqTrueCore e (← mkEqTrueProof e)
   else if (← isEqFalse e) then
     let_expr Eq α lhs rhs := e | return ()
+    if α.isConstOf ``Bool then
+      propagateBoolDiseq lhs
+      propagateBoolDiseq rhs
     propagateCutsatDiseq lhs rhs
     let thms ← getExtTheorems α
     if !thms.isEmpty then

tests/lean/grind/list_problems.lean

@@ -1,28 +0,0 @@
-open List Nat
-
-attribute [grind] List.getElem_cons_zero
-
-attribute [grind] List.filter_nil List.filter_cons
-attribute [grind] List.any_nil List.any_cons
-
-@[simp] theorem any_filter {l : List α} {p q : α → Bool} :
-    (filter p l).any q = l.any fun a => p a && q a := by
-  induction l <;> grind
-  -- Fails at:
-  -- [grind] Goal diagnostics ▼
-  -- [facts] Asserted facts ▼
-  --   [prop] (filter p tail).any q = tail.any fun a => p a && q a
-  --   [prop] ¬(filter p (head :: tail)).any q = (head :: tail).any fun a => p a && q a
-  --   [prop] filter p (head :: tail) = if p head = true then head :: filter p tail else filter p tail
-  --   [prop] ((head :: tail).any fun a => p a && q a) = (p head && q head || tail.any fun a => p a && q a)
-  --   [prop] ¬p head = true
-  -- [eqc] False propositions ▼
-  --   [prop] (filter p (head :: tail)).any q = (head :: tail).any fun a => p a && q a
-  --   [prop] p head = true
-  -- [eqc] Equivalence classes ▼
-  --   [] {(head :: tail).any fun a => p a && q a, p head && q head || tail.any fun a => p a && q a}
-  --   [] {filter p (head :: tail), filter p tail, if p head = true then head :: filter p tail else filter p tail}
-  --   [] {(filter p tail).any q, (filter p (head :: tail)).any q, tail.any fun a => p a && q a}
-  -- Despite knowing that `p head = false`, grind doesn't see that
-  -- `p head && q head || tail.any fun a => p a && q a = tail.any fun a => p a && q a`,
-  -- which should finish the problem.

tests/lean/run/grind_bool_diseq.lean

@@ -0,0 +1,25 @@
+set_option grind.warning false
+
+example (f : Bool → Nat) : (x = y ↔ q) → ¬ q → y = false → f x = 0 → f true = 0 := by
+  grind (splits := 0)
+
+example (f : Bool → Nat) : (x = false ↔ q) → ¬ q → f x = 0 → f true = 0 := by
+  grind (splits := 0)
+
+example (f : Bool → Nat) : (y = x ↔ q) → ¬ q → y = false → f x = 0 → f true = 0 := by
+  grind (splits := 0)
+
+example (f : Bool → Nat) : (x = true ↔ q) → ¬ q → f x = 0 → f false = 0 := by
+  grind (splits := 0)
+
+example (f : Bool → Nat) : (true = x ↔ q) → ¬ q → f x = 0 → f false = 0 := by
+  grind (splits := 0)
+
+example (f : Bool → Nat) : (false = x ↔ q) → ¬ q → f x = 0 → f true = 0 := by
+  grind (splits := 0)
+
+example (f : Bool → Nat) : (x = false ↔ q) → ¬ q → f x = 0 → f true = 0 := by
+  grind (splits := 0)
+
+example (f : Bool → Nat) : (y = x ↔ q) → ¬ q → y = true → f x = 0 → f false = 0 := by
+  grind (splits := 0)

tests/lean/run/grind_list_issue.lean

@@ -0,0 +1,9 @@
+reset_grind_attrs%
+open List Nat
+
+attribute [grind] List.filter_nil List.filter_cons
+attribute [grind] List.any_nil List.any_cons
+
+@[simp] theorem any_filter {l : List α} {p q : α → Bool} :
+    (filter p l).any q = l.any fun a => p a && q a := by
+  induction l <;> grind