Remove 'prog.code s = some bs' argument to eval

lean/Main.lean

@@ -1,5 +1,6 @@
 import Spa.Analysis.Sign
 import Spa.Analysis.Constant
+import Spa.Analysis.Reaching
 import Spa.Language.Notation
 
 namespace Spa
@@ -32,4 +33,5 @@ end Spa
 
 def main : IO Unit :=
   IO.println (Spa.ConstAnalysis.output Spa.testProgram ++ "\n" ++
-              Spa.SignAnalysis.output Spa.testProgram)
+              Spa.SignAnalysis.output Spa.testProgram ++ "\n" ++
+              Spa.ReachingAnalysis.output Spa.testProgram)

lean/Spa/Analysis/Forward.lean

@@ -9,22 +9,12 @@ 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 :=
+    VariableValues L prog := E.eval s (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 =>
-  evalStmtOrNone_mono s (prog.code s) rfl (variablesAt_le hle s)
+  E.eval_mono s (variablesAt_le hle s)
 
 def updateAll (sv : StateVariables L prog) : StateVariables L prog :=
   FiniteMap.generalizedUpdate id updateVariablesForState
@@ -65,32 +55,25 @@ lemma joinForKey_initialState :
 
 class ValidStateEvaluator (L : Type) [FiniteHeightLattice L] (prog : Program)
     [E : StmtEvaluator L prog] [S : StateInterpretation L prog] where
-  step : (s : prog.State) → {ρ₁ ρ₂ : Env} → {bs : BasicStmt} →
+  step : (s : prog.State) → {ρ₁ ρ₂ : Env} → EvalBasicStmtOpt ρ₁ (prog.code s) ρ₂ → S.St ρ₁ → S.St ρ₂
-    prog.code s = some bs → EvalBasicStmt ρ₁ bs ρ₂ → S.St ρ₁ → S.St ρ₂
+  valid : ∀ (s : prog.State) {ρ₁ ρ₂ : Env}
-  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 →
+    (hbs : EvalBasicStmtOpt ρ₁ (prog.code s) ρ₂) → ⟦ vs ⟧ ρ₁ st →
-    ⟦ E.eval s bs hcode vs ⟧ ρ₂ (step s hcode hbs st)
+    ⟦ E.eval s vs ⟧ ρ₂ (step s 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
+  step := by intro _ _ _ _ _; exact PUnit.unit
-  valid := by intro _ _ _ _ _ _ hcode hbs hvs; exact ValidStmtEvaluator.valid hcode hbs hvs
+  valid := by intro _ _ _ _ _ hbs hvs; exact ValidStmtEvaluator.valid hbs hvs
   botV_init := by intro k l _ v hmem; cases hmem
 
 section
 variable [S : StateInterpretation 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
+  V.step s h st
 
 noncomputable def stepTraceState :
     {s₁ s₂ : prog.State} → {ρ₁ ρ₂ : Env} →
@@ -121,15 +104,6 @@ inductive Reaches : {s₁ s₂ : prog.State} → {ρ₁ ρ₂ : Env} →
       Reaches rest (stepNode s₁ hnode st₁) s ρin ρout stin stout →
       Reaches (.edge hnode hedge rest) st₁ s ρin ρout stin stout
 
-omit [DecidableEq L] in
-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} {st : S.St ρ₁}
@@ -137,7 +111,7 @@ lemma updateAll_matches {s : prog.State} {sv : StateVariables L prog}
     (hvs : ⟦ variablesAt s sv ⟧ ρ₁ st) :
     ⟦ variablesAt s (updateAll sv) ⟧ ρ₂ (stepNode s hnode st) := by
   rw [variablesAt_updateAll]
-  exact evalStmtOrNone_valid (prog.code s) rfl hnode hvs
+  exact V.valid s hnode hvs
 
 lemma stepTrace {s₁ : prog.State} {ρ₁ ρ₂ : Env} {st : S.St ρ₁}
     (hjoin : ⟦ joinForKey s₁ (result L prog) ⟧ ρ₁ st)

lean/Spa/Analysis/Forward/Adapters.lean

@@ -14,44 +14,50 @@ 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 (s : prog.State) (bs : BasicStmt) (_h : prog.code s = some bs)
+def evalBasicStmt (bs : BasicStmt)
     (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) (h : prog.code s = some bs) :
+lemma evalBasicStmt_mono (bs : BasicStmt) :
-    Monotone (evalBasicStmt (L := L) (prog := prog) s bs h) := by
+    Monotone (evalBasicStmt (L := L) (prog := prog) bs) := by
   cases bs with
   | assign k e => exact updateVariablesFromExpression_mono k e
   | noop => exact monotone_id
 
+def evalBasicStmtOpt (obs : Option BasicStmt)
+    (vs : VariableValues L prog) : VariableValues L prog :=
+  match obs with
+  | none => vs
+  | some bs => evalBasicStmt bs vs
+
+lemma evalBasicStmtOpt_mono (obs : Option BasicStmt) :
+    Monotone (evalBasicStmtOpt (L := L) (prog := prog) obs) := by
+  cases obs <;> unfold evalBasicStmtOpt
+  · exact monotone_id
+  · apply evalBasicStmt_mono
+
 instance ExprEvaluator.toStmtEvaluator : StmtEvaluator L prog :=
-  ⟨evalBasicStmt, evalBasicStmt_mono⟩
+  ⟨evalBasicStmtOpt ∘ prog.code,
+   by intro s; simp; exact (evalBasicStmtOpt_mono (prog.code s))⟩
 
 instance ExprEvaluator.toStmtEvaluator_valid [LatticeInterpretation L]
     [ValidExprEvaluator L prog] : ValidStmtEvaluator L prog := by
   constructor
-  intro s vs ρ₁ ρ₂ bs hcode hbs hvs
+  simp [StmtEvaluator.eval, evalBasicStmtOpt]
-  cases hbs with
+  intro s vs ρ₁ ρ₂; generalize prog.code s = obs; intro hev hvs
-  | noop => exact hvs
+  rcases hev with _ | @⟨_,bs,hev⟩ <;> try simpa
-  | assign k e v hev =>
+  rcases hev with _ | @⟨k, e, v, hev⟩ <;> try simpa
-    intro k' l hk'l v' hv'
+  intros k' l' hkl' v' hρ
-    cases hv' with
+  rcases hρ with _ | ⟨_,_,_,_,_,hne,hmem⟩ <;> simp [evalBasicStmt] at hkl'
-    | here =>
+  · have hl := FiniteMap.generalizedUpdate_mem_eq (f := id)
-      have hk'l₀ : (k, l) ∈ FiniteMap.generalizedUpdate (ks := prog.vars) id
+        (g := fun _ vs => E.eval e vs) (List.mem_singleton_self k) hkl'
-          (fun _ vs => E.eval e vs) [k] vs := hk'l
+    rewrite [hl]; simp
-      have hl := FiniteMap.generalizedUpdate_mem_eq (f := id)
+    exact ValidExprEvaluator.valid hev hvs
-        (g := fun _ vs => E.eval e vs) (List.mem_singleton_self k) hk'l₀
+  · have hl := FiniteMap.generalizedUpdate_not_mem_backward
-      rw [hl]
+        (fun hmem => hne (List.mem_singleton.mp hmem)) hkl'
-      exact ValidExprEvaluator.valid hev hvs
+    apply hvs _ _ hl _ hmem
-    | there _ _ _ _ _ hne hmem' =>
-      have hk'l₀ : (k', l) ∈ FiniteMap.generalizedUpdate (ks := prog.vars) id
-          (fun _ vs => E.eval e vs) [k] vs := hk'l
-      have hk'l' : (k', l) ∈ (id vs : VariableValues L prog) :=
-        FiniteMap.generalizedUpdate_not_mem_backward
-          (fun hmem => hne (List.mem_singleton.mp hmem)) hk'l₀
-      exact hvs _ _ hk'l' _ hmem'
 
 end Forward
 

lean/Spa/Analysis/Forward/Evaluation.lean

@@ -7,9 +7,8 @@ namespace Forward
 variable (L : Type) [Lattice L] (prog : Program)
 
 class StmtEvaluator where
-  eval : (s : prog.State) → (bs : BasicStmt) → prog.code s = some bs →
+  eval : prog.State → VariableValues L prog → VariableValues L prog
-    VariableValues L prog → VariableValues L prog
+  eval_mono : ∀ s, Monotone (eval s)
-  eval_mono : ∀ s bs h, Monotone (eval s bs h)
 
 class ExprEvaluator where
   eval : Expr → VariableValues L prog → L
@@ -22,9 +21,8 @@ class ValidExprEvaluator [ExprEvaluator L prog] [I : LatticeInterpretation L] :
 
 class ValidStmtEvaluator [E : StmtEvaluator L prog] [LatticeInterpretation L] :
     Prop where
-  valid : ∀ {s : prog.State} {vs : VariableValues L prog} {ρ₁ ρ₂ : Env}
+  valid : ∀ {s : prog.State} {vs : VariableValues L prog} {ρ₁ ρ₂ : Env},
-    {bs : BasicStmt} (hcode : prog.code s = some bs),
+    EvalBasicStmtOpt ρ₁ (prog.code s) ρ₂ → ⟦ vs ⟧ ρ₁ () → ⟦ E.eval s vs ⟧ ρ₂ ()
-    EvalBasicStmt ρ₁ bs ρ₂ → ⟦ vs ⟧ ρ₁ () → ⟦ E.eval s bs hcode vs ⟧ ρ₂ ()
 
 end Forward
 

lean/Spa/Analysis/Reaching.lean

@@ -19,23 +19,23 @@ namespace ReachingAnalysis
 
 variable (prog : Program)
 
-def genSet (s : prog.State) {bs : BasicStmt} (h : prog.code s = some bs) :
+def genSet (s : prog.State) : DefSet prog := (prog.nodeIdOf s).elim {} (fun x => {x})
-    DefSet prog :=
-  {prog.nodeIdOfNonempty s h}
 
-def eval (s : prog.State) :
+def eval (s : prog.State) (vs : VariableValues (DefSet prog) prog) : VariableValues (DefSet prog) prog :=
-    (bs : BasicStmt) → prog.code s = some bs →
+  match prog.code s with
-    VariableValues (DefSet prog) prog → VariableValues (DefSet prog) prog
+  | none => vs
-  | .assign k _, h, vs =>
+  | some bs =>
-    FiniteMap.generalizedUpdate id (fun _ _ => genSet prog s h) [k] vs
+    match bs with
-  | .noop, _, vs => vs
+    | .assign k _ => FiniteMap.generalizedUpdate id (fun _ _ => genSet prog s) [k] vs
+    | .noop => vs
 
-lemma eval_mono (s : prog.State) (bs : BasicStmt) (h : prog.code s = some bs) :
+lemma eval_mono (s : prog.State) :
-    Monotone (eval prog s bs h) := by
+    Monotone (eval prog s) := by
-  cases bs with
+  intros vs₁ vs₂ hle
-  | assign k e =>
+  unfold eval; split <;> try simpa
-    exact FiniteMap.generalizedUpdate_monotone monotone_id (fun _ => monotone_const)
+  split <;> try simpa
-  | noop => exact monotone_id
+  apply FiniteMap.generalizedUpdate_monotone monotone_id (fun _ => monotone_const)
+  assumption
 
 instance stmtEvaluator : StmtEvaluator (DefSet prog) prog :=
   ⟨eval prog, eval_mono prog⟩
@@ -45,18 +45,18 @@ def output : String :=
 
 inductive Run (prog : Program) where
   | nil : Run prog
-  | cons (s : prog.State) (bs : BasicStmt) (hc : prog.code s = some bs)
+  | cons (s : prog.State) (bs : BasicStmt)
       (rest : Run prog) : Run prog
 
 @[aesop unsafe cases]
 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)
+      LastAssign prog x (Run.cons s (.assign x e) 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
+      LastAssign prog x (Run.cons s bs rest) n
 
 instance stateInterp : StateInterpretation (DefSet prog) prog where
   St := fun _ => Run prog
@@ -72,22 +72,27 @@ instance stateInterp : StateInterpretation (DefSet prog) prog where
     obtain ⟨a₁, a₂, rfl, h₁, h₂⟩ := FiniteMap.mem_inf hmem
     aesop (add simp Finset.mem_inter)
 
+private def stepAt (s : prog.State) (obs : Option BasicStmt) { ρ₁ ρ₂ : Env} : EvalBasicStmtOpt ρ₁ obs ρ₂ → Run prog → Run prog
+  | .none, rest => rest
+  | .some (bs := bs) _, rest => Run.cons s bs rest
+
 instance validStateEvaluator : ValidStateEvaluator (DefSet prog) prog where
-  step := by intro s _ _ bs hcode _ rest; exact Run.cons s bs hcode rest
+  step := fun s ρ₁ ρ₂ => stepAt prog s (prog.code s)
   valid := by
-    intro s ρ₁ ρ₂ bs vs st hcode hbs hvs
+    simp [StmtEvaluator.eval, eval];
+    intro s ρ₁ ρ₂ vs; generalize prog.code s = obs; intro hst hbs hvs
+    rcases hbs with _ | @⟨_, bs, hbs⟩; try (simpa [stepAt])
     cases hbs with
     | noop => intro x assigners hmem n hla; aesop
     | assign x e v hev =>
-      intro k assigners hmem n hla
+      simp; 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 hd := FiniteMap.generalizedUpdate_mem_eq (List.mem_singleton.mpr rfl) hmem
-        aesop (add simp [genSet, Finset.mem_singleton])
+        rcases hla
+          <;> simp [Program.nodeIdOfNonempty, hd, genSet, Option.get] <;> aesop
       · have hmem' := FiniteMap.generalizedUpdate_not_mem_backward
-          (fun hc => hx (List.mem_singleton.mp hc)) hmem2
+          (fun hc => hx (List.mem_singleton.mp hc)) hmem
         aesop
   botV_init := by intro x assigners _ n hla; cases hla