412 lines
14 KiB
Lean4
412 lines
14 KiB
Lean4
|
/-
|
|||
|
|
Port of `Analysis/Sign.agda`.
|
|||
|
|
|
|||
|
|
Correspondence:
|
|||
|
|
Sign (+ / - / 0ˢ) ↦ Sign.plus / Sign.minus / Sign.zero
|
|||
|
|
_≟ᵍ_, ≡-equiv, ≡-Decidable ↦ deriving DecidableEq
|
|||
|
|
SignLattice (AboveBelow) ↦ SignLattice
|
|||
|
|
AB.Plain 0ˢ ↦ signFixedHeight (AboveBelow.plainFixedHeight .zero)
|
|||
|
|
plus, minus ↦ plus, minus
|
|||
|
|
plus-Monoˡ/ʳ, minus-Monoˡ/ʳ (postulates in Agda!)
|
|||
|
|
↦ plus_mono_left/right, minus_mono_left/right —
|
|||
|
|
now actually proved, via AboveBelow.le_cases
|
|||
|
|
plus-Mono₂, minus-Mono₂ ↦ plus_mono₂, minus_mono₂
|
|||
|
|
⟦_⟧ᵍ ↦ interpSign
|
|||
|
|
⟦⟧ᵍ-respects-≈ᵍ ↦ (trivial with `=`)
|
|||
|
|
⟦⟧ᵍ-⊔ᵍ-∨, ⟦⟧ᵍ-⊓ᵍ-∧ ↦ interpSign_sup, interpSign_inf
|
|||
|
|
s₁≢s₂⇒¬s₁∧s₂ ↦ interpSign_mk_disjoint
|
|||
|
|
latticeInterpretationᵍ ↦ signInterpretation
|
|||
|
|
WithProg.eval, eval-Monoʳ ↦ SignAnalysis.eval, eval_mono
|
|||
|
|
SignEval (instance) ↦ SignAnalysis.exprEvaluator
|
|||
|
|
plus-valid, minus-valid ↦ plus_valid, minus_valid
|
|||
|
|
eval-valid, SignEvalValid ↦ eval_valid
|
|||
|
|
output ↦ SignAnalysis.output
|
|||
|
|
analyze-correct ↦ SignAnalysis.analyze_correct
|
|||
|
|
-/
|
|||
|
|
import Spa.Analysis.Forward
|
|||
|
|
import Spa.Analysis.Utils
|
|||
|
|
import Spa.Showable
|
|||
|
|
|
|||
|
|
namespace Spa
|
|||
|
|
|
|||
|
|
inductive Sign where
|
|||
|
|
| plus
|
|||
|
|
| minus
|
|||
|
|
| zero
|
|||
|
|
deriving DecidableEq
|
|||
|
|
|
|||
|
|
instance : Showable Sign :=
|
|||
|
|
⟨fun
|
|||
|
|
| .plus => "+"
|
|||
|
|
| .minus => "-"
|
|||
|
|
| .zero => "0"⟩
|
|||
|
|
|
|||
|
|
/-- Agda: the module parameter `x = 0ˢ` of `AB.Plain`. -/
|
|||
|
|
instance : Inhabited Sign := ⟨.zero⟩
|
|||
|
|
|
|||
|
|
abbrev SignLattice : Type := AboveBelow Sign
|
|||
|
|
|
|||
|
|
/-- Agda: `AB.Plain 0ˢ`'s `fixedHeight`. -/
|
|||
|
|
def signFixedHeight : FixedHeight SignLattice 2 :=
|
|||
|
|
AboveBelow.plainFixedHeight Sign.zero
|
|||
|
|
|
|||
|
|
open AboveBelow in
|
|||
|
|
/-- Agda: `plus`. -/
|
|||
|
|
def plus : SignLattice → SignLattice → SignLattice
|
|||
|
|
| bot, _ => bot
|
|||
|
|
| _, bot => bot
|
|||
|
|
| top, _ => top
|
|||
|
|
| _, top => top
|
|||
|
|
| mk .plus, mk .plus => mk .plus
|
|||
|
|
| mk .plus, mk .minus => top
|
|||
|
|
| mk .plus, mk .zero => mk .plus
|
|||
|
|
| mk .minus, mk .plus => top
|
|||
|
|
| mk .minus, mk .minus => mk .minus
|
|||
|
|
| mk .minus, mk .zero => mk .minus
|
|||
|
|
| mk .zero, mk .plus => mk .plus
|
|||
|
|
| mk .zero, mk .minus => mk .minus
|
|||
|
|
| mk .zero, mk .zero => mk .zero
|
|||
|
|
|
|||
|
|
open AboveBelow in
|
|||
|
|
/-- Agda: `minus`. -/
|
|||
|
|
def minus : SignLattice → SignLattice → SignLattice
|
|||
|
|
| bot, _ => bot
|
|||
|
|
| _, bot => bot
|
|||
|
|
| top, _ => top
|
|||
|
|
| _, top => top
|
|||
|
|
| mk .plus, mk .plus => top
|
|||
|
|
| mk .plus, mk .minus => mk .plus
|
|||
|
|
| mk .plus, mk .zero => mk .plus
|
|||
|
|
| mk .minus, mk .plus => mk .minus
|
|||
|
|
| mk .minus, mk .minus => top
|
|||
|
|
| mk .minus, mk .zero => mk .minus
|
|||
|
|
| mk .zero, mk .plus => mk .minus
|
|||
|
|
| mk .zero, mk .minus => mk .plus
|
|||
|
|
| mk .zero, mk .zero => mk .zero
|
|||
|
|
|
|||
|
|
/-- Agda: `plus-Monoˡ` — a postulate there, a theorem here. -/
|
|||
|
|
theorem plus_mono_left (s₂ : SignLattice) : Monotone (plus · s₂) := by
|
|||
|
|
intro a b h
|
|||
|
|
rcases AboveBelow.le_cases h with rfl | rfl | rfl
|
|||
|
|
· rcases s₂ with _ | _ | y <;> rcases b with _ | _ | x <;>
|
|||
|
|
simp only [plus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
| exact AboveBelow.bot_le' _
|
|||
|
|
· rcases s₂ with _ | _ | y <;> rcases a with _ | _ | x <;>
|
|||
|
|
simp only [plus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
· exact le_refl _
|
|||
|
|
|
|||
|
|
/-- Agda: `plus-Monoʳ` — a postulate there, a theorem here. -/
|
|||
|
|
theorem plus_mono_right (s₁ : SignLattice) : Monotone (plus s₁) := by
|
|||
|
|
intro a b h
|
|||
|
|
rcases AboveBelow.le_cases h with rfl | rfl | rfl
|
|||
|
|
· rcases s₁ with _ | _ | x <;> rcases b with _ | _ | y <;>
|
|||
|
|
simp only [plus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
| exact AboveBelow.bot_le' _
|
|||
|
|
· rcases s₁ with _ | _ | x <;> rcases a with _ | _ | y <;>
|
|||
|
|
simp only [plus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
· exact le_refl _
|
|||
|
|
|
|||
|
|
/-- Agda: `plus-Mono₂`. -/
|
|||
|
|
theorem plus_mono₂ : Monotone₂ plus :=
|
|||
|
|
⟨plus_mono_left, plus_mono_right⟩
|
|||
|
|
|
|||
|
|
/-- Agda: `minus-Monoˡ` — a postulate there, a theorem here. -/
|
|||
|
|
theorem minus_mono_left (s₂ : SignLattice) : Monotone (minus · s₂) := by
|
|||
|
|
intro a b h
|
|||
|
|
rcases AboveBelow.le_cases h with rfl | rfl | rfl
|
|||
|
|
· rcases s₂ with _ | _ | y <;> rcases b with _ | _ | x <;>
|
|||
|
|
simp only [minus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
| exact AboveBelow.bot_le' _
|
|||
|
|
· rcases s₂ with _ | _ | y <;> rcases a with _ | _ | x <;>
|
|||
|
|
simp only [minus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
· exact le_refl _
|
|||
|
|
|
|||
|
|
/-- Agda: `minus-Monoʳ` — a postulate there, a theorem here. -/
|
|||
|
|
theorem minus_mono_right (s₁ : SignLattice) : Monotone (minus s₁) := by
|
|||
|
|
intro a b h
|
|||
|
|
rcases AboveBelow.le_cases h with rfl | rfl | rfl
|
|||
|
|
· rcases s₁ with _ | _ | x <;> rcases b with _ | _ | y <;>
|
|||
|
|
simp only [minus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
| exact AboveBelow.bot_le' _
|
|||
|
|
· rcases s₁ with _ | _ | x <;> rcases a with _ | _ | y <;>
|
|||
|
|
simp only [minus] <;>
|
|||
|
|
first
|
|||
|
|
| exact le_refl _
|
|||
|
|
| exact AboveBelow.le_top' _
|
|||
|
|
· exact le_refl _
|
|||
|
|
|
|||
|
|
/-- Agda: `minus-Mono₂`. -/
|
|||
|
|
theorem minus_mono₂ : Monotone₂ minus :=
|
|||
|
|
⟨minus_mono_left, minus_mono_right⟩
|
|||
|
|
|
|||
|
|
/-- Agda: `⟦_⟧ᵍ`. -/
|
|||
|
|
def interpSign : SignLattice → Value → Prop
|
|||
|
|
| .bot, _ => False
|
|||
|
|
| .top, _ => True
|
|||
|
|
| .mk .plus, v => ∃ n : ℕ, v = .int (n + 1)
|
|||
|
|
| .mk .zero, v => v = .int 0
|
|||
|
|
| .mk .minus, v => ∃ n : ℕ, v = .int (-(n + 1))
|
|||
|
|
|
|||
|
|
/-- Agda: `s₁≢s₂⇒¬s₁∧s₂`. -/
|
|||
|
|
theorem interpSign_mk_disjoint {s₁ s₂ : Sign} (hne : s₁ ≠ s₂) {v : Value} :
|
|||
|
|
¬(interpSign (.mk s₁) v ∧ interpSign (.mk s₂) v) := by
|
|||
|
|
rintro ⟨h₁, h₂⟩
|
|||
|
|
rcases s₁ <;> rcases s₂ <;> try exact hne rfl
|
|||
|
|
all_goals simp only [interpSign] at h₁ h₂
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
obtain ⟨n₂, hv⟩ := h₂
|
|||
|
|
injection hv with hz
|
|||
|
|
omega
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
injection h₂ with hz
|
|||
|
|
omega
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
obtain ⟨n₂, hv⟩ := h₂
|
|||
|
|
injection hv with hz
|
|||
|
|
omega
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
injection h₂ with hz
|
|||
|
|
omega
|
|||
|
|
· subst h₁
|
|||
|
|
obtain ⟨n₂, hv⟩ := h₂
|
|||
|
|
injection hv with hz
|
|||
|
|
omega
|
|||
|
|
· subst h₁
|
|||
|
|
obtain ⟨n₂, hv⟩ := h₂
|
|||
|
|
injection hv with hz
|
|||
|
|
omega
|
|||
|
|
|
|||
|
|
/-- Agda: `⟦⟧ᵍ-⊔ᵍ-∨`. -/
|
|||
|
|
theorem interpSign_sup {s₁ s₂ : SignLattice} (v : Value)
|
|||
|
|
(h : interpSign s₁ v ∨ interpSign s₂ v) : interpSign (s₁ ⊔ s₂) v := by
|
|||
|
|
rcases s₁ with _ | _ | x
|
|||
|
|
· rcases h with h | h
|
|||
|
|
· exact h.elim
|
|||
|
|
· rw [AboveBelow.bot_sup]
|
|||
|
|
exact h
|
|||
|
|
· exact trivial
|
|||
|
|
· rcases s₂ with _ | _ | y
|
|||
|
|
· rcases h with h | h
|
|||
|
|
· rw [AboveBelow.sup_bot]
|
|||
|
|
exact h
|
|||
|
|
· exact h.elim
|
|||
|
|
· rw [AboveBelow.sup_top]
|
|||
|
|
exact trivial
|
|||
|
|
· by_cases hxy : x = y
|
|||
|
|
· subst hxy
|
|||
|
|
rw [AboveBelow.mk_sup_mk, if_pos rfl]
|
|||
|
|
rcases h with h | h <;> exact h
|
|||
|
|
· rw [AboveBelow.mk_sup_mk, if_neg hxy]
|
|||
|
|
exact trivial
|
|||
|
|
|
|||
|
|
/-- Agda: `⟦⟧ᵍ-⊓ᵍ-∧`. -/
|
|||
|
|
theorem interpSign_inf {s₁ s₂ : SignLattice} (v : Value)
|
|||
|
|
(h : interpSign s₁ v ∧ interpSign s₂ v) : interpSign (s₁ ⊓ s₂) v := by
|
|||
|
|
rcases s₁ with _ | _ | x
|
|||
|
|
· exact h.1
|
|||
|
|
· rw [AboveBelow.top_inf]
|
|||
|
|
exact h.2
|
|||
|
|
· rcases s₂ with _ | _ | y
|
|||
|
|
· exact h.2
|
|||
|
|
· rw [AboveBelow.inf_top]
|
|||
|
|
exact h.1
|
|||
|
|
· by_cases hxy : x = y
|
|||
|
|
· subst hxy
|
|||
|
|
rw [AboveBelow.mk_inf_mk, if_pos rfl]
|
|||
|
|
exact h.1
|
|||
|
|
· exact absurd h (interpSign_mk_disjoint hxy)
|
|||
|
|
|
|||
|
|
/-- Agda: `latticeInterpretationᵍ`. -/
|
|||
|
|
def signInterpretation : LatticeInterpretation SignLattice where
|
|||
|
|
interp := interpSign
|
|||
|
|
interp_sup := fun {l₁ l₂} v h => interpSign_sup (s₁ := l₁) (s₂ := l₂) v h
|
|||
|
|
interp_inf := fun {l₁ l₂} v h => interpSign_inf (s₁ := l₁) (s₂ := l₂) v h
|
|||
|
|
|
|||
|
|
namespace SignAnalysis
|
|||
|
|
|
|||
|
|
/-! Agda: `module WithProg (prog : Program)`. -/
|
|||
|
|
|
|||
|
|
variable (prog : Program)
|
|||
|
|
|
|||
|
|
/-- Agda: `WithProg.eval`. -/
|
|||
|
|
def eval : Expr → VariableValues SignLattice prog → SignLattice
|
|||
|
|
| .add e₁ e₂, vs => plus (eval e₁ vs) (eval e₂ vs)
|
|||
|
|
| .sub e₁ e₂, vs => minus (eval e₁ vs) (eval e₂ vs)
|
|||
|
|
| .var k, vs =>
|
|||
|
|
if h : FiniteMap.MemKey k vs then (FiniteMap.locate h).1 else .top
|
|||
|
|
| .num 0, _ => .mk .zero
|
|||
|
|
| .num (_ + 1), _ => .mk .plus
|
|||
|
|
|
|||
|
|
/-- Agda: `WithProg.eval-Monoʳ`. -/
|
|||
|
|
theorem eval_mono (e : Expr) : Monotone (eval prog e) := by
|
|||
|
|
induction e with
|
|||
|
|
| add e₁ e₂ ih₁ ih₂ =>
|
|||
|
|
intro vs₁ vs₂ h
|
|||
|
|
exact eval_combine₂ plus_mono₂ (ih₁ h) (ih₂ h)
|
|||
|
|
| sub e₁ e₂ ih₁ ih₂ =>
|
|||
|
|
intro vs₁ vs₂ h
|
|||
|
|
exact eval_combine₂ minus_mono₂ (ih₁ h) (ih₂ h)
|
|||
|
|
| var k =>
|
|||
|
|
intro vs₁ vs₂ h
|
|||
|
|
simp only [eval]
|
|||
|
|
by_cases hk : k ∈ prog.vars
|
|||
|
|
· rw [dif_pos (FiniteMap.memKey_iff.mpr hk),
|
|||
|
|
dif_pos (FiniteMap.memKey_iff.mpr hk)]
|
|||
|
|
exact FiniteMap.le_of_mem_mem prog.vars_nodup h
|
|||
|
|
(FiniteMap.locate _).2 (FiniteMap.locate _).2
|
|||
|
|
· rw [dif_neg (fun hm => hk (FiniteMap.memKey_iff.mp hm)),
|
|||
|
|
dif_neg (fun hm => hk (FiniteMap.memKey_iff.mp hm))]
|
|||
|
|
| num n =>
|
|||
|
|
intro vs₁ vs₂ _
|
|||
|
|
cases n <;> exact le_refl _
|
|||
|
|
|
|||
|
|
/-- Agda: the `SignEval` instance. -/
|
|||
|
|
def exprEvaluator : ExprEvaluator SignLattice prog :=
|
|||
|
|
⟨eval prog, eval_mono prog⟩
|
|||
|
|
|
|||
|
|
/-- Agda: `WithProg.result`/`output` — the analysis result, printed. -/
|
|||
|
|
def output : String :=
|
|||
|
|
show' (result signFixedHeight (exprEvaluator prog).toStmtEvaluator)
|
|||
|
|
|
|||
|
|
/-- Agda: `plus-valid`. -/
|
|||
|
|
theorem plus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
|
|||
|
|
(h₁ : interpSign g₁ (.int z₁)) (h₂ : interpSign g₂ (.int z₂)) :
|
|||
|
|
interpSign (plus g₁ g₂) (.int (z₁ + z₂)) := by
|
|||
|
|
rcases g₁ with _ | _ | s₁
|
|||
|
|
· exact h₁.elim
|
|||
|
|
· rcases g₂ with _ | _ | s₂
|
|||
|
|
· exact h₂.elim
|
|||
|
|
· exact trivial
|
|||
|
|
· exact trivial
|
|||
|
|
· rcases g₂ with _ | _ | s₂
|
|||
|
|
· exact h₂.elim
|
|||
|
|
· rcases s₁ <;> exact trivial
|
|||
|
|
· rcases s₁ <;> rcases s₂ <;>
|
|||
|
|
simp only [plus, interpSign, Value.int.injEq] at h₁ h₂ ⊢ <;>
|
|||
|
|
try trivial
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₁ + n₂ + 1, by omega⟩
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
subst h₂
|
|||
|
|
exact ⟨n₁, by omega⟩
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₁ + n₂ + 1, by omega⟩
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
subst h₂
|
|||
|
|
exact ⟨n₁, by omega⟩
|
|||
|
|
· subst h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₂, by omega⟩
|
|||
|
|
· subst h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₂, by omega⟩
|
|||
|
|
· subst h₁
|
|||
|
|
subst h₂
|
|||
|
|
omega
|
|||
|
|
|
|||
|
|
/-- Agda: `minus-valid`. -/
|
|||
|
|
theorem minus_valid {g₁ g₂ : SignLattice} {z₁ z₂ : ℤ}
|
|||
|
|
(h₁ : interpSign g₁ (.int z₁)) (h₂ : interpSign g₂ (.int z₂)) :
|
|||
|
|
interpSign (minus g₁ g₂) (.int (z₁ - z₂)) := by
|
|||
|
|
rcases g₁ with _ | _ | s₁
|
|||
|
|
· exact h₁.elim
|
|||
|
|
· rcases g₂ with _ | _ | s₂
|
|||
|
|
· exact h₂.elim
|
|||
|
|
· exact trivial
|
|||
|
|
· exact trivial
|
|||
|
|
· rcases g₂ with _ | _ | s₂
|
|||
|
|
· exact h₂.elim
|
|||
|
|
· rcases s₁ <;> exact trivial
|
|||
|
|
· rcases s₁ <;> rcases s₂ <;>
|
|||
|
|
simp only [minus, interpSign, Value.int.injEq] at h₁ h₂ ⊢ <;>
|
|||
|
|
try trivial
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₁ + n₂ + 1, by omega⟩
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
subst h₂
|
|||
|
|
exact ⟨n₁, by omega⟩
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₁ + n₂ + 1, by omega⟩
|
|||
|
|
· obtain ⟨n₁, rfl⟩ := h₁
|
|||
|
|
subst h₂
|
|||
|
|
exact ⟨n₁, by omega⟩
|
|||
|
|
· subst h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₂, by omega⟩
|
|||
|
|
· subst h₁
|
|||
|
|
obtain ⟨n₂, rfl⟩ := h₂
|
|||
|
|
exact ⟨n₂, by omega⟩
|
|||
|
|
· subst h₁
|
|||
|
|
subst h₂
|
|||
|
|
omega
|
|||
|
|
|
|||
|
|
/-- Agda: `eval-valid` / `SignEvalValid`. -/
|
|||
|
|
theorem eval_valid :
|
|||
|
|
IsValidExprEvaluator (exprEvaluator prog) signInterpretation := by
|
|||
|
|
intro vs ρ e v hev
|
|||
|
|
induction hev with
|
|||
|
|
| num n =>
|
|||
|
|
intro _
|
|||
|
|
show interpSign (eval prog (.num n) vs) (.int n)
|
|||
|
|
cases n with
|
|||
|
|
| zero => rfl
|
|||
|
|
| succ n' => exact ⟨n', congrArg Value.int (by push_cast; ring)⟩
|
|||
|
|
| var x v hxv =>
|
|||
|
|
intro hvs
|
|||
|
|
show interpSign (eval prog (.var x) vs) v
|
|||
|
|
simp only [eval]
|
|||
|
|
by_cases hk : FiniteMap.MemKey x vs
|
|||
|
|
· rw [dif_pos hk]
|
|||
|
|
exact hvs _ _ (FiniteMap.locate hk).2 _ hxv
|
|||
|
|
· rw [dif_neg hk]
|
|||
|
|
exact trivial
|
|||
|
|
| add e₁ e₂ z₁ z₂ _ _ ih₁ ih₂ =>
|
|||
|
|
intro hvs
|
|||
|
|
have h₁ : interpSign (eval prog e₁ vs) (.int z₁) := ih₁ hvs
|
|||
|
|
have h₂ : interpSign (eval prog e₂ vs) (.int z₂) := ih₂ hvs
|
|||
|
|
show interpSign (eval prog (.add e₁ e₂) vs) (.int (z₁ + z₂))
|
|||
|
|
exact plus_valid h₁ h₂
|
|||
|
|
| sub e₁ e₂ z₁ z₂ _ _ ih₁ ih₂ =>
|
|||
|
|
intro hvs
|
|||
|
|
have h₁ : interpSign (eval prog e₁ vs) (.int z₁) := ih₁ hvs
|
|||
|
|
have h₂ : interpSign (eval prog e₂ vs) (.int z₂) := ih₂ hvs
|
|||
|
|
show interpSign (eval prog (.sub e₁ e₂) vs) (.int (z₁ - z₂))
|
|||
|
|
exact minus_valid h₁ h₂
|
|||
|
|
|
|||
|
|
/-- Agda: `WithProg.analyze-correct`. -/
|
|||
|
|
theorem analyze_correct {ρ : Env} (hrun : EvalStmt [] prog.rootStmt ρ) :
|
|||
|
|
interpV signInterpretation
|
|||
|
|
(variablesAt prog.finalState
|
|||
|
|
(result signFixedHeight (exprEvaluator prog).toStmtEvaluator)) ρ :=
|
|||
|
|
Spa.analyze_correct signFixedHeight
|
|||
|
|
((exprEvaluator prog).toStmtEvaluator_valid (eval_valid prog)) hrun
|
|||
|
|
|
|||
|
|
end SignAnalysis
|
|||
|
|
|
|||
|
|
end Spa
|