Danila Fedorin
b6b30958aa
This requires a few pieces: * Make node tags use `Fin n` intead of natural numbers. This makes it possible to build a finite lattice over AST nodes, and also ensure automatic, total indexing from CFG nodes into the AST that created them. For this, use the elaborator to derive the ordering statements etc. where possible. * Adjust the forward framework to enable proofs that don't just state correctness on the environment, but also on an arbitrary additional state accumulated from traversing the trace. * State the reaching definition analysis's correctness in terms of this new framework. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
132 lines
4.9 KiB
Lean4
132 lines
4.9 KiB
Lean4
import Spa.Analysis.Forward
|
||
import Spa.Lattice.Bool
|
||
import Spa.Lattice.Tuple
|
||
import Spa.Language.Tagged.Graphs
|
||
import Spa.Showable
|
||
|
||
namespace Spa
|
||
|
||
open Forward
|
||
|
||
instance : Showable Bool := ⟨fun b => if b then "true" else "false"⟩
|
||
|
||
instance {n : ℕ} {β : Type*} [Showable β] : Showable (Fin n → β) :=
|
||
⟨fun f =>
|
||
"{" ++ (List.finRange n).foldr
|
||
(fun i rest => show' i ++ " ↦ " ++ show' (f i) ++ ", " ++ rest) ""
|
||
++ "}"⟩
|
||
|
||
abbrev DefSet (prog : Program) : Type := prog.NodeId → Bool
|
||
|
||
namespace ReachingAnalysis
|
||
|
||
variable (prog : Program)
|
||
|
||
def genSet (s : prog.State) {bs : BasicStmt} (h : prog.code s = some bs) :
|
||
DefSet prog :=
|
||
Function.update (⊥ : DefSet prog) (prog.nodeIdOfNonempty s h) true
|
||
|
||
def eval (s : prog.State) :
|
||
(bs : BasicStmt) → prog.code s = some bs →
|
||
VariableValues (DefSet prog) prog → VariableValues (DefSet prog) prog
|
||
| .assign k _, h, vs =>
|
||
FiniteMap.generalizedUpdate id (fun _ _ => genSet prog s h) [k] vs
|
||
| .noop, _, vs => vs
|
||
|
||
lemma eval_mono (s : prog.State) (bs : BasicStmt) (h : prog.code s = some bs) :
|
||
Monotone (eval prog s bs h) := by
|
||
cases bs with
|
||
| assign k e =>
|
||
exact FiniteMap.generalizedUpdate_monotone monotone_id (fun _ => monotone_const)
|
||
| noop => exact monotone_id
|
||
|
||
instance stmtEvaluator : StmtEvaluator (DefSet prog) prog :=
|
||
⟨eval prog, eval_mono prog⟩
|
||
|
||
def output : String :=
|
||
show' (result (DefSet prog) prog)
|
||
|
||
inductive Run (prog : Program) where
|
||
| nil : Run prog
|
||
| cons (s : prog.State) (bs : BasicStmt) (hc : prog.code s = some bs)
|
||
(rest : Run prog) : Run prog
|
||
|
||
inductive LastAssign (prog : Program) (x : String) : Run prog → prog.NodeId → Prop
|
||
| here (s : prog.State) (e : Expr) (hc : prog.code s = some (.assign x e))
|
||
(rest : Run prog) :
|
||
LastAssign prog x (Run.cons s (.assign x e) hc rest) (prog.nodeIdOfNonempty s hc)
|
||
| there (s : prog.State) (bs : BasicStmt) (hc : prog.code s = some bs)
|
||
(rest : Run prog) {n : prog.NodeId} :
|
||
(∀ e, bs ≠ .assign x e) → LastAssign prog x rest n →
|
||
LastAssign prog x (Run.cons s bs hc rest) n
|
||
|
||
lemma lastAssign_cons_here {x : String} {s : prog.State} {e : Expr}
|
||
{hc : prog.code s = some (.assign x e)} {rest : Run prog} {n : prog.NodeId}
|
||
(h : LastAssign prog x (Run.cons s (.assign x e) hc rest) n) :
|
||
n = prog.nodeIdOfNonempty s hc := by
|
||
cases h with
|
||
| here _ _ _ _ => rfl
|
||
| there _ _ _ _ hne _ => exact absurd rfl (hne e)
|
||
|
||
lemma lastAssign_cons_of_ne {x : String} {s : prog.State} {bs : BasicStmt}
|
||
{hc : prog.code s = some bs} {rest : Run prog} {n : prog.NodeId}
|
||
(h : LastAssign prog x (Run.cons s bs hc rest) n)
|
||
(hne : ∀ e, bs ≠ .assign x e) : LastAssign prog x rest n := by
|
||
cases h with
|
||
| here _ e' _ _ => exact absurd rfl (hne e')
|
||
| there _ _ _ _ _ hp => exact hp
|
||
|
||
instance stateInterp : StateInterp (DefSet prog) prog where
|
||
St := fun _ => Run prog
|
||
init := Run.nil
|
||
interp vs _ run := ∀ (x : String) (assigners : DefSet prog), (x, assigners) ∈ vs →
|
||
∀ (n : prog.NodeId), LastAssign prog x run n → assigners n = true
|
||
interp_sup := by
|
||
intro vs₁ vs₂ ρ run h x assigners hmem n hla
|
||
obtain ⟨a₁, a₂, rfl, h₁, h₂⟩ := FiniteMap.mem_sup hmem
|
||
rw [Pi.sup_apply]
|
||
rcases h with h | h
|
||
· aesop
|
||
· aesop
|
||
interp_inf := by
|
||
intro vs₁ vs₂ ρ run h x assigners hmem n hla
|
||
obtain ⟨a₁, a₂, rfl, h₁, h₂⟩ := FiniteMap.mem_inf hmem
|
||
rw [Pi.inf_apply]
|
||
aesop
|
||
|
||
instance validStateEvaluator : ValidStateEvaluator (DefSet prog) prog where
|
||
step := by intro s _ _ bs hcode _ rest; exact Run.cons s bs hcode rest
|
||
valid := by
|
||
intro s ρ₁ ρ₂ bs vs st hcode hbs hvs
|
||
cases hbs with
|
||
| noop =>
|
||
intro x assigners hmem n hla
|
||
exact hvs x assigners hmem n
|
||
(lastAssign_cons_of_ne prog hla (fun _ h => BasicStmt.noConfusion h))
|
||
| assign x e v hev =>
|
||
intro k assigners hmem n hla
|
||
have hmem2 : (k, assigners) ∈
|
||
FiniteMap.generalizedUpdate id (fun _ _ => genSet prog s hcode) [x] vs := hmem
|
||
by_cases hx : k = x
|
||
· subst hx
|
||
have hd := FiniteMap.generalizedUpdate_mem_eq (List.mem_singleton.mpr rfl) hmem2
|
||
have hn := lastAssign_cons_here prog hla
|
||
subst hd
|
||
rw [hn]
|
||
simp only [genSet, Function.update_self]
|
||
· have hp := lastAssign_cons_of_ne prog hla
|
||
(by intro e' h; injection h with h1 _; exact hx h1.symm)
|
||
have hmem' := FiniteMap.generalizedUpdate_not_mem_backward
|
||
(fun hc => hx (List.mem_singleton.mp hc)) hmem2
|
||
exact hvs k assigners hmem' n hp
|
||
botV_init := by intro x assigners _ n hla; cases hla
|
||
|
||
theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
|
||
⟦ variablesAt prog.finalState (result (DefSet prog) prog) ⟧ ρ
|
||
(stepTraceState (prog.trace hrun) (stateInterp prog).init) :=
|
||
Forward.analyze_correct_state (DefSet prog) prog hrun
|
||
|
||
end ReachingAnalysis
|
||
|
||
end Spa
|