Prove correctness of constant folding

lean/Spa/Transformation/Constant.lean

@@ -126,6 +126,53 @@ theorem foldExpr_eval {vs : VariableValues ConstLattice prog} {ρ : Env} (hvs :
       · cases hev with
         | sub _ _ z₁ z₂ h₁ h₂ => exact EvalExpr.sub ρ _ _ z₁ z₂ (iha h₁) (ihb h₂)
 
+/-- Fold a source evaluation using its actual whole-program execution prefix. -/
+noncomputable def foldStmt_eval (prog : Program) {s : Stmt} {ρ₀ ρ₁ : Env}
+    (h : EvalStmt ρ₀ s ρ₁) :
+    (e : Embed s.cfg prog.cfg) →
+    (pre : Traceₗ prog.cfg prog.initialState (e.f (Stmt.cfg_sufficient h).entry) [] ρ₀) →
+    EvalStmt ρ₀ (foldStmt prog (result prog) s e) ρ₁ := by
+  induction h with
+  | basic ρ₀ ρ₁ bs hbs =>
+      intro e pre
+      have hr : Reaches e.singletonIndex ρ₀ ρ₁ :=
+        ⟨pre, by rw [Program.code, e.nodes_singletonIndex]; exact .some hbs⟩
+      cases hbs with
+      | noop => exact .basic _ _ _ (.noop _)
+      | assign x expr v hev =>
+          exact .basic _ _ _ (.assign _ _ _ _
+            (foldExpr_eval (ConstAnalysis.analyze_correct_at prog hr).1 hev))
+  | andThen ρ₀ ρ₁ ρ₂ s₁ s₂ h₁ h₂ ih₁ ih₂ =>
+      intro e pre
+      exact .andThen _ _ _ _ _
+        (ih₁ ((Embed.sequenceLeft s₁.cfg s₂.cfg).trans e) pre)
+        (ih₂ ((Embed.sequenceRight s₁.cfg s₂.cfg).trans e)
+          (Path.append pre (Path.embed e
+            ((Stmt.cfg_sufficient h₁).beforeRight (Stmt.cfg_sufficient h₂)))))
+  | ifTrue ρ₀ ρ₁ cond z s₁ s₂ hc hz h ih =>
+      intro e pre
+      exact .ifTrue _ _ _ _ _ _ hc hz
+        (ih ((Embed.overlayLeft s₁.cfg s₂.cfg).trans e) pre)
+  | ifFalse ρ₀ ρ₁ cond s₁ s₂ hc h ih =>
+      intro e pre
+      exact .ifFalse _ _ _ _ _ hc
+        (ih ((Embed.overlayRight s₁.cfg s₂.cfg).trans e) pre)
+  | whileTrue ρ₀ ρ₁ ρ₂ cond z body hc hz hb hr ihb ihr =>
+      intro e pre
+      exact .whileTrue _ _ _ _ _ _ hc hz
+        (ihb ((Embed.loop body.cfg).trans e)
+          (Path.append pre (Path.embed e (Stmt.cfg_sufficient hb).beforeBody)))
+        (ihr e (Path.append pre (Path.embed e
+          ((Stmt.cfg_sufficient hb).loop.beforeRest (Stmt.cfg_sufficient hr)))))
+  | whileFalse ρ cond body hc =>
+      intro e pre
+      exact .whileFalse _ _ _ hc
+
+/-- Constant folding preserves every terminating source evaluation. -/
+noncomputable def foldProgram_eval (prog : Program) {ρ : Env}
+    (h : EvalStmt [] prog.rootStmt ρ) : EvalStmt [] (foldProgram prog) ρ :=
+  foldStmt_eval prog h prog.rootEmbed (Stmt.cfg_sufficient h).beforeRoot
+
 end ConstantTransform
 
 end Spa