diff --git a/lean/Spa/Analysis/Constant.lean b/lean/Spa/Analysis/Constant.lean index 3efa702..47b1583 100644 --- a/lean/Spa/Analysis/Constant.lean +++ b/lean/Spa/Analysis/Constant.lean @@ -29,15 +29,13 @@ def minus : ConstLattice → ConstLattice → ConstLattice lemma plus_mono₂ : Monotone₂ plus := AboveBelow.monotone₂_of_strict plus - (fun y => by cases y <;> rfl) (fun x => by cases x <;> rfl) - (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl) - (fun x hx => by cases x <;> first | exact absurd rfl hx | rfl) + (fun y => by aesop) (fun x => by aesop) + (fun y hy => by aesop) (fun x hx => by aesop) lemma minus_mono₂ : Monotone₂ minus := AboveBelow.monotone₂_of_strict minus - (fun y => by cases y <;> rfl) (fun x => by cases x <;> rfl) - (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl) - (fun x hx => by cases x <;> first | exact absurd rfl hx | rfl) + (fun y => by aesop) (fun x => by aesop) + (fun y hy => by aesop) (fun x hx => by aesop) def interpConst : ConstLattice → Value → Prop | .bot, _ => False @@ -96,36 +94,14 @@ def output : String := lemma plus_valid {g₁ g₂ : ConstLattice} {z₁ z₂ : ℤ} (h₁ : ⟦g₁⟧ (.int z₁)) (h₂ : ⟦g₂⟧ (.int z₂)) : ⟦plus g₁ g₂⟧ (.int (z₁ + z₂)) := by - rcases g₁ with _ | _ | c₁ - · exact h₁.elim - · rcases g₂ with _ | _ | c₂ - · exact h₂.elim - · exact trivial - · exact trivial - · rcases g₂ with _ | _ | c₂ - · exact h₂.elim - · exact trivial - · injection h₁ with hz₁ - injection h₂ with hz₂ - show Value.int (z₁ + z₂) = Value.int (c₁ + c₂) - rw [hz₁, hz₂] + rcases g₁ with _ | _ | c₁ <;> rcases g₂ with _ | _ | c₂ <;> + simp_all [plus, constInterpretation, interpConst] lemma minus_valid {g₁ g₂ : ConstLattice} {z₁ z₂ : ℤ} (h₁ : ⟦g₁⟧ (.int z₁)) (h₂ : ⟦g₂⟧ (.int z₂)) : ⟦minus g₁ g₂⟧ (.int (z₁ - z₂)) := by - rcases g₁ with _ | _ | c₁ - · exact h₁.elim - · rcases g₂ with _ | _ | c₂ - · exact h₂.elim - · exact trivial - · exact trivial - · rcases g₂ with _ | _ | c₂ - · exact h₂.elim - · exact trivial - · injection h₁ with hz₁ - injection h₂ with hz₂ - show Value.int (z₁ - z₂) = Value.int (c₁ - c₂) - rw [hz₁, hz₂] + rcases g₁ with _ | _ | c₁ <;> rcases g₂ with _ | _ | c₂ <;> + simp_all [minus, constInterpretation, interpConst] instance eval_valid : ValidExprEvaluator ConstLattice prog := by constructor diff --git a/lean/Spa/Analysis/Sign.lean b/lean/Spa/Analysis/Sign.lean index bd91104..7cfaed8 100644 --- a/lean/Spa/Analysis/Sign.lean +++ b/lean/Spa/Analysis/Sign.lean @@ -13,6 +13,8 @@ inductive Sign where | zero deriving DecidableEq +attribute [aesop safe cases] Sign + instance : Showable Sign := ⟨fun | .plus => "+" @@ -57,21 +59,13 @@ def minus : SignLattice → SignLattice → SignLattice lemma plus_mono₂ : Monotone₂ plus := AboveBelow.monotone₂_of_strict plus - (fun y => by cases y <;> rfl) - (fun x => by rcases x with _ | _ | s <;> first | rfl | (cases s <;> rfl)) - (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl) - (fun x hx => by - rcases x with _ | _ | s <;> - first | exact absurd rfl hx | rfl | (cases s <;> rfl)) + (fun y => by aesop) (fun x => by aesop) + (fun y hy => by aesop) (fun x hx => by aesop) lemma minus_mono₂ : Monotone₂ minus := AboveBelow.monotone₂_of_strict minus - (fun y => by cases y <;> rfl) - (fun x => by rcases x with _ | _ | s <;> first | rfl | (cases s <;> rfl)) - (fun y hy => by cases y <;> first | exact absurd rfl hy | rfl) - (fun x hx => by - rcases x with _ | _ | s <;> - first | exact absurd rfl hx | rfl | (cases s <;> rfl)) + (fun y => by aesop) (fun x => by aesop) + (fun y hy => by aesop) (fun x hx => by aesop) def interpSign : SignLattice → Value → Prop | .bot, _ => False diff --git a/lean/Spa/Lattice/AboveBelow.lean b/lean/Spa/Lattice/AboveBelow.lean index c7f1f10..1148792 100644 --- a/lean/Spa/Lattice/AboveBelow.lean +++ b/lean/Spa/Lattice/AboveBelow.lean @@ -10,6 +10,8 @@ inductive AboveBelow (α : Type*) where namespace AboveBelow +attribute [aesop safe cases] AboveBelow + instance {α : Type*} [ToString α] : ToString (AboveBelow α) where toString | bot => "⊥" @@ -49,22 +51,22 @@ instance : Min (AboveBelow α) where (mk x ⊓ mk y : AboveBelow α) = if x = y then mk x else bot := rfl protected lemma sup_comm (a b : AboveBelow α) : a ⊔ b = b ⊔ a := by - rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop + aesop protected lemma sup_assoc (a b c : AboveBelow α) : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) := by - rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> rcases c with _ | _ | z <;> aesop + aesop protected lemma inf_comm (a b : AboveBelow α) : a ⊓ b = b ⊓ a := by - rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop + aesop protected lemma inf_assoc (a b c : AboveBelow α) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) := by - rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> rcases c with _ | _ | z <;> aesop + aesop protected lemma sup_inf_self (a b : AboveBelow α) : a ⊔ a ⊓ b = a := by - rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop + aesop protected lemma inf_sup_self (a b : AboveBelow α) : a ⊓ (a ⊔ b) = a := by - rcases a with _ | _ | x <;> rcases b with _ | _ | y <;> aesop + aesop instance : Lattice (AboveBelow α) := Lattice.mk' AboveBelow.sup_comm AboveBelow.sup_assoc @@ -189,13 +191,7 @@ def rank : AboveBelow α → ℕ lemma not_mk_lt_mk (x y : α) : ¬(mk x : AboveBelow α) < mk y := by intro h obtain ⟨hle, hne⟩ := lt_iff_le_and_ne.mp h - have hsup := le_iff.mp hle - rw [mk_sup_mk] at hsup - by_cases hxy : x = y - · rw [if_pos hxy] at hsup - exact hne hsup - · rw [if_neg hxy] at hsup - exact absurd hsup (by simp) + rcases le_cases hle with h | h | h <;> simp_all lemma rank_strictMono : StrictMono (rank : AboveBelow α → ℕ) := by intro a b hab