Lean migration: typeclass-based parameter passing, as in the Agda original

The port had flattened Agda's instance arguments ({{flA}}, {{evaluator}},
{{latticeInterpretation}}, {{validEvaluator}}) into explicitly threaded
values (fhL, E, I, hE). Restore them as typeclasses:

- Spa.FiniteHeightLattice: now actually used — Fixedpoint takes the
  instance instead of a FixedHeight value; FiniteMap gets the missing
  instance (height = ks.length * height B), so varsFixedHeight /
  statesFixedHeight / signFixedHeight / constFixedHeight plumbing
  disappears (instance bottoms are defeq to the old ones)
- Spa.Analysis.Forward.Evaluation: StmtEvaluator/ExprEvaluator become
  classes; the Valid* Props become Prop-classes, as in Agda
- Spa.Analysis.Forward.Adapters: the expr→stmt adapter and its validity
  are instances (Agda: the ExprToStmtAdapter instances)
- LatticeInterpretation is a class; sign/const interpretations,
  evaluators and validity proofs are instances; use sites read like the
  Agda module applications: result SignLattice prog

Proof simplifications (same theorems, proofs factored):

- Spa.Lattice.AboveBelow.monotone₂_of_strict: any ⊥-strict/⊤-dominated
  operation on a flat lattice is monotone — replaces the four near-
  identical case bashes per analysis (postulates in Agda)
- Spa.Lattice.AboveBelow.interp_sup_of/interp_inf_of: the shared flat-
  lattice interpretation case analysis, making interpSign_sup/inf and
  interpConst_sup/inf one-liners

lake build green with zero warnings; lake exe spa output verified
byte-identical (diff) to the previous, Agda-verified output.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>

lean/Spa/Analysis/Sign.lean

@@ -5,11 +5,13 @@ Correspondence:
   Sign (+ / - / 0ˢ)         ↦ Sign.plus / Sign.minus / Sign.zero
   _≟ᵍ_, ≡-equiv, ≡-Decidable ↦ deriving DecidableEq
   SignLattice (AboveBelow)  ↦ SignLattice
-  AB.Plain 0ˢ               ↦ signFixedHeight (AboveBelow.plainFixedHeight .zero)
+  AB.Plain 0ˢ               ↦ the AboveBelow FiniteHeightLattice instance,
+                              seeded by `Inhabited Sign := ⟨.zero⟩`
   plus, minus               ↦ plus, minus
   plus-Monoˡ/ʳ, minus-Monoˡ/ʳ (postulates in Agda!)
                             ↦ plus_mono_left/right, minus_mono_left/right —
-                              now actually proved, via AboveBelow.le_cases
+                              now actually proved, via
+                              AboveBelow.monotone₂_of_strict
   plus-Mono₂, minus-Mono₂   ↦ plus_mono₂, minus_mono₂
   ⟦_⟧ᵍ                      ↦ interpSign
   ⟦⟧ᵍ-respects-≈ᵍ           ↦ (trivial with `=`)
@@ -41,15 +43,12 @@ instance : Showable Sign :=
     | .minus => "-"
     | .zero => "0"⟩
 
-/-- Agda: the module parameter `x = 0ˢ` of `AB.Plain`. -/
+/-- Agda: the module parameter `x = 0ˢ` of `AB.Plain` (it seeds the
+`FiniteHeightLattice (AboveBelow Sign)` instance). -/
 instance : Inhabited Sign := ⟨.zero⟩
 
 abbrev SignLattice : Type := AboveBelow Sign
 
-/-- Agda: `AB.Plain 0ˢ`'s `fixedHeight`. -/
-def signFixedHeight : FixedHeight SignLattice 2 :=
-  AboveBelow.plainFixedHeight Sign.zero
-
 open AboveBelow in
 /-- Agda: `plus`. -/
 def plus : SignLattice → SignLattice → SignLattice
@@ -84,81 +83,39 @@ def minus : SignLattice → SignLattice → SignLattice
   | mk .zero, mk .minus => mk .plus
   | mk .zero, mk .zero => mk .zero
 
+/-- Agda: `plus-Mono₂` (its components were postulates in Agda; `plus` is a
+strict operation on the flat lattice, so monotonicity holds regardless of the
+sign table). -/
+theorem plus_mono₂ : Monotone₂ plus :=
+  AboveBelow.monotone₂_of_strict plus
+    (fun y => by cases y <;> rfl)
+    (fun x => by rcases x with _ | _ | s <;> first | rfl | (cases s <;> rfl))
+    (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))
+
 /-- Agda: `plus-Monoˡ` — a postulate there, a theorem here. -/
-theorem plus_mono_left (s₂ : SignLattice) : Monotone (plus · s₂) := by
-  intro a b h
-  rcases AboveBelow.le_cases h with rfl | rfl | rfl
-  · rcases s₂ with _ | _ | y <;> rcases b with _ | _ | x <;>
-      simp only [plus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-        | exact AboveBelow.bot_le' _
-  · rcases s₂ with _ | _ | y <;> rcases a with _ | _ | x <;>
-      simp only [plus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-  · exact le_refl _
+theorem plus_mono_left (s₂ : SignLattice) : Monotone (plus · s₂) := plus_mono₂.1 s₂
 
 /-- Agda: `plus-Monoʳ` — a postulate there, a theorem here. -/
-theorem plus_mono_right (s₁ : SignLattice) : Monotone (plus s₁) := by
-  intro a b h
-  rcases AboveBelow.le_cases h with rfl | rfl | rfl
-  · rcases s₁ with _ | _ | x <;> rcases b with _ | _ | y <;>
-      simp only [plus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-        | exact AboveBelow.bot_le' _
-  · rcases s₁ with _ | _ | x <;> rcases a with _ | _ | y <;>
-      simp only [plus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-  · exact le_refl _
+theorem plus_mono_right (s₁ : SignLattice) : Monotone (plus s₁) := plus_mono₂.2 s₁
 
-/-- Agda: `plus-Mono₂`. -/
-theorem plus_mono₂ : Monotone₂ plus :=
-  ⟨plus_mono_left, plus_mono_right⟩
+/-- Agda: `minus-Mono₂` (likewise from strictness of `minus`). -/
+theorem minus_mono₂ : Monotone₂ minus :=
+  AboveBelow.monotone₂_of_strict minus
+    (fun y => by cases y <;> rfl)
+    (fun x => by rcases x with _ | _ | s <;> first | rfl | (cases s <;> rfl))
+    (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))
 
 /-- Agda: `minus-Monoˡ` — a postulate there, a theorem here. -/
-theorem minus_mono_left (s₂ : SignLattice) : Monotone (minus · s₂) := by
-  intro a b h
-  rcases AboveBelow.le_cases h with rfl | rfl | rfl
-  · rcases s₂ with _ | _ | y <;> rcases b with _ | _ | x <;>
-      simp only [minus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-        | exact AboveBelow.bot_le' _
-  · rcases s₂ with _ | _ | y <;> rcases a with _ | _ | x <;>
-      simp only [minus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-  · exact le_refl _
+theorem minus_mono_left (s₂ : SignLattice) : Monotone (minus · s₂) := minus_mono₂.1 s₂
 
 /-- Agda: `minus-Monoʳ` — a postulate there, a theorem here. -/
-theorem minus_mono_right (s₁ : SignLattice) : Monotone (minus s₁) := by
-  intro a b h
-  rcases AboveBelow.le_cases h with rfl | rfl | rfl
-  · rcases s₁ with _ | _ | x <;> rcases b with _ | _ | y <;>
-      simp only [minus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-        | exact AboveBelow.bot_le' _
-  · rcases s₁ with _ | _ | x <;> rcases a with _ | _ | y <;>
-      simp only [minus] <;>
-      first
-        | exact le_refl _
-        | exact AboveBelow.le_top' _
-  · exact le_refl _
-
-/-- Agda: `minus-Mono₂`. -/
-theorem minus_mono₂ : Monotone₂ minus :=
-  ⟨minus_mono_left, minus_mono_right⟩
+theorem minus_mono_right (s₁ : SignLattice) : Monotone (minus s₁) := minus_mono₂.2 s₁
 
 /-- Agda: `⟦_⟧ᵍ`. -/
 def interpSign : SignLattice → Value → Prop
@@ -197,48 +154,18 @@ theorem interpSign_mk_disjoint {s₁ s₂ : Sign} (hne : s₁ ≠ s₂) {v : Val
     injection hv with hz
     omega
 
-/-- Agda: `⟦⟧ᵍ-⊔ᵍ-∨`. -/
+/-- Agda: `⟦⟧ᵍ-⊔ᵍ-∨` (via the factored flat-lattice lemma). -/
 theorem interpSign_sup {s₁ s₂ : SignLattice} (v : Value)
-    (h : interpSign s₁ v ∨ interpSign s₂ v) : interpSign (s₁ ⊔ s₂) v := by
-  rcases s₁ with _ | _ | x
-  · rcases h with h | h
-    · exact h.elim
-    · rw [AboveBelow.bot_sup]
-      exact h
-  · exact trivial
-  · rcases s₂ with _ | _ | y
-    · rcases h with h | h
-      · rw [AboveBelow.sup_bot]
-        exact h
-      · exact h.elim
-    · rw [AboveBelow.sup_top]
-      exact trivial
-    · by_cases hxy : x = y
-      · subst hxy
-        rw [AboveBelow.mk_sup_mk, if_pos rfl]
-        rcases h with h | h <;> exact h
-      · rw [AboveBelow.mk_sup_mk, if_neg hxy]
-        exact trivial
+    (h : interpSign s₁ v ∨ interpSign s₂ v) : interpSign (s₁ ⊔ s₂) v :=
+  AboveBelow.interp_sup_of (fun _ h => h) (fun _ => trivial) v h
 
-/-- Agda: `⟦⟧ᵍ-⊓ᵍ-∧`. -/
+/-- Agda: `⟦⟧ᵍ-⊓ᵍ-∧` (via the factored flat-lattice lemma). -/
 theorem interpSign_inf {s₁ s₂ : SignLattice} (v : Value)
-    (h : interpSign s₁ v ∧ interpSign s₂ v) : interpSign (s₁ ⊓ s₂) v := by
-  rcases s₁ with _ | _ | x
-  · exact h.1
-  · rw [AboveBelow.top_inf]
-    exact h.2
-  · rcases s₂ with _ | _ | y
-    · exact h.2
-    · rw [AboveBelow.inf_top]
-      exact h.1
-    · by_cases hxy : x = y
-      · subst hxy
-        rw [AboveBelow.mk_inf_mk, if_pos rfl]
-        exact h.1
-      · exact absurd h (interpSign_mk_disjoint hxy)
+    (h : interpSign s₁ v ∧ interpSign s₂ v) : interpSign (s₁ ⊓ s₂) v :=
+  AboveBelow.interp_inf_of (fun hne _ => interpSign_mk_disjoint hne) v h
 
-/-- Agda: `latticeInterpretationᵍ`. -/
-def signInterpretation : LatticeInterpretation SignLattice where
+/-- Agda: `latticeInterpretationᵍ` (an instance there too). -/
+instance signInterpretation : LatticeInterpretation SignLattice where
   interp := interpSign
   interp_sup := fun {l₁ l₂} v h => interpSign_sup (s₁ := l₁) (s₂ := l₂) v h
   interp_inf := fun {l₁ l₂} v h => interpSign_inf (s₁ := l₁) (s₂ := l₂) v h
@@ -282,12 +209,12 @@ theorem eval_mono (e : Expr) : Monotone (eval prog e) := by
     cases n <;> exact le_refl _
 
 /-- Agda: the `SignEval` instance. -/
-def exprEvaluator : ExprEvaluator SignLattice prog :=
+instance exprEvaluator : ExprEvaluator SignLattice prog :=
   ⟨eval prog, eval_mono prog⟩
 
 /-- Agda: `WithProg.result`/`output` — the analysis result, printed. -/
 def output : String :=
-  show' (result signFixedHeight (exprEvaluator prog).toStmtEvaluator)
+  show' (result SignLattice prog)
 
 /-- Agda: `plus-valid`. -/
 theorem plus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
@@ -365,9 +292,9 @@ theorem minus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
         subst h₂
         omega
 
-/-- Agda: `eval-valid` / `SignEvalValid`. -/
-theorem eval_valid :
-    IsValidExprEvaluator (exprEvaluator prog) signInterpretation := by
+/-- Agda: `eval-valid` / the `SignEvalValid` instance. -/
+instance eval_valid : ValidExprEvaluator SignLattice prog := by
+  constructor
   intro vs ρ e v hev
   induction hev with
   | num n =>
@@ -400,11 +327,8 @@ theorem eval_valid :
 
 /-- Agda: `WithProg.analyze-correct`. -/
 theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
-    interpV signInterpretation
-      (variablesAt prog.finalState
-        (result signFixedHeight (exprEvaluator prog).toStmtEvaluator)) ρ :=
-  Spa.analyze_correct signFixedHeight
-    ((exprEvaluator prog).toStmtEvaluator_valid (eval_valid prog)) hrun
+    interpV (variablesAt prog.finalState (result SignLattice prog)) ρ :=
+  Spa.analyze_correct SignLattice prog hrun
 
 end SignAnalysis