Danila Fedorin
b16f14fdfd
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>
76 lines
3.2 KiB
Lean4
76 lines
3.2 KiB
Lean4
/-
|
|
Port of `Analysis/Forward/Adapters.agda` (`ExprToStmtAdapter`).
|
|
|
|
Correspondence:
|
|
updateVariablesFromExpression ↦ updateVariablesFromExpression
|
|
updateVariablesFromExpression-Mono ↦ updateVariablesFromExpression_mono
|
|
(the -k∈ks-≡ / -k∉ks-backward renames ↦ used directly from FiniteMap)
|
|
evalᵇ, evalᵇ-Monoʳ ↦ evalB, evalB_mono
|
|
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`)
|
|
-/
|
|
import Spa.Analysis.Forward.Evaluation
|
|
|
|
namespace Spa
|
|
|
|
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 (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 (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 (_ : prog.State) (bs : BasicStmt)
|
|
(vs : VariableValues L prog) : VariableValues L prog :=
|
|
match bs with
|
|
| .assign k e => updateVariablesFromExpression k e vs
|
|
| .noop => vs
|
|
|
|
/-- Agda: `evalᵇ-Monoʳ`. -/
|
|
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 k e
|
|
| noop => exact monotone_id
|
|
|
|
/-- Agda: the `stmtEvaluator` instance of `ExprToStmtAdapter`. -/
|
|
instance ExprEvaluator.toStmtEvaluator : StmtEvaluator L prog :=
|
|
⟨evalB, evalB_mono⟩
|
|
|
|
/-- Agda: `evalᵇ-valid` / the `validStmtEvaluator` instance. -/
|
|
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
|
|
| assign k e v hev =>
|
|
intro k' l hk'l v' hv'
|
|
cases hv' with
|
|
| here =>
|
|
have hk'l₀ : (k, l) ∈ FiniteMap.generalizedUpdate (ks := prog.vars) id
|
|
(fun _ vs => E.eval e vs) [k] vs := hk'l
|
|
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 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
|
|
have hk'l' : (k', l) ∈ (id vs : VariableValues L prog) :=
|
|
FiniteMap.generalizedUpdate_not_mem_backward
|
|
(fun hmem => hne (List.mem_singleton.mp hmem)) hk'l₀
|
|
exact hvs _ _ hk'l' _ hmem'
|
|
|
|
end Spa
|