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>
92 lines
3.8 KiB
Lean4
92 lines
3.8 KiB
Lean4
/-
|
||
Port of `Language/Semantics.agda`.
|
||
|
||
Correspondence:
|
||
Value (↑ᶻ) ↦ Value.int
|
||
Env ↦ Env (= List (String × Value))
|
||
_∈_ (env lookup) ↦ Env.Mem
|
||
_,_⇒ᵉ_ ↦ EvalExpr
|
||
_,_⇒ᵇ_ ↦ EvalBasicStmt
|
||
_,_⇒ᵇˢ_ ↦ EvalBasicStmts
|
||
_,_⇒ˢ_ ↦ EvalStmt
|
||
LatticeInterpretation:
|
||
⟦_⟧ ↦ interp
|
||
⟦⟧-respects-≈ ↦ (trivial with `=`; field dropped)
|
||
⟦⟧-⊔-∨ ↦ interp_sup
|
||
⟦⟧-⊓-∧ ↦ interp_inf
|
||
(the `Utils` combinators `_⇒_`, `_∨_`, `_∧_` are inlined as plain logic)
|
||
-/
|
||
import Spa.Language.Base
|
||
import Spa.Lattice
|
||
|
||
namespace Spa
|
||
|
||
inductive Value where
|
||
| int (z : ℤ)
|
||
deriving DecidableEq
|
||
|
||
def Env : Type := List (String × Value)
|
||
|
||
/-- Agda: `_∈_` on environments — lookup respecting shadowing. -/
|
||
inductive Env.Mem : String × Value → Env → Prop
|
||
| here (s : String) (v : Value) (ρ : Env) : Env.Mem (s, v) ((s, v) :: ρ)
|
||
| there (s s' : String) (v v' : Value) (ρ : Env) :
|
||
¬(s = s') → Env.Mem (s, v) ρ → Env.Mem (s, v) ((s', v') :: ρ)
|
||
|
||
/-- Agda: `_,_⇒ᵉ_`. -/
|
||
inductive EvalExpr : Env → Expr → Value → Prop
|
||
| num (ρ : Env) (n : ℕ) : EvalExpr ρ (.num n) (.int n)
|
||
| var (ρ : Env) (x : String) (v : Value) :
|
||
Env.Mem (x, v) ρ → EvalExpr ρ (.var x) v
|
||
| add (ρ : Env) (e₁ e₂ : Expr) (z₁ z₂ : ℤ) :
|
||
EvalExpr ρ e₁ (.int z₁) → EvalExpr ρ e₂ (.int z₂) →
|
||
EvalExpr ρ (.add e₁ e₂) (.int (z₁ + z₂))
|
||
| sub (ρ : Env) (e₁ e₂ : Expr) (z₁ z₂ : ℤ) :
|
||
EvalExpr ρ e₁ (.int z₁) → EvalExpr ρ e₂ (.int z₂) →
|
||
EvalExpr ρ (.sub e₁ e₂) (.int (z₁ - z₂))
|
||
|
||
/-- Agda: `_,_⇒ᵇ_`. -/
|
||
inductive EvalBasicStmt : Env → BasicStmt → Env → Prop
|
||
| noop (ρ : Env) : EvalBasicStmt ρ .noop ρ
|
||
| assign (ρ : Env) (x : String) (e : Expr) (v : Value) :
|
||
EvalExpr ρ e v → EvalBasicStmt ρ (.assign x e) ((x, v) :: ρ)
|
||
|
||
/-- Agda: `_,_⇒ᵇˢ_`. -/
|
||
inductive EvalBasicStmts : Env → List BasicStmt → Env → Prop
|
||
| nil {ρ : Env} : EvalBasicStmts ρ [] ρ
|
||
| cons {ρ₁ ρ₂ ρ₃ : Env} {bs : BasicStmt} {bss : List BasicStmt} :
|
||
EvalBasicStmt ρ₁ bs ρ₂ → EvalBasicStmts ρ₂ bss ρ₃ →
|
||
EvalBasicStmts ρ₁ (bs :: bss) ρ₃
|
||
|
||
/-- Agda: `_,_⇒ˢ_`. -/
|
||
inductive EvalStmt : Env → Stmt → Env → Prop
|
||
| basic (ρ₁ ρ₂ : Env) (bs : BasicStmt) :
|
||
EvalBasicStmt ρ₁ bs ρ₂ → EvalStmt ρ₁ (.basic bs) ρ₂
|
||
| andThen (ρ₁ ρ₂ ρ₃ : Env) (s₁ s₂ : Stmt) :
|
||
EvalStmt ρ₁ s₁ ρ₂ → EvalStmt ρ₂ s₂ ρ₃ →
|
||
EvalStmt ρ₁ (.andThen s₁ s₂) ρ₃
|
||
| ifTrue (ρ₁ ρ₂ : Env) (e : Expr) (z : ℤ) (s₁ s₂ : Stmt) :
|
||
EvalExpr ρ₁ e (.int z) → ¬(z = 0) → EvalStmt ρ₁ s₁ ρ₂ →
|
||
EvalStmt ρ₁ (.ifElse e s₁ s₂) ρ₂
|
||
| ifFalse (ρ₁ ρ₂ : Env) (e : Expr) (s₁ s₂ : Stmt) :
|
||
EvalExpr ρ₁ e (.int 0) → EvalStmt ρ₁ s₂ ρ₂ →
|
||
EvalStmt ρ₁ (.ifElse e s₁ s₂) ρ₂
|
||
| whileTrue (ρ₁ ρ₂ ρ₃ : Env) (e : Expr) (z : ℤ) (s : Stmt) :
|
||
EvalExpr ρ₁ e (.int z) → ¬(z = 0) → EvalStmt ρ₁ s ρ₂ →
|
||
EvalStmt ρ₂ (.whileLoop e s) ρ₃ →
|
||
EvalStmt ρ₁ (.whileLoop e s) ρ₃
|
||
| whileFalse (ρ : Env) (e : Expr) (s : Stmt) :
|
||
EvalExpr ρ e (.int 0) →
|
||
EvalStmt ρ (.whileLoop e s) ρ
|
||
|
||
/-- Agda: `LatticeInterpretation` (used there as an instance argument `⦃·⦄`,
|
||
hence a typeclass here). -/
|
||
class LatticeInterpretation (L : Type*) [Lattice L] where
|
||
interp : L → Value → Prop
|
||
interp_sup : ∀ {l₁ l₂ : L} (v : Value),
|
||
interp l₁ v ∨ interp l₂ v → interp (l₁ ⊔ l₂) v
|
||
interp_inf : ∀ {l₁ l₂ : L} (v : Value),
|
||
interp l₁ v ∧ interp l₂ v → interp (l₁ ⊓ l₂) v
|
||
|
||
end Spa
|