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/Forward/Adapters.lean

@@ -6,8 +6,8 @@ Correspondence:
   updateVariablesFromExpression-Mono      ↦ updateVariablesFromExpression_mono
   (the -k∈ks-≡ / -k∉ks-backward renames   ↦ used directly from FiniteMap)
   evalᵇ, evalᵇ-Monoʳ                      ↦ evalB, evalB_mono
-  stmtEvaluator (instance)                ↦ ExprEvaluator.toStmtEvaluator
-  evalᵇ-valid, validStmtEvaluator         ↦ ExprEvaluator.toStmtEvaluator_valid
+  stmtEvaluator (instance)                ↦ instance StmtEvaluator L prog
+  evalᵇ-valid, validStmtEvaluator         ↦ instance ValidStmtEvaluator L prog
                                             (the Agda `k ≟ˢ k'` case split is
                                             subsumed by `cases` on `Env.Mem`,
                                             whose `here` case forces `k' = k`)
@@ -16,43 +16,41 @@ import Spa.Analysis.Forward.Evaluation
 
 namespace Spa
 
-variable {L : Type} [Lattice L] {prog : Program}
+variable {L : Type} [Lattice L] {prog : Program} [E : ExprEvaluator L prog]
 
 /-- Agda: `updateVariablesFromExpression` — set the single key `k` to the
 value of `e` (the `GeneralizedUpdate` with `ks = [k]`). -/
-def updateVariablesFromExpression (E : ExprEvaluator L prog) (k : String)
-    (e : Expr) (vs : VariableValues L prog) : VariableValues L prog :=
+def updateVariablesFromExpression (k : String) (e : Expr)
+    (vs : VariableValues L prog) : VariableValues L prog :=
   FiniteMap.generalizedUpdate id (fun _ vs => E.eval e vs) [k] vs
 
 /-- Agda: `updateVariablesFromExpression-Mono`. -/
-theorem updateVariablesFromExpression_mono (E : ExprEvaluator L prog)
-    (k : String) (e : Expr) :
-    Monotone (updateVariablesFromExpression E k e) :=
+theorem updateVariablesFromExpression_mono (k : String) (e : Expr) :
+    Monotone (updateVariablesFromExpression (L := L) (prog := prog) k e) :=
   FiniteMap.generalizedUpdate_monotone monotone_id (fun _ => E.eval_mono e)
 
 /-- Agda: `evalᵇ`. -/
-def evalB (E : ExprEvaluator L prog) (_ : prog.State) (bs : BasicStmt)
+def evalB (_ : prog.State) (bs : BasicStmt)
     (vs : VariableValues L prog) : VariableValues L prog :=
   match bs with
-  | .assign k e => updateVariablesFromExpression E k e vs
+  | .assign k e => updateVariablesFromExpression k e vs
   | .noop => vs
 
 /-- Agda: `evalᵇ-Monoʳ`. -/
-theorem evalB_mono (E : ExprEvaluator L prog) (s : prog.State) (bs : BasicStmt) :
-    Monotone (evalB E s bs) := by
+theorem evalB_mono (s : prog.State) (bs : BasicStmt) :
+    Monotone (evalB (L := L) (prog := prog) s bs) := by
   cases bs with
-  | assign k e => exact updateVariablesFromExpression_mono E k e
+  | assign k e => exact updateVariablesFromExpression_mono k e
   | noop => exact monotone_id
 
 /-- Agda: the `stmtEvaluator` instance of `ExprToStmtAdapter`. -/
-def ExprEvaluator.toStmtEvaluator (E : ExprEvaluator L prog) :
-    StmtEvaluator L prog :=
-  ⟨evalB E, evalB_mono E⟩
+instance ExprEvaluator.toStmtEvaluator : StmtEvaluator L prog :=
+  ⟨evalB, evalB_mono⟩
 
 /-- Agda: `evalᵇ-valid` / the `validStmtEvaluator` instance. -/
-theorem ExprEvaluator.toStmtEvaluator_valid (E : ExprEvaluator L prog)
-    {I : LatticeInterpretation L} (hE : IsValidExprEvaluator E I) :
-    IsValidStmtEvaluator E.toStmtEvaluator I := by
+instance ExprEvaluator.toStmtEvaluator_valid [LatticeInterpretation L]
+    [ValidExprEvaluator L prog] : ValidStmtEvaluator L prog := by
+  constructor
   intro s vs ρ₁ ρ₂ bs hbs hvs
   cases hbs with
   | noop => exact hvs
@@ -65,7 +63,7 @@ theorem ExprEvaluator.toStmtEvaluator_valid (E : ExprEvaluator L prog)
       have hl := FiniteMap.generalizedUpdate_mem_eq (f := id)
         (g := fun _ vs => E.eval e vs) (List.mem_singleton_self k) hk'l₀
       rw [hl]
-      exact hE hev hvs
+      exact ValidExprEvaluator.valid hev hvs
     | there _ _ _ _ _ hne hmem' =>
       have hk'l₀ : (k', l) ∈ FiniteMap.generalizedUpdate (ks := prog.vars) id
           (fun _ vs => E.eval e vs) [k] vs := hk'l

lean/Spa/Analysis/Forward/Evaluation.lean

@@ -1,15 +1,15 @@
 /-
 Port of `Analysis/Forward/Evaluation.agda`.
 
+All four records were consumed through Agda instance arguments (`{{evaluator :
+StmtEvaluator}}`, `{{validEvaluator : ValidStmtEvaluator …}}`), so they are
+typeclasses here as well.
+
 Correspondence:
   StmtEvaluator (eval, eval-Monoʳ)  ↦ StmtEvaluator (eval, eval_mono)
   ExprEvaluator (eval, eval-Monoʳ)  ↦ ExprEvaluator (eval, eval_mono)
-  IsValidExprEvaluator              ↦ IsValidExprEvaluator
-  IsValidStmtEvaluator              ↦ IsValidStmtEvaluator
-  ValidExprEvaluator,
-  ValidStmtEvaluator (records)      ↦ (the `IsValid…` Props are passed
-                                      directly; the wrapper records existed
-                                      for Agda instance resolution)
+  ValidExprEvaluator                ↦ ValidExprEvaluator (valid)
+  ValidStmtEvaluator                ↦ ValidStmtEvaluator (valid)
 -/
 import Spa.Analysis.Forward.Lattices
 
@@ -18,27 +18,26 @@ namespace Spa
 variable (L : Type) [Lattice L] (prog : Program)
 
 /-- Agda: `StmtEvaluator`. -/
-structure StmtEvaluator where
+class StmtEvaluator where
   eval : prog.State → BasicStmt → VariableValues L prog → VariableValues L prog
   eval_mono : ∀ s bs, Monotone (eval s bs)
 
 /-- Agda: `ExprEvaluator`. -/
-structure ExprEvaluator where
+class ExprEvaluator where
   eval : Expr → VariableValues L prog → L
   eval_mono : ∀ e, Monotone (eval e)
 
-variable {L prog}
+/-- Agda: `ValidExprEvaluator`. -/
+class ValidExprEvaluator [ExprEvaluator L prog] [I : LatticeInterpretation L] :
+    Prop where
+  valid : ∀ {vs : VariableValues L prog} {ρ : Env} {e : Expr} {v : Value},
+    EvalExpr ρ e v → interpV vs ρ → I.interp (ExprEvaluator.eval e vs) v
 
-/-- Agda: `IsValidExprEvaluator`. -/
-def IsValidExprEvaluator (E : ExprEvaluator L prog)
-    (I : LatticeInterpretation L) : Prop :=
-  ∀ {vs : VariableValues L prog} {ρ : Env} {e : Expr} {v : Value},
-    EvalExpr ρ e v → interpV I vs ρ → I.interp (E.eval e vs) v
-
-/-- Agda: `IsValidStmtEvaluator`. -/
-def IsValidStmtEvaluator (E : StmtEvaluator L prog)
-    (I : LatticeInterpretation L) : Prop :=
-  ∀ {s : prog.State} {vs : VariableValues L prog} {ρ₁ ρ₂ : Env} {bs : BasicStmt},
-    EvalBasicStmt ρ₁ bs ρ₂ → interpV I vs ρ₁ → interpV I (E.eval s bs vs) ρ₂
+/-- Agda: `ValidStmtEvaluator`. -/
+class ValidStmtEvaluator [E : StmtEvaluator L prog] [LatticeInterpretation L] :
+    Prop where
+  valid : ∀ {s : prog.State} {vs : VariableValues L prog} {ρ₁ ρ₂ : Env}
+    {bs : BasicStmt},
+    EvalBasicStmt ρ₁ bs ρ₂ → interpV vs ρ₁ → interpV (E.eval s bs vs) ρ₂
 
 end Spa

lean/Spa/Analysis/Forward/Lattices.lean

@@ -5,12 +5,13 @@ The Agda module instantiates `Lattice.FiniteMap` twice (variables ↦ abstract
 values, states ↦ variable maps) and re-exports everything with ᵛ/ᵐ suffixes.
 In Lean the two instantiations are `abbrev`s and the FiniteMap API is used
 directly; the module parameters (the finite-height lattice `L`, the program)
-become section variables.
+become section variables, with the finite-height structure and the lattice
+interpretation arriving by instance resolution as in Agda.
 
 Correspondence:
   VariableValues, StateVariables  ↦ VariableValues, StateVariables
   isLatticeᵛ/isLatticeᵐ, ⊔ᵛ, ≼ᵛ … ↦ (the FiniteMap Lattice instances)
-  fixedHeightᵛ                    ↦ varsFixedHeight
+  fixedHeightᵛ, fixedHeightᵐ      ↦ (the FiniteMap FiniteHeightLattice instance)
   ⊥ᵛ, ⊥ᵛ-contains-bottoms         ↦ botV, FiniteMap.bot_contains_bots
   states-in-Map                   ↦ states_memKey
   variablesAt                     ↦ variablesAt
@@ -39,22 +40,9 @@ abbrev VariableValues : Type := FiniteMap String L prog.vars
 /-- Agda: `StateVariables`. -/
 abbrev StateVariables : Type := FiniteMap prog.State (VariableValues L prog) prog.states
 
-variable {h : ℕ}
-
-/-- Agda: `fixedHeightᵛ`. -/
-def varsFixedHeight (fhL : FixedHeight L h) :
-    FixedHeight (VariableValues L prog) (prog.vars.length * h) :=
-  FiniteMap.fixedHeight fhL prog.vars
-
-/-- Agda: `⊥ᵛ`. -/
-def botV (fhL : FixedHeight L h) : VariableValues L prog :=
-  (varsFixedHeight L prog fhL).bot
-
-/-- Agda: `fixedHeight` on `StateVariables` (assembled in `Forward.agda`'s
-fixpoint call; named here for reuse). -/
-def statesFixedHeight (fhL : FixedHeight L h) :
-    FixedHeight (StateVariables L prog) (prog.states.length * (prog.vars.length * h)) :=
-  FiniteMap.fixedHeight (varsFixedHeight L prog fhL) prog.states
+/-- Agda: `⊥ᵛ` (the bottom of `fixedHeightᵛ`, now found by instance search). -/
+def botV [FiniteHeightLattice L] : VariableValues L prog :=
+  FiniteHeightLattice.bot (VariableValues L prog)
 
 variable {L prog}
 
@@ -81,16 +69,16 @@ theorem variablesAt_le {sv₁ sv₂ : StateVariables L prog} (hle : sv₁ ≤ sv
   FiniteMap.le_of_mem_mem prog.states_nodup hle
     (variablesAt_mem s sv₁) (variablesAt_mem s sv₂)
 
-variable (fhL : FixedHeight L h)
+variable [FiniteHeightLattice L]
 
 /-- Agda: `joinForKey`. -/
 def joinForKey (k : prog.State) (sv : StateVariables L prog) :
     VariableValues L prog :=
-  (sv.valuesAt (prog.incoming k)).foldr (· ⊔ ·) (botV L prog fhL)
+  (sv.valuesAt (prog.incoming k)).foldr (· ⊔ ·) (botV L prog)
 
 /-- Agda: `joinForKey-Mono`. -/
 theorem joinForKey_mono (k : prog.State) :
-    Monotone (joinForKey fhL k) := by
+    Monotone (joinForKey (L := L) k) := by
   intro sv₁ sv₂ hle
   exact foldr_mono _ (FiniteMap.valuesAt_le hle (prog.incoming k)) (le_refl _)
     (fun b _ _ hab => sup_le_sup_right hab b)
@@ -98,40 +86,42 @@ theorem joinForKey_mono (k : prog.State) :
 
 /-- Agda: `joinAll` (the "Exercise 4.26" generalized update with `f = id`). -/
 def joinAll (sv : StateVariables L prog) : StateVariables L prog :=
-  FiniteMap.generalizedUpdate id (joinForKey fhL) prog.states sv
+  FiniteMap.generalizedUpdate id joinForKey prog.states sv
 
 /-- Agda: `joinAll-Mono`. -/
-theorem joinAll_mono : Monotone (joinAll (prog := prog) fhL) :=
-  FiniteMap.generalizedUpdate_monotone monotone_id (joinForKey_mono fhL)
+theorem joinAll_mono : Monotone (joinAll (L := L) (prog := prog)) :=
+  FiniteMap.generalizedUpdate_monotone monotone_id joinForKey_mono
 
 /-- Agda: `joinAll-k∈ks-≡`. -/
 theorem joinAll_mem_eq {s : prog.State} {vs : VariableValues L prog}
-    {sv : StateVariables L prog} (h : (s, vs) ∈ joinAll fhL sv) :
-    vs = joinForKey fhL s sv :=
+    {sv : StateVariables L prog} (h : (s, vs) ∈ joinAll sv) :
+    vs = joinForKey s sv :=
   FiniteMap.generalizedUpdate_mem_eq (prog.states_complete s) h
 
 /-- Agda: `variablesAt-joinAll`. -/
 theorem variablesAt_joinAll (s : prog.State) (sv : StateVariables L prog) :
-    variablesAt s (joinAll fhL sv) = joinForKey fhL s sv :=
-  joinAll_mem_eq fhL (variablesAt_mem s (joinAll fhL sv))
+    variablesAt s (joinAll sv) = joinForKey s sv :=
+  joinAll_mem_eq (variablesAt_mem s (joinAll sv))
 
 /-! ### Lifting an interpretation to variable maps -/
 
-variable (I : LatticeInterpretation L)
+variable [I : LatticeInterpretation L]
 
+omit [FiniteHeightLattice L] in
 /-- Agda: `⟦_⟧ᵛ`. -/
 def interpV (vs : VariableValues L prog) (ρ : Env) : Prop :=
   ∀ (k : String) (l : L), (k, l) ∈ vs →
     ∀ (v : Value), Env.Mem (k, v) ρ → I.interp l v
 
 /-- Agda: `⟦⊥ᵛ⟧ᵛ∅`. -/
-theorem interpV_botV_nil : interpV I (botV L prog fhL) [] := by
+theorem interpV_botV_nil : interpV (botV L prog) [] := by
   intro k l _ v hmem
   cases hmem
 
+omit [FiniteHeightLattice L] in
 /-- Agda: `⟦⟧ᵛ-⊔ᵛ-∨`. -/
 theorem interpV_sup {vs₁ vs₂ : VariableValues L prog} {ρ : Env}
-    (h : interpV I vs₁ ρ ∨ interpV I vs₂ ρ) : interpV I (vs₁ ⊔ vs₂) ρ := by
+    (h : interpV vs₁ ρ ∨ interpV vs₂ ρ) : interpV (vs₁ ⊔ vs₂) ρ := by
   intro k l hmem v hv
   obtain ⟨l₁, l₂, rfl, h₁, h₂⟩ := FiniteMap.mem_sup hmem
   rcases h with h | h
@@ -141,13 +131,13 @@ theorem interpV_sup {vs₁ vs₂ : VariableValues L prog} {ρ : Env}
 /-- Agda: `⟦⟧ᵛ-foldr`. -/
 theorem interpV_foldr {vs : VariableValues L prog}
     {vss : List (VariableValues L prog)} {ρ : Env}
-    (hvs : interpV I vs ρ) (hmem : vs ∈ vss) :
-    interpV I (vss.foldr (· ⊔ ·) (botV L prog fhL)) ρ := by
+    (hvs : interpV vs ρ) (hmem : vs ∈ vss) :
+    interpV (vss.foldr (· ⊔ ·) (botV L prog)) ρ := by
   induction vss with
   | nil => cases hmem
   | cons vs' vss' ih =>
     rcases List.mem_cons.mp hmem with rfl | hmem'
-    · exact interpV_sup I (Or.inl hvs)
-    · exact interpV_sup I (Or.inr (ih hmem'))
+    · exact interpV_sup (Or.inl hvs)
+    · exact interpV_sup (Or.inr (ih hmem'))
 
 end Spa