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>
2026-06-09 23:32:38 -07:00
parent b26d6b5acd
commit b16f14fdfd
12 changed files with 338 additions and 407 deletions
--- a/lean/Spa/Analysis/Forward.lean
+++ b/lean/Spa/Analysis/Forward.lean
@@ -2,6 +2,12 @@
 Port of `Analysis/Forward.agda` (`WithProg`, `WithStmtEvaluator`,
 `WithValidInterpretation`).

+As in Agda, the statement evaluator, the lattice interpretation and the
+evaluator's validity proof are instance arguments (`{{evaluator}}`,
+`{{latticeInterpretationˡ}}`, `{{validEvaluator}}`); `result` and
+`analyze_correct` take `L` and `prog` explicitly, mirroring the Agda call
+shape `WithProg.result L prog`.
+
 Correspondence:
  updateVariablesForState, -Monoʳ   ↦ updateVariablesForState, _mono
  updateAll, updateAll-Mono,
@@ -26,139 +32,136 @@ import Spa.Fixedpoint

 namespace Spa

-variable {L : Type} [Lattice L] [DecidableEq L] {prog : Program} {h : ℕ}
-  (fhL : FixedHeight L h) (E : StmtEvaluator L prog)
+variable {L : Type} [Lattice L] {prog : Program} [E : StmtEvaluator L prog]

 /-- Agda: `updateVariablesForState`. -/
 def updateVariablesForState (s : prog.State) (sv : StateVariables L prog) :
    VariableValues L prog :=
  (prog.code s).foldl (fun vs bs => E.eval s bs vs) (variablesAt s sv)

-omit [DecidableEq L] in
 /-- Agda: `updateVariablesForState-Monoʳ`. -/
 theorem updateVariablesForState_mono (s : prog.State) :
-    Monotone (updateVariablesForState E s) := fun _ _ hle =>
+    Monotone (updateVariablesForState (L := L) s) := fun _ _ hle =>
  foldl_mono' (prog.code s) _ (fun bs => E.eval_mono s bs) (variablesAt_le hle s)

 /-- Agda: `updateAll`. -/
 def updateAll (sv : StateVariables L prog) : StateVariables L prog :=
-  FiniteMap.generalizedUpdate id (fun s sv => updateVariablesForState E s sv)
+  FiniteMap.generalizedUpdate id (fun s sv => updateVariablesForState s sv)
    prog.states sv

-omit [DecidableEq L] in
 /-- Agda: `updateAll-Mono`. -/
-theorem updateAll_mono : Monotone (updateAll E) :=
-  FiniteMap.generalizedUpdate_monotone monotone_id (updateVariablesForState_mono E)
+theorem updateAll_mono : Monotone (updateAll (L := L) (prog := prog)) :=
+  FiniteMap.generalizedUpdate_monotone monotone_id updateVariablesForState_mono

-omit [DecidableEq L] in
 /-- Agda: `updateAll-k∈ks-≡`. -/
 theorem updateAll_mem_eq {s : prog.State} {vs : VariableValues L prog}
-    {sv : StateVariables L prog} (hmem : (s, vs) ∈ updateAll E sv) :
-    vs = updateVariablesForState E s sv :=
+    {sv : StateVariables L prog} (hmem : (s, vs) ∈ updateAll sv) :
+    vs = updateVariablesForState s sv :=
  FiniteMap.generalizedUpdate_mem_eq (prog.states_complete s) hmem

-omit [DecidableEq L] in
 /-- Agda: `variablesAt-updateAll`. -/
 theorem variablesAt_updateAll (s : prog.State) (sv : StateVariables L prog) :
-    variablesAt s (updateAll E sv) = updateVariablesForState E s sv :=
-  updateAll_mem_eq E (variablesAt_mem s (updateAll E sv))
+    variablesAt s (updateAll sv) = updateVariablesForState s sv :=
+  updateAll_mem_eq (variablesAt_mem s (updateAll sv))
+
+variable [FiniteHeightLattice L]

 /-- Agda: `analyze`. -/
 def analyze (sv : StateVariables L prog) : StateVariables L prog :=
-  updateAll E (joinAll fhL sv)
+  updateAll (joinAll sv)

-omit [DecidableEq L] in
 /-- Agda: `analyze-Mono`. -/
-theorem analyze_mono : Monotone (analyze fhL E) := fun _ _ hle =>
-  updateAll_mono E (joinAll_mono fhL hle)
+theorem analyze_mono : Monotone (analyze (L := L) (prog := prog)) := fun _ _ hle =>
+  updateAll_mono (joinAll_mono hle)

+variable [DecidableEq L]
+
+variable (L prog) in
 /-- Agda: `result` (the least fixpoint of `analyze`). -/
 def result : StateVariables L prog :=
-  Fixedpoint.aFix (statesFixedHeight L prog fhL) (analyze fhL E) (analyze_mono fhL E)
+  Fixedpoint.aFix analyze analyze_mono

+variable (L prog) in
 /-- Agda: `result≈analyze-result`. -/
-theorem result_eq : result fhL E = analyze fhL E (result fhL E) :=
-  Fixedpoint.aFix_eq (statesFixedHeight L prog fhL) (analyze fhL E) (analyze_mono fhL E)
+theorem result_eq : result L prog = analyze (result L prog) :=
+  Fixedpoint.aFix_eq analyze analyze_mono
+
+/-- Agda: `joinForKey-initialState-⊥ᵛ`. -/
+theorem joinForKey_initialState :
+    joinForKey prog.initialState (result L prog) = botV L prog := by
+  rw [joinForKey, prog.incoming_initialState_eq_nil]
+  rfl

 /-! ### Semantic correctness (Agda: `WithValidInterpretation`) -/

-variable {I : LatticeInterpretation L} {E}
-variable (hE : IsValidStmtEvaluator E I)
-include hE
+variable [I : LatticeInterpretation L] [V : ValidStmtEvaluator L prog]

-omit [DecidableEq L] in
+omit [FiniteHeightLattice L] [DecidableEq L] in
 /-- Agda: `eval-fold-valid`. -/
 theorem eval_fold_valid {s : prog.State} {bss : List BasicStmt}
    {vs : VariableValues L prog} {ρ₁ ρ₂ : Env}
-    (hbss : EvalBasicStmts ρ₁ bss ρ₂) (hvs : interpV I vs ρ₁) :
-    interpV I (bss.foldl (fun vs bs => E.eval s bs vs) vs) ρ₂ := by
+    (hbss : EvalBasicStmts ρ₁ bss ρ₂) (hvs : interpV vs ρ₁) :
+    interpV (bss.foldl (fun vs bs => E.eval s bs vs) vs) ρ₂ := by
  induction hbss generalizing vs with
  | nil => exact hvs
-  | cons hbs _ ih => exact ih (hE hbs hvs)
+  | cons hbs _ ih => exact ih (ValidStmtEvaluator.valid hbs hvs)

-omit [DecidableEq L] in
+omit [FiniteHeightLattice L] [DecidableEq L] in
 /-- Agda: `updateVariablesForState-matches`. -/
 theorem updateVariablesForState_matches {s : prog.State}
    {sv : StateVariables L prog} {ρ₁ ρ₂ : Env}
    (hbss : EvalBasicStmts ρ₁ (prog.code s) ρ₂)
-    (hvs : interpV I (variablesAt s sv) ρ₁) :
-    interpV I (updateVariablesForState E s sv) ρ₂ :=
-  eval_fold_valid hE hbss hvs
+    (hvs : interpV (variablesAt s sv) ρ₁) :
+    interpV (updateVariablesForState s sv) ρ₂ :=
+  eval_fold_valid hbss hvs

-omit [DecidableEq L] in
+omit [FiniteHeightLattice L] [DecidableEq L] in
 /-- Agda: `updateAll-matches`. -/
 theorem updateAll_matches {s : prog.State} {sv : StateVariables L prog}
    {ρ₁ ρ₂ : Env} (hbss : EvalBasicStmts ρ₁ (prog.code s) ρ₂)
-    (hvs : interpV I (variablesAt s sv) ρ₁) :
-    interpV I (variablesAt s (updateAll E sv)) ρ₂ := by
+    (hvs : interpV (variablesAt s sv) ρ₁) :
+    interpV (variablesAt s (updateAll sv)) ρ₂ := by
  rw [variablesAt_updateAll]
-  exact updateVariablesForState_matches hE hbss hvs
+  exact updateVariablesForState_matches hbss hvs

 /-- Agda: `stepTrace`. -/
 theorem stepTrace {s₁ : prog.State} {ρ₁ ρ₂ : Env}
-    (hjoin : interpV I (joinForKey fhL s₁ (result fhL E)) ρ₁)
+    (hjoin : interpV (joinForKey s₁ (result L prog)) ρ₁)
    (hbss : EvalBasicStmts ρ₁ (prog.code s₁) ρ₂) :
-    interpV I (variablesAt s₁ (result fhL E)) ρ₂ := by
-  rw [result_eq fhL E]
-  refine updateAll_matches hE hbss ?_
+    interpV (variablesAt s₁ (result L prog)) ρ₂ := by
+  rw [result_eq L prog]
+  refine updateAll_matches hbss ?_
  rw [variablesAt_joinAll]
  exact hjoin

 /-- Agda: `walkTrace`. -/
 theorem walkTrace {s₁ s₂ : prog.State} {ρ₁ ρ₂ : Env}
-    (hjoin : interpV I (joinForKey fhL s₁ (result fhL E)) ρ₁)
+    (hjoin : interpV (joinForKey s₁ (result L prog)) ρ₁)
    (tr : Trace prog.graph s₁ s₂ ρ₁ ρ₂) :
-    interpV I (variablesAt s₂ (result fhL E)) ρ₂ := by
+    interpV (variablesAt s₂ (result L prog)) ρ₂ := by
  induction tr with
-  | single hbss => exact stepTrace fhL hE hjoin hbss
+  | single hbss => exact stepTrace hjoin hbss
  | @edge _ ρ' _ i₁ i₂ _ hbss hedge _ ih =>
-    have hstep : interpV I (variablesAt i₁ (result fhL E)) ρ' :=
-      stepTrace fhL hE hjoin hbss
-    have hmem : variablesAt i₁ (result fhL E)
-        ∈ (result fhL E).valuesAt (prog.incoming i₂) :=
+    have hstep : interpV (variablesAt i₁ (result L prog)) ρ' :=
+      stepTrace hjoin hbss
+    have hmem : variablesAt i₁ (result L prog)
+        ∈ (result L prog).valuesAt (prog.incoming i₂) :=
      FiniteMap.mem_valuesAt prog.states_nodup
-        (prog.mem_incoming_of_edge hedge) (variablesAt_mem i₁ (result fhL E))
-    exact ih (interpV_foldr fhL I hstep hmem)
+        (prog.mem_incoming_of_edge hedge) (variablesAt_mem i₁ (result L prog))
+    exact ih (interpV_foldr hstep hmem)

-omit hE in
-/-- Agda: `joinForKey-initialState-⊥ᵛ`. -/
-theorem joinForKey_initialState :
-    joinForKey fhL prog.initialState (result fhL E) = botV L prog fhL := by
-  rw [joinForKey, prog.incoming_initialState_eq_nil]
-  rfl
-
-omit hE in
+omit V in
 /-- Agda: `⟦joinAll-initialState⟧ᵛ∅`. -/
 theorem interpV_joinForKey_initialState :
-    interpV I (joinForKey fhL prog.initialState (result fhL E)) [] := by
+    interpV (joinForKey prog.initialState (result L prog)) [] := by
  rw [joinForKey_initialState]
-  exact interpV_botV_nil fhL I
+  exact interpV_botV_nil

+variable (L prog) in
 /-- Agda: `analyze-correct` — the analysis result at the final state soundly
 describes every terminating execution of the program. -/
 theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
-    interpV I (variablesAt prog.finalState (result fhL E)) ρ :=
-  walkTrace fhL hE (interpV_joinForKey_initialState fhL (E := E) (I := I))
-    (prog.trace hrun)
+    interpV (variablesAt prog.finalState (result L prog)) ρ :=
+  walkTrace interpV_joinForKey_initialState (prog.trace hrun)

 end Spa