Add proof of reaching definition analysis

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>
2026-06-27 16:29:16 -05:00
parent 5737805125
commit b6b30958aa
20 changed files with 678 additions and 197 deletions
--- a/lean/Spa/Analysis/Constant.lean
+++ b/lean/Spa/Analysis/Constant.lean
@@ -158,7 +158,7 @@ instance eval_valid : ValidExprEvaluator ConstLattice prog := by
    exact minus_valid h₁ h₂

 theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
-    ⟦ variablesAt prog.finalState (result ConstLattice prog) ⟧ ρ :=
+    ⟦ variablesAt prog.finalState (result ConstLattice prog) ⟧ ρ () :=
  Forward.analyze_correct ConstLattice prog hrun

 end ConstAnalysis
--- a/lean/Spa/Analysis/Forward.lean
+++ b/lean/Spa/Analysis/Forward.lean
@@ -9,13 +9,22 @@ namespace Forward

 variable {L : Type} [FiniteHeightLattice L] {prog : Program} [E : StmtEvaluator L prog]

+def evalStmtOrNone (s : prog.State) (o : Option BasicStmt) (hco : prog.code s = o)
+    (vs : VariableValues L prog) : VariableValues L prog :=
+  o.elimEq vs (fun bs h => E.eval s bs (hco.trans h))
+
+lemma evalStmtOrNone_mono (s : prog.State) (o : Option BasicStmt)
+    (hco : prog.code s = o) : Monotone (evalStmtOrNone (L := L) s o hco) :=
+  elimEq_self_mono o (fun bs h vs => E.eval s bs (hco.trans h) vs)
+    (fun bs h => E.eval_mono s bs (hco.trans h))
+
 def updateVariablesForState (s : prog.State) (sv : StateVariables L prog) :
    VariableValues L prog :=
-  (prog.code s).foldl (fun vs bs => E.eval s bs vs) (variablesAt s sv)
+  evalStmtOrNone s (prog.code s) rfl (variablesAt s sv)

 lemma updateVariablesForState_mono (s : prog.State) :
    Monotone (updateVariablesForState (L := L) s) := fun _ _ hle =>
-  foldl_mono' (prog.code s) _ (E.eval_mono s ·) (variablesAt_le hle s)
+  evalStmtOrNone_mono s (prog.code s) rfl (variablesAt_le hle s)

 def updateAll (sv : StateVariables L prog) : StateVariables L prog :=
  FiniteMap.generalizedUpdate id updateVariablesForState
@@ -54,67 +63,99 @@ lemma joinForKey_initialState :
  rw [joinForKey, prog.incoming_initialState_eq_nil]
  rfl

-variable [I : LatticeInterpretation L] [V : ValidStmtEvaluator L prog]
+class ValidStateEvaluator (L : Type) [FiniteHeightLattice L] (prog : Program)
+    [E : StmtEvaluator L prog] [S : StateInterp L prog] where
+  step : (s : prog.State) → {ρ₁ ρ₂ : Env} → {bs : BasicStmt} →
+    prog.code s = some bs → EvalBasicStmt ρ₁ bs ρ₂ → S.St ρ₁ → S.St ρ₂
+  valid : ∀ (s : prog.State) {ρ₁ ρ₂ : Env} {bs : BasicStmt}
+    {vs : VariableValues L prog} {st : S.St ρ₁},
+    (hcode : prog.code s = some bs) → (hbs : EvalBasicStmt ρ₁ bs ρ₂) → ⟦ vs ⟧ ρ₁ st →
+    ⟦ E.eval s bs hcode vs ⟧ ρ₂ (step s hcode hbs st)
+  botV_init : ⟦ botV L prog ⟧ [] S.init
+
+instance [LatticeInterpretation L] [ValidStmtEvaluator L prog] :
+    ValidStateEvaluator L prog where
+  step := by intro _ _ _ _ _ _ _; exact PUnit.unit
+  valid := by intro _ _ _ _ _ _ hcode hbs hvs; exact ValidStmtEvaluator.valid hcode hbs hvs
+  botV_init := by intro k l _ v hmem; cases hmem
+
+section
+variable [S : StateInterp L prog] [V : ValidStateEvaluator L prog]
+
+noncomputable def stepStmtOrNone (s : prog.State) {ρ₁ ρ₂ : Env} :
+    (o : Option BasicStmt) → prog.code s = o → EvalBasicStmtOpt ρ₁ o ρ₂ →
+    S.St ρ₁ → S.St ρ₂
+  | none, _, .none, st => st
+  | some _, hco, .some hbs, st => V.step s hco hbs st
+
+noncomputable def stepNode (s : prog.State) {ρ₁ ρ₂ : Env}
+    (h : EvalBasicStmtOpt ρ₁ (prog.code s) ρ₂) (st : S.St ρ₁) : S.St ρ₂ :=
+  stepStmtOrNone s (prog.code s) rfl h st
+
+noncomputable def stepTraceState :
+    {s₁ s₂ : prog.State} → {ρ₁ ρ₂ : Env} →
+    Trace prog.cfg s₁ s₂ ρ₁ ρ₂ → S.St ρ₁ → S.St ρ₂
+  | s₁, _, _, _, .single hnode, st => stepNode s₁ hnode st
+  | s₁, _, _, _, .edge hnode _ subtr, st =>
+      stepTraceState subtr (stepNode s₁ hnode st)

 omit [DecidableEq L] in
-lemma eval_fold_valid {s : prog.State} {bss : List BasicStmt}
-    {vs : VariableValues L prog} {ρ₁ ρ₂ : Env}
-    (hbss : EvalBasicStmts ρ₁ bss ρ₂) (hvs : ⟦ vs ⟧ ρ₁) :
-    ⟦ bss.foldl (fun vs bs => E.eval s bs vs) vs ⟧ ρ₂ := by
-  induction hbss generalizing vs with
-  | nil => exact hvs
-  | cons hbs _ ih => exact ih (ValidStmtEvaluator.valid hbs hvs)
-
-omit [DecidableEq L] in
-lemma updateVariablesForState_matches {s : prog.State}
-    {sv : StateVariables L prog} {ρ₁ ρ₂ : Env}
-    (hbss : EvalBasicStmts ρ₁ (prog.code s) ρ₂)
-    (hvs : ⟦ variablesAt s sv ⟧ ρ₁) :
-    ⟦ updateVariablesForState s sv ⟧ ρ₂ :=
-  eval_fold_valid hbss hvs
+lemma evalStmtOrNone_valid {s : prog.State} {ρ₁ ρ₂ : Env} {st : S.St ρ₁}
+    {vs : VariableValues L prog} (o : Option BasicStmt) (hco : prog.code s = o)
+    (he : EvalBasicStmtOpt ρ₁ o ρ₂) (hvs : ⟦ vs ⟧ ρ₁ st) :
+    ⟦ evalStmtOrNone s o hco vs ⟧ ρ₂ (stepStmtOrNone s o hco he st) := by
+  cases he with
+  | none => exact hvs
+  | some hbs => exact V.valid s hco hbs hvs

 omit [DecidableEq L] in
 lemma updateAll_matches {s : prog.State} {sv : StateVariables L prog}
-    {ρ₁ ρ₂ : Env} (hbss : EvalBasicStmts ρ₁ (prog.code s) ρ₂)
-    (hvs : ⟦ variablesAt s sv ⟧ ρ₁) :
-    ⟦ variablesAt s (updateAll sv) ⟧ ρ₂ := by
+    {ρ₁ ρ₂ : Env} {st : S.St ρ₁}
+    (hnode : EvalBasicStmtOpt ρ₁ (prog.code s) ρ₂)
+    (hvs : ⟦ variablesAt s sv ⟧ ρ₁ st) :
+    ⟦ variablesAt s (updateAll sv) ⟧ ρ₂ (stepNode s hnode st) := by
  rw [variablesAt_updateAll]
-  exact updateVariablesForState_matches hbss hvs
+  exact evalStmtOrNone_valid (prog.code s) rfl hnode hvs

-lemma stepTrace {s₁ : prog.State} {ρ₁ ρ₂ : Env}
-    (hjoin : ⟦ joinForKey s₁ (result L prog) ⟧ ρ₁)
-    (hbss : EvalBasicStmts ρ₁ (prog.code s₁) ρ₂) :
-    ⟦ variablesAt s₁ (result L prog) ⟧ ρ₂ := by
+lemma stepTrace {s₁ : prog.State} {ρ₁ ρ₂ : Env} {st : S.St ρ₁}
+    (hjoin : ⟦ joinForKey s₁ (result L prog) ⟧ ρ₁ st)
+    (hnode : EvalBasicStmtOpt ρ₁ (prog.code s₁) ρ₂) :
+    ⟦ variablesAt s₁ (result L prog) ⟧ ρ₂ (stepNode s₁ hnode st) := by
  rw [result_eq L prog]
-  refine updateAll_matches hbss ?_
+  refine updateAll_matches hnode ?_
  rw [variablesAt_joinAll]
  exact hjoin

-lemma walkTrace {s₁ s₂ : prog.State} {ρ₁ ρ₂ : Env}
-    (hjoin : ⟦ joinForKey s₁ (result L prog) ⟧ ρ₁)
+lemma walkTrace {s₁ s₂ : prog.State} {ρ₁ ρ₂ : Env} {st₁ : S.St ρ₁}
+    (hjoin : ⟦ joinForKey s₁ (result L prog) ⟧ ρ₁ st₁)
    (tr : Trace prog.cfg s₁ s₂ ρ₁ ρ₂) :
-    ⟦ variablesAt s₂ (result L prog) ⟧ ρ₂ := by
+    ⟦ variablesAt s₂ (result L prog) ⟧ ρ₂ (stepTraceState tr st₁) := by
  induction tr with
-  | single hbss => exact stepTrace hjoin hbss
-  | @edge _ ρ' _ i₁ i₂ _ hbss hedge _ ih =>
-    have hstep : ⟦ variablesAt i₁ (result L prog) ⟧ ρ' :=
-      stepTrace hjoin hbss
+  | single hnode => exact stepTrace hjoin hnode
+  | @edge _ ρ' _ i₁ i₂ _ hnode hedge _ ih =>
+    have hstep : ⟦ variablesAt i₁ (result L prog) ⟧ ρ' (stepNode i₁ hnode st₁) :=
+      stepTrace hjoin hnode
    have hmem : variablesAt i₁ (result L prog)
        ∈ (result L prog).valuesAt (prog.incoming i₂) :=
      FiniteMap.mem_valuesAt prog.states_nodup
        (prog.mem_incoming_of_edge hedge) (variablesAt_mem i₁ (result L prog))
    exact ih (interp_foldr hstep hmem)

-omit V in
-lemma interp_joinForKey_initialState :
-    ⟦ joinForKey prog.initialState (result L prog) ⟧ [] := by
+variable (L prog) in
+theorem analyze_correct_state {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
+    ⟦ variablesAt prog.finalState (result L prog) ⟧ ρ
+      (stepTraceState (prog.trace hrun) S.init) := by
+  refine walkTrace ?_ (prog.trace hrun)
  rw [joinForKey_initialState]
-  exact interp_botV_nil
+  exact ValidStateEvaluator.botV_init
+
+end

 variable (L prog) in
-theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
-    ⟦ variablesAt prog.finalState (result L prog) ⟧ ρ :=
-  walkTrace interp_joinForKey_initialState (prog.trace hrun)
+theorem analyze_correct [LatticeInterpretation L] [ValidStmtEvaluator L prog]
+    {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
+    ⟦ variablesAt prog.finalState (result L prog) ⟧ ρ () :=
+  analyze_correct_state L prog hrun

 end Forward

--- a/lean/Spa/Analysis/Forward/Adapters.lean
+++ b/lean/Spa/Analysis/Forward/Adapters.lean
@@ -14,14 +14,14 @@ lemma updateVariablesFromExpression_mono (k : String) (e : Expr) :
    Monotone (updateVariablesFromExpression (L := L) (prog := prog) k e) :=
  FiniteMap.generalizedUpdate_monotone monotone_id (fun _ => E.eval_mono e)

-def evalBasicStmt (_ : prog.State) (bs : BasicStmt)
+def evalBasicStmt (s : prog.State) (bs : BasicStmt) (_h : prog.code s = some bs)
    (vs : VariableValues L prog) : VariableValues L prog :=
  match bs with
  | .assign k e => updateVariablesFromExpression k e vs
  | .noop => vs

-lemma evalBasicStmt_mono (s : prog.State) (bs : BasicStmt) :
-    Monotone (evalBasicStmt (L := L) (prog := prog) s bs) := by
+lemma evalBasicStmt_mono (s : prog.State) (bs : BasicStmt) (h : prog.code s = some bs) :
+    Monotone (evalBasicStmt (L := L) (prog := prog) s bs h) := by
  cases bs with
  | assign k e => exact updateVariablesFromExpression_mono k e
  | noop => exact monotone_id
@@ -32,7 +32,7 @@ instance ExprEvaluator.toStmtEvaluator : StmtEvaluator L prog :=
 instance ExprEvaluator.toStmtEvaluator_valid [LatticeInterpretation L]
    [ValidExprEvaluator L prog] : ValidStmtEvaluator L prog := by
  constructor
-  intro s vs ρ₁ ρ₂ bs hbs hvs
+  intro s vs ρ₁ ρ₂ bs hcode hbs hvs
  cases hbs with
  | noop => exact hvs
  | assign k e v hev =>
--- a/lean/Spa/Analysis/Forward/Evaluation.lean
+++ b/lean/Spa/Analysis/Forward/Evaluation.lean
@@ -7,8 +7,9 @@ namespace Forward
 variable (L : Type) [Lattice L] (prog : Program)

 class StmtEvaluator where
-  eval : prog.State → BasicStmt → VariableValues L prog → VariableValues L prog
-  eval_mono : ∀ s bs, Monotone (eval s bs)
+  eval : (s : prog.State) → (bs : BasicStmt) → prog.code s = some bs →
+    VariableValues L prog → VariableValues L prog
+  eval_mono : ∀ s bs h, Monotone (eval s bs h)

 class ExprEvaluator where
  eval : Expr → VariableValues L prog → L
@@ -17,13 +18,13 @@ class ExprEvaluator where
 class ValidExprEvaluator [ExprEvaluator L prog] [I : LatticeInterpretation L] :
    Prop where
  valid : ∀ {vs : VariableValues L prog} {ρ : Env} {e : Expr} {v : Value},
-    EvalExpr ρ e v → ⟦ vs ⟧ ρ → I.interp (ExprEvaluator.eval e vs) v
+    EvalExpr ρ e v → ⟦ vs ⟧ ρ () → I.interp (ExprEvaluator.eval e vs) v

 class ValidStmtEvaluator [E : StmtEvaluator L prog] [LatticeInterpretation L] :
    Prop where
  valid : ∀ {s : prog.State} {vs : VariableValues L prog} {ρ₁ ρ₂ : Env}
-    {bs : BasicStmt},
-    EvalBasicStmt ρ₁ bs ρ₂ → ⟦ vs ⟧ ρ₁ → ⟦ E.eval s bs vs ⟧ ρ₂
+    {bs : BasicStmt} (hcode : prog.code s = some bs),
+    EvalBasicStmt ρ₁ bs ρ₂ → ⟦ vs ⟧ ρ₁ () → ⟦ E.eval s bs hcode vs ⟧ ρ₂ ()

 end Forward

--- a/lean/Spa/Analysis/Forward/Lattices.lean
+++ b/lean/Spa/Analysis/Forward/Lattices.lean
@@ -64,39 +64,47 @@ 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))

-/-! ### Lifting an interpretation to variable maps -/
+class StateInterp (L : Type) [Lattice L] (prog : Program) where
+  St : Env → Type
+  init : St []
+  interp : VariableValues L prog → (ρ : Env) → St ρ → Prop
+  interp_sup : ∀ {vs₁ vs₂ : VariableValues L prog} {ρ : Env} {st : St ρ},
+    interp vs₁ ρ st ∨ interp vs₂ ρ st → interp (vs₁ ⊔ vs₂) ρ st
+  interp_inf : ∀ {vs₁ vs₂ : VariableValues L prog} {ρ : Env} {st : St ρ},
+    interp vs₁ ρ st ∧ interp vs₂ ρ st → interp (vs₁ ⊓ vs₂) ρ st

-variable [I : LatticeInterpretation L]
+instance [S : StateInterp L prog] :
+    Interp (VariableValues L prog) ((ρ : Env) → S.St ρ → Prop) :=
+  ⟨S.interp⟩

-omit [FiniteHeightLattice L] in
-instance : Interp (VariableValues L prog) (Env → Prop) where
-  interp (vs : VariableValues L prog) (ρ : Env) : Prop :=
-    ∀ (k : String) (l : L), (k, l) ∈ vs →
-      ∀ (v : Value), Env.Mem (k, v) ρ → I.interp l v
-
-lemma interp_botV_nil : ⟦ botV L prog ⟧ [] := by
-  intro k l _ v hmem
-  cases hmem
-
-omit [FiniteHeightLattice L] in
-lemma interp_sup {vs₁ vs₂ : VariableValues L prog} {ρ : Env}
-    (h : ⟦ vs₁⟧ ρ ∨ ⟦ vs₂ ⟧ ρ) : ⟦ vs₁ ⊔ vs₂ ⟧ ρ := by
-  intro 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))
-
-lemma interp_foldr {vs : VariableValues L prog}
-    {vss : List (VariableValues L prog)} {ρ : Env}
-    (hvs : ⟦ vs ⟧ ρ) (hmem : vs ∈ vss) :
-    ⟦ vss.foldr (· ⊔ ·) (botV L prog) ⟧ ρ := by
+lemma interp_foldr [S : StateInterp L prog]
+    {vs : VariableValues L prog} {vss : List (VariableValues L prog)}
+    {ρ : Env} {st : S.St ρ} (hvs : ⟦ vs ⟧ ρ st) (hmem : vs ∈ vss) :
+    ⟦ vss.foldr (· ⊔ ·) (botV L prog) ⟧ ρ st := by
  induction vss with
  | nil => cases hmem
  | cons vs' vss' ih =>
    rcases List.mem_cons.mp hmem with rfl | hmem'
-    · exact interp_sup (Or.inl hvs)
-    · exact interp_sup (Or.inr (ih hmem'))
+    · exact S.interp_sup (Or.inl hvs)
+    · exact S.interp_sup (Or.inr (ih hmem'))
+
+variable [I : LatticeInterpretation L]
+
+instance : StateInterp L prog where
+  St := fun _ => PUnit
+  init := PUnit.unit
+  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₂ ρ st 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₂ ρ st 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⟩

 end Forward

--- a/lean/Spa/Analysis/Reaching.lean
+++ b/lean/Spa/Analysis/Reaching.lean
@@ -1,5 +1,7 @@
 import Spa.Analysis.Forward
 import Spa.Lattice.Bool
+import Spa.Lattice.Tuple
+import Spa.Language.Tagged.Graphs
 import Spa.Showable

 namespace Spa
@@ -8,23 +10,31 @@ open Forward

 instance : Showable Bool := ⟨fun b => if b then "true" else "false"⟩

-abbrev DefSet (prog : Program) : Type := FiniteMap prog.State Bool prog.states
+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) : DefSet prog :=
-  FiniteMap.updating (⊥ : DefSet prog) [s] (fun _ => true)
+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) :
-    BasicStmt → VariableValues (DefSet prog) prog → VariableValues (DefSet prog) prog
-  | .assign k _, vs =>
-    FiniteMap.generalizedUpdate id (fun _ _ => genSet prog s) [k] vs
-  | .noop, vs => vs
+    (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) :
-    Monotone (eval prog s bs) := by
+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)
@@ -36,6 +46,86 @@ instance stmtEvaluator : StmtEvaluator (DefSet prog) 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
--- a/lean/Spa/Analysis/Sign.lean
+++ b/lean/Spa/Analysis/Sign.lean
@@ -216,7 +216,7 @@ instance eval_valid : ValidExprEvaluator SignLattice prog := by
    exact minus_valid h₁ h₂

 theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
-    ⟦ variablesAt prog.finalState (result SignLattice prog) ⟧ ρ :=
+    ⟦ variablesAt prog.finalState (result SignLattice prog) ⟧ ρ () :=
  Forward.analyze_correct SignLattice prog hrun

 end SignAnalysis