122 lines
4.4 KiB
Lean4
122 lines
4.4 KiB
Lean4
import Spa.Language
|
||
import Spa.Lattice.FiniteMap
|
||
import Spa.Interp
|
||
|
||
namespace Spa
|
||
|
||
namespace Forward
|
||
|
||
variable (L : Type) [Lattice L] (prog : Program)
|
||
|
||
abbrev VariableValues : Type := FiniteMap String L prog.vars
|
||
|
||
abbrev StateVariables : Type := FiniteMap prog.State (VariableValues L prog) prog.states
|
||
|
||
def botV [FiniteHeightLattice L] : VariableValues L prog :=
|
||
(⊥ : VariableValues L prog)
|
||
|
||
variable {L prog}
|
||
|
||
omit [Lattice L] in
|
||
lemma states_memKey (s : prog.State) (sv : StateVariables L prog) :
|
||
FiniteMap.MemKey s sv :=
|
||
FiniteMap.MemKey_iff.mpr (prog.states_complete s)
|
||
|
||
def variablesAt (s : prog.State) (sv : StateVariables L prog) :
|
||
VariableValues L prog :=
|
||
(FiniteMap.locate (states_memKey s sv)).1
|
||
|
||
omit [Lattice L] in
|
||
lemma variablesAt_mem (s : prog.State) (sv : StateVariables L prog) :
|
||
(s, variablesAt s sv) ∈ sv :=
|
||
(FiniteMap.locate (states_memKey s sv)).2
|
||
|
||
lemma variablesAt_le {sv₁ sv₂ : StateVariables L prog} (hle : sv₁ ≤ sv₂)
|
||
(s : prog.State) : variablesAt s sv₁ ≤ variablesAt s sv₂ :=
|
||
FiniteMap.le_of_mem_mem prog.states_nodup hle
|
||
(variablesAt_mem s sv₁) (variablesAt_mem s sv₂)
|
||
|
||
variable [FiniteHeightLattice L]
|
||
|
||
def joinForKey (k : prog.State) (sv : StateVariables L prog) :
|
||
VariableValues L prog :=
|
||
(sv.valuesAt (prog.incoming k)).foldr (· ⊔ ·) (botV L prog)
|
||
|
||
lemma joinForKey_mono (k : prog.State) :
|
||
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)
|
||
(fun a _ _ hab => sup_le_sup_left hab a)
|
||
|
||
def joinAll (sv : StateVariables L prog) : StateVariables L prog :=
|
||
FiniteMap.generalizedUpdate id joinForKey prog.states sv
|
||
|
||
lemma joinAll_mono : Monotone (joinAll (L := L) (prog := prog)) :=
|
||
FiniteMap.generalizedUpdate_monotone monotone_id joinForKey_mono
|
||
|
||
lemma joinAll_mem_eq {s : prog.State} {vs : VariableValues L prog}
|
||
{sv : StateVariables L prog} (h : (s, vs) ∈ joinAll sv) :
|
||
vs = joinForKey s sv :=
|
||
FiniteMap.generalizedUpdate_mem_eq (prog.states_complete s) h
|
||
|
||
lemma variablesAt_joinAll (s : prog.State) (sv : StateVariables L prog) :
|
||
variablesAt s (joinAll sv) = joinForKey s sv :=
|
||
joinAll_mem_eq (variablesAt_mem s (joinAll sv))
|
||
|
||
class StateInterpretation (L : Type) [Lattice L] (prog : Program) where
|
||
Proj : Type
|
||
Pre : ∀ {s₁ s₂ : prog.State} {ρ₁ ρ₂ : Env}, Traceₗ prog.cfg s₁ s₂ ρ₁ ρ₂ → Proj
|
||
Post : ∀ {s₁ s₂ : prog.State} {ρ₁ ρ₂ : Env}, Trace prog.cfg s₁ s₂ ρ₁ ρ₂ → Proj
|
||
|
||
interp : VariableValues L prog → (p : Proj) → Prop
|
||
interp_sup : ∀ {vs₁ vs₂ : VariableValues L prog} {p : Proj},
|
||
interp vs₁ p ∨ interp vs₂ p → interp (vs₁ ⊔ vs₂) p
|
||
interp_inf : ∀ {vs₁ vs₂ : VariableValues L prog} {p : Proj},
|
||
interp vs₁ p ∧ interp vs₂ p → interp (vs₁ ⊓ vs₂) p
|
||
|
||
post_pre : ∀ {vs} {s₁ s₂ s₃: prog.State} {ρ₁ ρ₂ : Env}
|
||
(tr : Trace prog.cfg s₁ s₂ ρ₁ ρ₂) (hedge : (s₂, s₃) ∈ prog.cfg.edges),
|
||
interp vs (Post tr) → interp vs (Pre (tr.addEdge hedge))
|
||
|
||
instance [S : StateInterpretation L prog] :
|
||
Interp (VariableValues L prog) (S.Proj → Prop) :=
|
||
⟨S.interp⟩
|
||
|
||
lemma interp_foldr [S : StateInterpretation L prog]
|
||
{vs : VariableValues L prog} {vss : List (VariableValues L prog)}
|
||
{p : S.Proj} (hvs : ⟦ vs ⟧ p) (hmem : vs ∈ vss) :
|
||
⟦ vss.foldr (· ⊔ ·) (botV L prog) ⟧ p := by
|
||
induction vss with
|
||
| nil => cases hmem
|
||
| cons vs' vss' ih =>
|
||
rcases List.mem_cons.mp hmem with rfl | hmem'
|
||
· exact S.interp_sup (Or.inl hvs)
|
||
· exact S.interp_sup (Or.inr (ih hmem'))
|
||
|
||
variable [I : LatticeInterpretation L]
|
||
|
||
instance : StateInterpretation L prog where
|
||
Proj := Env
|
||
Pre := fun {_ _ _ ρ₂} _ => ρ₂
|
||
Post := fun {_ _ _ ρ₂} _ => ρ₂
|
||
|
||
interp vs ρ := ∀ (k : String) (l : L), (k, l) ∈ vs →
|
||
∀ (v : Value), Env.Mem (k, v) ρ → I.interp l v
|
||
interp_sup := by
|
||
intro vs₁ vs₂ ρ h k l hmem v hv
|
||
obtain ⟨l₁, l₂, rfl, h₁, h₂⟩ := FiniteMap.mem_sup hmem
|
||
rcases h with h | h
|
||
· exact I.interp_sup v (Or.inl (h _ _ h₁ _ hv))
|
||
· exact I.interp_sup v (Or.inr (h _ _ h₂ _ hv))
|
||
interp_inf := by
|
||
intro vs₁ vs₂ ρ h k l hmem v hv
|
||
obtain ⟨l₁, l₂, rfl, h₁, h₂⟩ := FiniteMap.mem_inf hmem
|
||
exact I.interp_inf v ⟨h.1 _ _ h₁ _ hv, h.2 _ _ h₂ _ hv⟩
|
||
post_pre := by simp
|
||
|
||
|
||
end Forward
|
||
|
||
end Spa
|