Start working on notation for formalization

Per convention, create a new instance for 'interpretable' thing,
with an fundep'ed semantic domain. I feel at peace with this notation
even though it conflicts with Mathlib's quotients.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-06-23 10:23:44 -05:00
parent 8c37a4c049
commit 2044d4b2b6
3 changed files with 51 additions and 33 deletions

View File

@@ -26,6 +26,7 @@ Correspondence:
-/
import Spa.Analysis.Forward
import Spa.Analysis.Utils
import Spa.Interp
import Spa.Showable
namespace Spa
@@ -86,9 +87,12 @@ def interpConst : ConstLattice → Value → Prop
| .top, _ => True
| .mk z, v => v = .int z
/-- Agda: `⟦_⟧ᶜ` is registered for the `⟦_⟧` interpretation notation. -/
instance : Interp ConstLattice (Value Prop) := interpConst
/-- Agda: `s₁≢s₂⇒¬s₁∧s₂`. -/
theorem interpConst_mk_disjoint {z₁ z₂ : } (hne : z₁ z₂) {v : Value} :
¬(interpConst (.mk z₁) v interpConst (.mk z₂) v) := by
¬((.mk z₁ : ConstLattice) v (.mk z₂ : ConstLattice) v) := by
rintro h₁, h₂
rw [h₁] at h₂
injection h₂ with hz
@@ -96,12 +100,12 @@ theorem interpConst_mk_disjoint {z₁ z₂ : } (hne : z₁ ≠ z₂) {v : Val
/-- Agda: `⟦⟧ᶜ-⊔ᶜ-` (via the factored flat-lattice lemma). -/
theorem interpConst_sup {s₁ s₂ : ConstLattice} (v : Value)
(h : interpConst s₁ v interpConst s₂ v) : interpConst (s₁ s₂) v :=
(h : s₁ v s₂ v) : s₁ s₂ v :=
AboveBelow.interp_sup_of (fun _ h => h) (fun _ => trivial) v h
/-- Agda: `⟦⟧ᶜ-⊓ᶜ-∧` (via the factored flat-lattice lemma). -/
theorem interpConst_inf {s₁ s₂ : ConstLattice} (v : Value)
(h : interpConst s₁ v interpConst s₂ v) : interpConst (s₁ s₂) v :=
(h : s₁ v s₂ v) : s₁ s₂ v :=
AboveBelow.interp_inf_of (fun hne _ => interpConst_mk_disjoint hne) v h
/-- Agda: `latticeInterpretationᶜ` (an instance there too). -/
@@ -153,8 +157,8 @@ def output : String :=
/-- Agda: `plus-valid`. -/
theorem plus_valid {g₁ g₂ : ConstLattice} {z₁ z₂ : }
(h₁ : interpConst g₁ (.int z₁)) (h₂ : interpConst g₂ (.int z₂)) :
interpConst (plus g₁ g₂) (.int (z₁ + z₂)) := by
(h₁ : g₁ (.int z₁)) (h₂ : g₂ (.int z₂)) :
plus g₁ g₂ (.int (z₁ + z₂)) := by
rcases g₁ with _ | _ | c₁
· exact h₁.elim
· rcases g₂ with _ | _ | c₂
@@ -171,8 +175,8 @@ theorem plus_valid {g₁ g₂ : ConstLattice} {z₁ z₂ : }
/-- Agda: `minus-valid`. -/
theorem minus_valid {g₁ g₂ : ConstLattice} {z₁ z₂ : }
(h₁ : interpConst g₁ (.int z₁)) (h₂ : interpConst g₂ (.int z₂)) :
interpConst (minus g₁ g₂) (.int (z₁ - z₂)) := by
(h₁ : g₁ (.int z₁)) (h₂ : g₂ (.int z₂)) :
minus g₁ g₂ (.int (z₁ - z₂)) := by
rcases g₁ with _ | _ | c₁
· exact h₁.elim
· rcases g₂ with _ | _ | c₂
@@ -194,11 +198,11 @@ instance eval_valid : ValidExprEvaluator ConstLattice prog := by
induction hev with
| num n =>
intro _
show interpConst (eval prog (.num n) vs) (.int n)
show eval prog (.num n) vs (.int n)
rfl
| var x v hxv =>
intro hvs
show interpConst (eval prog (.var x) vs) v
show eval prog (.var x) vs v
simp only [eval]
by_cases hk : FiniteMap.MemKey x vs
· rw [dif_pos hk]
@@ -207,15 +211,15 @@ instance eval_valid : ValidExprEvaluator ConstLattice prog := by
exact trivial
| add e₁ e₂ z₁ z₂ _ _ ih₁ ih₂ =>
intro hvs
have h₁ : interpConst (eval prog e₁ vs) (.int z₁) := ih₁ hvs
have h₂ : interpConst (eval prog e₂ vs) (.int z₂) := ih₂ hvs
show interpConst (eval prog (.add e₁ e₂) vs) (.int (z₁ + z₂))
have h₁ : eval prog e₁ vs (.int z₁) := ih₁ hvs
have h₂ : eval prog e₂ vs (.int z₂) := ih₂ hvs
show eval prog (.add e₁ e₂) vs (.int (z₁ + z₂))
exact plus_valid h₁ h₂
| sub e₁ e₂ z₁ z₂ _ _ ih₁ ih₂ =>
intro hvs
have h₁ : interpConst (eval prog e₁ vs) (.int z₁) := ih₁ hvs
have h₂ : interpConst (eval prog e₂ vs) (.int z₂) := ih₂ hvs
show interpConst (eval prog (.sub e₁ e₂) vs) (.int (z₁ - z₂))
have h₁ : eval prog e₁ vs (.int z₁) := ih₁ hvs
have h₂ : eval prog e₂ vs (.int z₂) := ih₂ hvs
show eval prog (.sub e₁ e₂) vs (.int (z₁ - z₂))
exact minus_valid h₁ h₂
/-- Agda: `WithProg.analyze-correct`. -/