Register cases rules on lattice carriers for aesop automation

Tag the finite lattice carrier types with `@[aesop safe cases]`
(`AboveBelow`, `Sign`) so aesop performs the dominant proof step in this
framework -- case-splitting a lattice element -- automatically. Combined
with the existing `@[simp]` operation lemmas, this collapses the recurring
"case-split then reduce" proofs to a bare `aesop`:

  * AboveBelow's six lattice axioms drop their explicit `rcases`
  * Sign/Constant `plus_mono₂`/`minus_mono₂` become `by aesop`
  * Constant `plus_valid`/`minus_valid` shrink to a 2-line `rcases <;> simp_all`
  * `not_mk_lt_mk` is reexpressed via `le_cases`

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

lean/Spa/Analysis/Constant.lean

@@ -29,15 +29,13 @@ def minus : ConstLattice → ConstLattice → ConstLattice
 
 lemma plus_mono₂ : Monotone₂ plus :=
   AboveBelow.monotone₂_of_strict plus
-    (fun y => by cases y <;> rfl) (fun x => by cases x <;> rfl)
+    (fun y => by aesop) (fun x => by aesop)
-    (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl)
+    (fun y hy => by aesop) (fun x hx => by aesop)
-    (fun x hx => by cases x <;> first | exact absurd rfl hx | rfl)
 
 lemma minus_mono₂ : Monotone₂ minus :=
   AboveBelow.monotone₂_of_strict minus
-    (fun y => by cases y <;> rfl) (fun x => by cases x <;> rfl)
+    (fun y => by aesop) (fun x => by aesop)
-    (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl)
+    (fun y hy => by aesop) (fun x hx => by aesop)
-    (fun x hx => by cases x <;> first | exact absurd rfl hx | rfl)
 
 def interpConst : ConstLattice → Value → Prop
   | .bot, _ => False
@@ -96,36 +94,14 @@ def output : String :=
 lemma plus_valid {g₁ g₂ : ConstLattice} {z₁ z₂ : ℤ}
     (h₁ : ⟦g₁⟧ (.int z₁)) (h₂ : ⟦g₂⟧ (.int z₂)) :
     ⟦plus g₁ g₂⟧ (.int (z₁ + z₂)) := by
-  rcases g₁ with _ | _ | c₁
+  rcases g₁ with _ | _ | c₁ <;> rcases g₂ with _ | _ | c₂ <;>
-  · exact h₁.elim
+    simp_all [plus, constInterpretation, interpConst]
-  · rcases g₂ with _ | _ | c₂
-    · exact h₂.elim
-    · exact trivial
-    · exact trivial
-  · rcases g₂ with _ | _ | c₂
-    · exact h₂.elim
-    · exact trivial
-    · injection h₁ with hz₁
-      injection h₂ with hz₂
-      show Value.int (z₁ + z₂) = Value.int (c₁ + c₂)
-      rw [hz₁, hz₂]
 
 lemma minus_valid {g₁ g₂ : ConstLattice} {z₁ z₂ : ℤ}
     (h₁ : ⟦g₁⟧ (.int z₁)) (h₂ : ⟦g₂⟧ (.int z₂)) :
     ⟦minus g₁ g₂⟧ (.int (z₁ - z₂)) := by
-  rcases g₁ with _ | _ | c₁
+  rcases g₁ with _ | _ | c₁ <;> rcases g₂ with _ | _ | c₂ <;>
-  · exact h₁.elim
+    simp_all [minus, constInterpretation, interpConst]
-  · rcases g₂ with _ | _ | c₂
-    · exact h₂.elim
-    · exact trivial
-    · exact trivial
-  · rcases g₂ with _ | _ | c₂
-    · exact h₂.elim
-    · exact trivial
-    · injection h₁ with hz₁
-      injection h₂ with hz₂
-      show Value.int (z₁ - z₂) = Value.int (c₁ - c₂)
-      rw [hz₁, hz₂]
 
 instance eval_valid : ValidExprEvaluator ConstLattice prog := by
   constructor

lean/Spa/Analysis/Sign.lean

@@ -13,6 +13,8 @@ inductive Sign where
   | zero
   deriving DecidableEq
 
+attribute [aesop safe cases] Sign
+
 instance : Showable Sign :=
   ⟨fun
     | .plus => "+"
@@ -57,21 +59,13 @@ def minus : SignLattice → SignLattice → SignLattice
 
 lemma plus_mono₂ : Monotone₂ plus :=
   AboveBelow.monotone₂_of_strict plus
-    (fun y => by cases y <;> rfl)
+    (fun y => by aesop) (fun x => by aesop)
-    (fun x => by rcases x with _ | _ | s <;> first | rfl | (cases s <;> rfl))
+    (fun y hy => by aesop) (fun x hx => by aesop)
-    (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl)
-    (fun x hx => by
-      rcases x with _ | _ | s <;>
-        first | exact absurd rfl hx | rfl | (cases s <;> rfl))
 
 lemma minus_mono₂ : Monotone₂ minus :=
   AboveBelow.monotone₂_of_strict minus
-    (fun y => by cases y <;> rfl)
+    (fun y => by aesop) (fun x => by aesop)
-    (fun x => by rcases x with _ | _ | s <;> first | rfl | (cases s <;> rfl))
+    (fun y hy => by aesop) (fun x hx => by aesop)
-    (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl)
-    (fun x hx => by
-      rcases x with _ | _ | s <;>
-        first | exact absurd rfl hx | rfl | (cases s <;> rfl))
 
 def interpSign : SignLattice → Value → Prop
   | .bot, _ => False

lean/Spa/Lattice/AboveBelow.lean

@@ -10,6 +10,8 @@ inductive AboveBelow (α : Type*) where
 
 namespace AboveBelow
 
+attribute [aesop safe cases] AboveBelow
+
 instance {α : Type*} [ToString α] : ToString (AboveBelow α) where
   toString
     | bot => "⊥"
@@ -49,22 +51,22 @@ instance : Min (AboveBelow α) where
     (mk x ⊓ mk y : AboveBelow α) = if x = y then mk x else bot := rfl
 
 protected lemma sup_comm (a b : AboveBelow α) : a ⊔ b = b ⊔ a := by
-  rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop
+  aesop
 
 protected lemma sup_assoc (a b c : AboveBelow α) : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) := by
-  rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> rcases c with _ | _ | z <;> aesop
+  aesop
 
 protected lemma inf_comm (a b : AboveBelow α) : a ⊓ b = b ⊓ a := by
-  rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop
+  aesop
 
 protected lemma inf_assoc (a b c : AboveBelow α) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) := by
-  rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> rcases c with _ | _ | z <;> aesop
+  aesop
 
 protected lemma sup_inf_self (a b : AboveBelow α) : a ⊔ a ⊓ b = a := by
-  rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop
+  aesop
 
 protected lemma inf_sup_self (a b : AboveBelow α) : a ⊓ (a ⊔ b) = a := by
-  rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop
+  aesop
 
 instance : Lattice (AboveBelow α) :=
   Lattice.mk' AboveBelow.sup_comm AboveBelow.sup_assoc
@@ -189,13 +191,7 @@ def rank : AboveBelow α → ℕ
 lemma not_mk_lt_mk (x y : α) : ¬(mk x : AboveBelow α) < mk y := by
   intro h
   obtain ⟨hle, hne⟩ := lt_iff_le_and_ne.mp h
-  have hsup := le_iff.mp hle
+  rcases le_cases hle with h | h | h <;> simp_all
-  rw [mk_sup_mk] at hsup
-  by_cases hxy : x = y
-  · rw [if_pos hxy] at hsup
-    exact hne hsup
-  · rw [if_neg hxy] at hsup
-    exact absurd hsup (by simp)
 
 lemma rank_strictMono : StrictMono (rank : AboveBelow α → ℕ) := by
   intro a b hab