mirror of
https://github.com/leanprover/lean4.git
synced 2026-03-18 19:04:07 +00:00
Compare commits
3 Commits
simproc_st
...
replace
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
54de6271fd | ||
|
|
eb7951e872 | ||
|
|
e601cdb193 |
@@ -17,7 +17,6 @@
|
||||
/src/Lean/Meta/Tactic/ @leodemoura
|
||||
/src/Lean/Parser/ @Kha
|
||||
/src/Lean/PrettyPrinter/ @Kha
|
||||
/src/Lean/PrettyPrinter/Delaborator/ @kmill
|
||||
/src/Lean/Server/ @mhuisi
|
||||
/src/Lean/Widget/ @Vtec234
|
||||
/src/runtime/io.cpp @joehendrix
|
||||
|
||||
@@ -11,13 +11,6 @@ of each version.
|
||||
v4.7.0 (development in progress)
|
||||
---------
|
||||
|
||||
* When the `pp.proofs` is false, now omitted proofs use `⋯` rather than `_`,
|
||||
which gives a more helpful error message when copied from the Infoview.
|
||||
The `pp.proofs.threshold` option lets small proofs always be pretty printed.
|
||||
[#3241](https://github.com/leanprover/lean4/pull/3241).
|
||||
|
||||
* `pp.proofs.withType` is now set to false by default to reduce noise in the info view.
|
||||
|
||||
v4.6.0
|
||||
---------
|
||||
|
||||
|
||||
@@ -282,7 +282,7 @@ theorem BinTree.find_insert_of_ne (b : BinTree β) (h : k ≠ k') (v : β)
|
||||
let ⟨t, h⟩ := b; simp
|
||||
induction t with simp
|
||||
| leaf =>
|
||||
intros
|
||||
split <;> (try simp) <;> split <;> (try simp)
|
||||
have_eq k k'
|
||||
contradiction
|
||||
| node left key value right ihl ihr =>
|
||||
|
||||
@@ -8,7 +8,6 @@ import Init.Prelude
|
||||
import Init.Notation
|
||||
import Init.Tactics
|
||||
import Init.TacticsExtra
|
||||
import Init.ByCases
|
||||
import Init.RCases
|
||||
import Init.Core
|
||||
import Init.Control
|
||||
@@ -24,11 +23,8 @@ import Init.MetaTypes
|
||||
import Init.Meta
|
||||
import Init.NotationExtra
|
||||
import Init.SimpLemmas
|
||||
import Init.PropLemmas
|
||||
import Init.Hints
|
||||
import Init.Conv
|
||||
import Init.Guard
|
||||
import Init.Simproc
|
||||
import Init.SizeOfLemmas
|
||||
import Init.BinderPredicates
|
||||
import Init.Ext
|
||||
|
||||
@@ -1,82 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner
|
||||
-/
|
||||
prelude
|
||||
import Init.NotationExtra
|
||||
|
||||
namespace Lean
|
||||
|
||||
/--
|
||||
The syntax category of binder predicates contains predicates like `> 0`, `∈ s`, etc.
|
||||
(`: t` should not be a binder predicate because it would clash with the built-in syntax for ∀/∃.)
|
||||
-/
|
||||
declare_syntax_cat binderPred
|
||||
|
||||
/--
|
||||
`satisfies_binder_pred% t pred` expands to a proposition expressing that `t` satisfies `pred`.
|
||||
-/
|
||||
syntax "satisfies_binder_pred% " term:max binderPred : term
|
||||
|
||||
-- Extend ∀ and ∃ to binder predicates.
|
||||
|
||||
/--
|
||||
The notation `∃ x < 2, p x` is shorthand for `∃ x, x < 2 ∧ p x`,
|
||||
and similarly for other binary operators.
|
||||
-/
|
||||
syntax "∃ " binderIdent binderPred ", " term : term
|
||||
/--
|
||||
The notation `∀ x < 2, p x` is shorthand for `∀ x, x < 2 → p x`,
|
||||
and similarly for other binary operators.
|
||||
-/
|
||||
syntax "∀ " binderIdent binderPred ", " term : term
|
||||
|
||||
macro_rules
|
||||
| `(∃ $x:ident $pred:binderPred, $p) =>
|
||||
`(∃ $x:ident, satisfies_binder_pred% $x $pred ∧ $p)
|
||||
| `(∃ _ $pred:binderPred, $p) =>
|
||||
`(∃ x, satisfies_binder_pred% x $pred ∧ $p)
|
||||
|
||||
macro_rules
|
||||
| `(∀ $x:ident $pred:binderPred, $p) =>
|
||||
`(∀ $x:ident, satisfies_binder_pred% $x $pred → $p)
|
||||
| `(∀ _ $pred:binderPred, $p) =>
|
||||
`(∀ x, satisfies_binder_pred% x $pred → $p)
|
||||
|
||||
/-- Declare `∃ x > y, ...` as syntax for `∃ x, x > y ∧ ...` -/
|
||||
binder_predicate x " > " y:term => `($x > $y)
|
||||
/-- Declare `∃ x ≥ y, ...` as syntax for `∃ x, x ≥ y ∧ ...` -/
|
||||
binder_predicate x " ≥ " y:term => `($x ≥ $y)
|
||||
/-- Declare `∃ x < y, ...` as syntax for `∃ x, x < y ∧ ...` -/
|
||||
binder_predicate x " < " y:term => `($x < $y)
|
||||
/-- Declare `∃ x ≤ y, ...` as syntax for `∃ x, x ≤ y ∧ ...` -/
|
||||
binder_predicate x " ≤ " y:term => `($x ≤ $y)
|
||||
/-- Declare `∃ x ≠ y, ...` as syntax for `∃ x, x ≠ y ∧ ...` -/
|
||||
binder_predicate x " ≠ " y:term => `($x ≠ $y)
|
||||
|
||||
/-- Declare `∀ x ∈ y, ...` as syntax for `∀ x, x ∈ y → ...` and `∃ x ∈ y, ...` as syntax for
|
||||
`∃ x, x ∈ y ∧ ...` -/
|
||||
binder_predicate x " ∈ " y:term => `($x ∈ $y)
|
||||
|
||||
/-- Declare `∀ x ∉ y, ...` as syntax for `∀ x, x ∉ y → ...` and `∃ x ∉ y, ...` as syntax for
|
||||
`∃ x, x ∉ y ∧ ...` -/
|
||||
binder_predicate x " ∉ " y:term => `($x ∉ $y)
|
||||
|
||||
/-- Declare `∀ x ⊆ y, ...` as syntax for `∀ x, x ⊆ y → ...` and `∃ x ⊆ y, ...` as syntax for
|
||||
`∃ x, x ⊆ y ∧ ...` -/
|
||||
binder_predicate x " ⊆ " y:term => `($x ⊆ $y)
|
||||
|
||||
/-- Declare `∀ x ⊂ y, ...` as syntax for `∀ x, x ⊂ y → ...` and `∃ x ⊂ y, ...` as syntax for
|
||||
`∃ x, x ⊂ y ∧ ...` -/
|
||||
binder_predicate x " ⊂ " y:term => `($x ⊂ $y)
|
||||
|
||||
/-- Declare `∀ x ⊇ y, ...` as syntax for `∀ x, x ⊇ y → ...` and `∃ x ⊇ y, ...` as syntax for
|
||||
`∃ x, x ⊇ y ∧ ...` -/
|
||||
binder_predicate x " ⊇ " y:term => `($x ⊇ $y)
|
||||
|
||||
/-- Declare `∀ x ⊃ y, ...` as syntax for `∀ x, x ⊃ y → ...` and `∃ x ⊃ y, ...` as syntax for
|
||||
`∃ x, x ⊃ y ∧ ...` -/
|
||||
binder_predicate x " ⊃ " y:term => `($x ⊃ $y)
|
||||
|
||||
end Lean
|
||||
@@ -1,74 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Classical
|
||||
|
||||
/-! # by_cases tactic and if-then-else support -/
|
||||
|
||||
/--
|
||||
`by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, and `h : ¬ p` in the second branch.
|
||||
-/
|
||||
syntax "by_cases " (atomic(ident " : "))? term : tactic
|
||||
|
||||
macro_rules
|
||||
| `(tactic| by_cases $e) => `(tactic| by_cases h : $e)
|
||||
macro_rules
|
||||
| `(tactic| by_cases $h : $e) =>
|
||||
`(tactic| open Classical in refine if $h:ident : $e then ?pos else ?neg)
|
||||
|
||||
/-! ## if-then-else -/
|
||||
|
||||
@[simp] theorem if_true {h : Decidable True} (t e : α) : ite True t e = t := if_pos trivial
|
||||
|
||||
@[simp] theorem if_false {h : Decidable False} (t e : α) : ite False t e = e := if_neg id
|
||||
|
||||
theorem ite_id [Decidable c] {α} (t : α) : (if c then t else t) = t := by split <;> rfl
|
||||
|
||||
/-- A function applied to a `dite` is a `dite` of that function applied to each of the branches. -/
|
||||
theorem apply_dite (f : α → β) (P : Prop) [Decidable P] (x : P → α) (y : ¬P → α) :
|
||||
f (dite P x y) = dite P (fun h => f (x h)) (fun h => f (y h)) := by
|
||||
by_cases h : P <;> simp [h]
|
||||
|
||||
/-- A function applied to a `ite` is a `ite` of that function applied to each of the branches. -/
|
||||
theorem apply_ite (f : α → β) (P : Prop) [Decidable P] (x y : α) :
|
||||
f (ite P x y) = ite P (f x) (f y) :=
|
||||
apply_dite f P (fun _ => x) (fun _ => y)
|
||||
|
||||
/-- Negation of the condition `P : Prop` in a `dite` is the same as swapping the branches. -/
|
||||
@[simp] theorem dite_not (P : Prop) {_ : Decidable P} (x : ¬P → α) (y : ¬¬P → α) :
|
||||
dite (¬P) x y = dite P (fun h => y (not_not_intro h)) x := by
|
||||
by_cases h : P <;> simp [h]
|
||||
|
||||
/-- Negation of the condition `P : Prop` in a `ite` is the same as swapping the branches. -/
|
||||
@[simp] theorem ite_not (P : Prop) {_ : Decidable P} (x y : α) : ite (¬P) x y = ite P y x :=
|
||||
dite_not P (fun _ => x) (fun _ => y)
|
||||
|
||||
@[simp] theorem dite_eq_left_iff {P : Prop} [Decidable P] {B : ¬ P → α} :
|
||||
dite P (fun _ => a) B = a ↔ ∀ h, B h = a := by
|
||||
by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false]
|
||||
|
||||
@[simp] theorem dite_eq_right_iff {P : Prop} [Decidable P] {A : P → α} :
|
||||
(dite P A fun _ => b) = b ↔ ∀ h, A h = b := by
|
||||
by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false]
|
||||
|
||||
@[simp] theorem ite_eq_left_iff {P : Prop} [Decidable P] : ite P a b = a ↔ ¬P → b = a :=
|
||||
dite_eq_left_iff
|
||||
|
||||
@[simp] theorem ite_eq_right_iff {P : Prop} [Decidable P] : ite P a b = b ↔ P → a = b :=
|
||||
dite_eq_right_iff
|
||||
|
||||
/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/
|
||||
@[simp] theorem dite_eq_ite [Decidable P] : (dite P (fun _ => a) fun _ => b) = ite P a b := rfl
|
||||
|
||||
-- We don't mark this as `simp` as it is already handled by `ite_eq_right_iff`.
|
||||
theorem ite_some_none_eq_none [Decidable P] :
|
||||
(if P then some x else none) = none ↔ ¬ P := by
|
||||
simp only [ite_eq_right_iff]
|
||||
rfl
|
||||
|
||||
@[simp] theorem ite_some_none_eq_some [Decidable P] :
|
||||
(if P then some x else none) = some y ↔ P ∧ x = y := by
|
||||
split <;> simp_all
|
||||
@@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.PropLemmas
|
||||
import Init.Core
|
||||
import Init.NotationExtra
|
||||
|
||||
universe u v
|
||||
|
||||
@@ -111,8 +112,8 @@ theorem skolem {α : Sort u} {b : α → Sort v} {p : ∀ x, b x → Prop} : (
|
||||
|
||||
theorem propComplete (a : Prop) : a = True ∨ a = False :=
|
||||
match em a with
|
||||
| Or.inl ha => Or.inl (eq_true ha)
|
||||
| Or.inr hn => Or.inr (eq_false hn)
|
||||
| Or.inl ha => Or.inl (propext (Iff.intro (fun _ => ⟨⟩) (fun _ => ha)))
|
||||
| Or.inr hn => Or.inr (propext (Iff.intro (fun h => hn h) (fun h => False.elim h)))
|
||||
|
||||
-- this supercedes byCases in Decidable
|
||||
theorem byCases {p q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
|
||||
@@ -122,36 +123,15 @@ theorem byCases {p q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
|
||||
theorem byContradiction {p : Prop} (h : ¬p → False) : p :=
|
||||
Decidable.byContradiction (dec := propDecidable _) h
|
||||
|
||||
/-- The Double Negation Theorem: `¬¬P` is equivalent to `P`.
|
||||
The left-to-right direction, double negation elimination (DNE),
|
||||
is classically true but not constructively. -/
|
||||
@[scoped simp] theorem not_not : ¬¬a ↔ a := Decidable.not_not
|
||||
|
||||
@[simp] theorem not_forall {p : α → Prop} : (¬∀ x, p x) ↔ ∃ x, ¬p x := Decidable.not_forall
|
||||
|
||||
theorem not_forall_not {p : α → Prop} : (¬∀ x, ¬p x) ↔ ∃ x, p x := Decidable.not_forall_not
|
||||
theorem not_exists_not {p : α → Prop} : (¬∃ x, ¬p x) ↔ ∀ x, p x := Decidable.not_exists_not
|
||||
|
||||
theorem forall_or_exists_not (P : α → Prop) : (∀ a, P a) ∨ ∃ a, ¬ P a := by
|
||||
rw [← not_forall]; exact em _
|
||||
|
||||
theorem exists_or_forall_not (P : α → Prop) : (∃ a, P a) ∨ ∀ a, ¬ P a := by
|
||||
rw [← not_exists]; exact em _
|
||||
|
||||
theorem or_iff_not_imp_left : a ∨ b ↔ (¬a → b) := Decidable.or_iff_not_imp_left
|
||||
theorem or_iff_not_imp_right : a ∨ b ↔ (¬b → a) := Decidable.or_iff_not_imp_right
|
||||
|
||||
theorem not_imp_iff_and_not : ¬(a → b) ↔ a ∧ ¬b := Decidable.not_imp_iff_and_not
|
||||
|
||||
theorem not_and_iff_or_not_not : ¬(a ∧ b) ↔ ¬a ∨ ¬b := Decidable.not_and_iff_or_not_not
|
||||
|
||||
theorem not_iff : ¬(a ↔ b) ↔ (¬a ↔ b) := Decidable.not_iff
|
||||
|
||||
end Classical
|
||||
|
||||
/-- Extract an element from a existential statement, using `Classical.choose`. -/
|
||||
-- This enables projection notation.
|
||||
@[reducible] noncomputable def Exists.choose {p : α → Prop} (P : ∃ a, p a) : α := Classical.choose P
|
||||
/--
|
||||
`by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, and `h : ¬ p` in the second branch.
|
||||
-/
|
||||
syntax "by_cases " (atomic(ident " : "))? term : tactic
|
||||
|
||||
/-- Show that an element extracted from `P : ∃ a, p a` using `P.choose` satisfies `p`. -/
|
||||
theorem Exists.choose_spec {p : α → Prop} (P : ∃ a, p a) : p P.choose := Classical.choose_spec P
|
||||
macro_rules
|
||||
| `(tactic| by_cases $e) => `(tactic| by_cases h : $e)
|
||||
macro_rules
|
||||
| `(tactic| by_cases $h : $e) =>
|
||||
`(tactic| open Classical in refine if $h:ident : $e then ?pos else ?neg)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Ullrich, Leonardo de Moura, Mario Carneiro
|
||||
Authors: Sebastian Ullrich, Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.SimpLemmas
|
||||
@@ -84,36 +84,6 @@ theorem seqRight_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x *>
|
||||
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
|
||||
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
|
||||
|
||||
/--
|
||||
An alternative constructor for `LawfulMonad` which has more
|
||||
defaultable fields in the common case.
|
||||
-/
|
||||
theorem LawfulMonad.mk' (m : Type u → Type v) [Monad m]
|
||||
(id_map : ∀ {α} (x : m α), id <$> x = x)
|
||||
(pure_bind : ∀ {α β} (x : α) (f : α → m β), pure x >>= f = f x)
|
||||
(bind_assoc : ∀ {α β γ} (x : m α) (f : α → m β) (g : β → m γ),
|
||||
x >>= f >>= g = x >>= fun x => f x >>= g)
|
||||
(map_const : ∀ {α β} (x : α) (y : m β),
|
||||
Functor.mapConst x y = Function.const β x <$> y := by intros; rfl)
|
||||
(seqLeft_eq : ∀ {α β} (x : m α) (y : m β),
|
||||
x <* y = (x >>= fun a => y >>= fun _ => pure a) := by intros; rfl)
|
||||
(seqRight_eq : ∀ {α β} (x : m α) (y : m β), x *> y = (x >>= fun _ => y) := by intros; rfl)
|
||||
(bind_pure_comp : ∀ {α β} (f : α → β) (x : m α),
|
||||
x >>= (fun y => pure (f y)) = f <$> x := by intros; rfl)
|
||||
(bind_map : ∀ {α β} (f : m (α → β)) (x : m α), f >>= (. <$> x) = f <*> x := by intros; rfl)
|
||||
: LawfulMonad m :=
|
||||
have map_pure {α β} (g : α → β) (x : α) : g <$> (pure x : m α) = pure (g x) := by
|
||||
rw [← bind_pure_comp]; simp [pure_bind]
|
||||
{ id_map, bind_pure_comp, bind_map, pure_bind, bind_assoc, map_pure,
|
||||
comp_map := by simp [← bind_pure_comp, bind_assoc, pure_bind]
|
||||
pure_seq := by intros; rw [← bind_map]; simp [pure_bind]
|
||||
seq_pure := by intros; rw [← bind_map]; simp [map_pure, bind_pure_comp]
|
||||
seq_assoc := by simp [← bind_pure_comp, ← bind_map, bind_assoc, pure_bind]
|
||||
map_const := funext fun x => funext (map_const x)
|
||||
seqLeft_eq := by simp [seqLeft_eq, ← bind_map, ← bind_pure_comp, pure_bind, bind_assoc]
|
||||
seqRight_eq := fun x y => by
|
||||
rw [seqRight_eq, ← bind_map, ← bind_pure_comp, bind_assoc]; simp [pure_bind, id_map] }
|
||||
|
||||
/-! # Id -/
|
||||
|
||||
namespace Id
|
||||
@@ -203,16 +173,6 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (ExceptT ε m) where
|
||||
|
||||
end ExceptT
|
||||
|
||||
/-! # Except -/
|
||||
|
||||
instance : LawfulMonad (Except ε) := LawfulMonad.mk'
|
||||
(id_map := fun x => by cases x <;> rfl)
|
||||
(pure_bind := fun a f => rfl)
|
||||
(bind_assoc := fun a f g => by cases a <;> rfl)
|
||||
|
||||
instance : LawfulApplicative (Except ε) := inferInstance
|
||||
instance : LawfulFunctor (Except ε) := inferInstance
|
||||
|
||||
/-! # ReaderT -/
|
||||
|
||||
namespace ReaderT
|
||||
@@ -347,30 +307,3 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
|
||||
bind_assoc := by intros; apply ext; intros; simp
|
||||
|
||||
end StateT
|
||||
|
||||
/-! # EStateM -/
|
||||
|
||||
instance : LawfulMonad (EStateM ε σ) := .mk'
|
||||
(id_map := fun x => funext <| fun s => by
|
||||
dsimp only [EStateM.instMonadEStateM, EStateM.map]
|
||||
match x s with
|
||||
| .ok _ _ => rfl
|
||||
| .error _ _ => rfl)
|
||||
(pure_bind := fun _ _ => rfl)
|
||||
(bind_assoc := fun x _ _ => funext <| fun s => by
|
||||
dsimp only [EStateM.instMonadEStateM, EStateM.bind]
|
||||
match x s with
|
||||
| .ok _ _ => rfl
|
||||
| .error _ _ => rfl)
|
||||
(map_const := fun _ _ => rfl)
|
||||
|
||||
/-! # Option -/
|
||||
|
||||
instance : LawfulMonad Option := LawfulMonad.mk'
|
||||
(id_map := fun x => by cases x <;> rfl)
|
||||
(pure_bind := fun x f => rfl)
|
||||
(bind_assoc := fun x f g => by cases x <;> rfl)
|
||||
(bind_pure_comp := fun f x => by cases x <;> rfl)
|
||||
|
||||
instance : LawfulApplicative Option := inferInstance
|
||||
instance : LawfulFunctor Option := inferInstance
|
||||
|
||||
@@ -17,9 +17,7 @@ universe u v w
|
||||
at the application site itself (by comparison to the `@[inline]` attribute,
|
||||
which applies to all applications of the function).
|
||||
-/
|
||||
@[simp] def inline {α : Sort u} (a : α) : α := a
|
||||
|
||||
theorem id.def {α : Sort u} (a : α) : id a = a := rfl
|
||||
def inline {α : Sort u} (a : α) : α := a
|
||||
|
||||
/--
|
||||
`flip f a b` is `f b a`. It is useful for "point-free" programming,
|
||||
@@ -34,32 +32,8 @@ and `flip (·<·)` is the greater-than relation.
|
||||
|
||||
@[simp] theorem Function.comp_apply {f : β → δ} {g : α → β} {x : α} : comp f g x = f (g x) := rfl
|
||||
|
||||
theorem Function.comp_def {α β δ} (f : β → δ) (g : α → β) : f ∘ g = fun x => f (g x) := rfl
|
||||
|
||||
attribute [simp] namedPattern
|
||||
|
||||
/--
|
||||
`Empty.elim : Empty → C` says that a value of any type can be constructed from
|
||||
`Empty`. This can be thought of as a compiler-checked assertion that a code path is unreachable.
|
||||
|
||||
This is a non-dependent variant of `Empty.rec`.
|
||||
-/
|
||||
@[macro_inline] def Empty.elim {C : Sort u} : Empty → C := Empty.rec
|
||||
|
||||
/-- Decidable equality for Empty -/
|
||||
instance : DecidableEq Empty := fun a => a.elim
|
||||
|
||||
/--
|
||||
`PEmpty.elim : Empty → C` says that a value of any type can be constructed from
|
||||
`PEmpty`. This can be thought of as a compiler-checked assertion that a code path is unreachable.
|
||||
|
||||
This is a non-dependent variant of `PEmpty.rec`.
|
||||
-/
|
||||
@[macro_inline] def PEmpty.elim {C : Sort _} : PEmpty → C := fun a => nomatch a
|
||||
|
||||
/-- Decidable equality for PEmpty -/
|
||||
instance : DecidableEq PEmpty := fun a => a.elim
|
||||
|
||||
/--
|
||||
Thunks are "lazy" values that are evaluated when first accessed using `Thunk.get/map/bind`.
|
||||
The value is then stored and not recomputed for all further accesses. -/
|
||||
@@ -104,8 +78,6 @@ instance thunkCoe : CoeTail α (Thunk α) where
|
||||
abbrev Eq.ndrecOn.{u1, u2} {α : Sort u2} {a : α} {motive : α → Sort u1} {b : α} (h : a = b) (m : motive a) : motive b :=
|
||||
Eq.ndrec m h
|
||||
|
||||
/-! # definitions -/
|
||||
|
||||
/--
|
||||
If and only if, or logical bi-implication. `a ↔ b` means that `a` implies `b` and vice versa.
|
||||
By `propext`, this implies that `a` and `b` are equal and hence any expression involving `a`
|
||||
@@ -154,10 +126,6 @@ inductive PSum (α : Sort u) (β : Sort v) where
|
||||
|
||||
@[inherit_doc] infixr:30 " ⊕' " => PSum
|
||||
|
||||
instance {α β} [Inhabited α] : Inhabited (PSum α β) := ⟨PSum.inl default⟩
|
||||
|
||||
instance {α β} [Inhabited β] : Inhabited (PSum α β) := ⟨PSum.inr default⟩
|
||||
|
||||
/--
|
||||
`Sigma β`, also denoted `Σ a : α, β a` or `(a : α) × β a`, is the type of dependent pairs
|
||||
whose first component is `a : α` and whose second component is `b : β a`
|
||||
@@ -374,70 +342,6 @@ class HasEquiv (α : Sort u) where
|
||||
|
||||
@[inherit_doc] infix:50 " ≈ " => HasEquiv.Equiv
|
||||
|
||||
/-! # set notation -/
|
||||
|
||||
/-- Notation type class for the subset relation `⊆`. -/
|
||||
class HasSubset (α : Type u) where
|
||||
/-- Subset relation: `a ⊆ b` -/
|
||||
Subset : α → α → Prop
|
||||
export HasSubset (Subset)
|
||||
|
||||
/-- Notation type class for the strict subset relation `⊂`. -/
|
||||
class HasSSubset (α : Type u) where
|
||||
/-- Strict subset relation: `a ⊂ b` -/
|
||||
SSubset : α → α → Prop
|
||||
export HasSSubset (SSubset)
|
||||
|
||||
/-- Superset relation: `a ⊇ b` -/
|
||||
abbrev Superset [HasSubset α] (a b : α) := Subset b a
|
||||
|
||||
/-- Strict superset relation: `a ⊃ b` -/
|
||||
abbrev SSuperset [HasSSubset α] (a b : α) := SSubset b a
|
||||
|
||||
/-- Notation type class for the union operation `∪`. -/
|
||||
class Union (α : Type u) where
|
||||
/-- `a ∪ b` is the union of`a` and `b`. -/
|
||||
union : α → α → α
|
||||
|
||||
/-- Notation type class for the intersection operation `∩`. -/
|
||||
class Inter (α : Type u) where
|
||||
/-- `a ∩ b` is the intersection of`a` and `b`. -/
|
||||
inter : α → α → α
|
||||
|
||||
/-- Notation type class for the set difference `\`. -/
|
||||
class SDiff (α : Type u) where
|
||||
/--
|
||||
`a \ b` is the set difference of `a` and `b`,
|
||||
consisting of all elements in `a` that are not in `b`.
|
||||
-/
|
||||
sdiff : α → α → α
|
||||
|
||||
/-- Subset relation: `a ⊆ b` -/
|
||||
infix:50 " ⊆ " => Subset
|
||||
|
||||
/-- Strict subset relation: `a ⊂ b` -/
|
||||
infix:50 " ⊂ " => SSubset
|
||||
|
||||
/-- Superset relation: `a ⊇ b` -/
|
||||
infix:50 " ⊇ " => Superset
|
||||
|
||||
/-- Strict superset relation: `a ⊃ b` -/
|
||||
infix:50 " ⊃ " => SSuperset
|
||||
|
||||
/-- `a ∪ b` is the union of`a` and `b`. -/
|
||||
infixl:65 " ∪ " => Union.union
|
||||
|
||||
/-- `a ∩ b` is the intersection of`a` and `b`. -/
|
||||
infixl:70 " ∩ " => Inter.inter
|
||||
|
||||
/--
|
||||
`a \ b` is the set difference of `a` and `b`,
|
||||
consisting of all elements in `a` that are not in `b`.
|
||||
-/
|
||||
infix:70 " \\ " => SDiff.sdiff
|
||||
|
||||
/-! # collections -/
|
||||
|
||||
/-- `EmptyCollection α` is the typeclass which supports the notation `∅`, also written as `{}`. -/
|
||||
class EmptyCollection (α : Type u) where
|
||||
/-- `∅` or `{}` is the empty set or empty collection.
|
||||
@@ -447,36 +351,6 @@ class EmptyCollection (α : Type u) where
|
||||
@[inherit_doc] notation "{" "}" => EmptyCollection.emptyCollection
|
||||
@[inherit_doc] notation "∅" => EmptyCollection.emptyCollection
|
||||
|
||||
/--
|
||||
Type class for the `insert` operation.
|
||||
Used to implement the `{ a, b, c }` syntax.
|
||||
-/
|
||||
class Insert (α : outParam <| Type u) (γ : Type v) where
|
||||
/-- `insert x xs` inserts the element `x` into the collection `xs`. -/
|
||||
insert : α → γ → γ
|
||||
export Insert (insert)
|
||||
|
||||
/--
|
||||
Type class for the `singleton` operation.
|
||||
Used to implement the `{ a, b, c }` syntax.
|
||||
-/
|
||||
class Singleton (α : outParam <| Type u) (β : Type v) where
|
||||
/-- `singleton x` is a collection with the single element `x` (notation: `{x}`). -/
|
||||
singleton : α → β
|
||||
export Singleton (singleton)
|
||||
|
||||
/-- `insert x ∅ = {x}` -/
|
||||
class IsLawfulSingleton (α : Type u) (β : Type v) [EmptyCollection β] [Insert α β] [Singleton α β] :
|
||||
Prop where
|
||||
/-- `insert x ∅ = {x}` -/
|
||||
insert_emptyc_eq (x : α) : (insert x ∅ : β) = singleton x
|
||||
export IsLawfulSingleton (insert_emptyc_eq)
|
||||
|
||||
/-- Type class used to implement the notation `{ a ∈ c | p a }` -/
|
||||
class Sep (α : outParam <| Type u) (γ : Type v) where
|
||||
/-- Computes `{ a ∈ c | p a }`. -/
|
||||
sep : (α → Prop) → γ → γ
|
||||
|
||||
/--
|
||||
`Task α` is a primitive for asynchronous computation.
|
||||
It represents a computation that will resolve to a value of type `α`,
|
||||
@@ -651,7 +525,9 @@ theorem not_not_intro {p : Prop} (h : p) : ¬ ¬ p :=
|
||||
fun hn : ¬ p => hn h
|
||||
|
||||
-- proof irrelevance is built in
|
||||
theorem proof_irrel {a : Prop} (h₁ h₂ : a) : h₁ = h₂ := rfl
|
||||
theorem proofIrrel {a : Prop} (h₁ h₂ : a) : h₁ = h₂ := rfl
|
||||
|
||||
theorem id.def {α : Sort u} (a : α) : id a = a := rfl
|
||||
|
||||
/--
|
||||
If `h : α = β` is a proof of type equality, then `h.mp : α → β` is the induced
|
||||
@@ -699,9 +575,8 @@ theorem Ne.elim (h : a ≠ b) : a = b → False := h
|
||||
|
||||
theorem Ne.irrefl (h : a ≠ a) : False := h rfl
|
||||
|
||||
theorem Ne.symm (h : a ≠ b) : b ≠ a := fun h₁ => h (h₁.symm)
|
||||
|
||||
theorem ne_comm {α} {a b : α} : a ≠ b ↔ b ≠ a := ⟨Ne.symm, Ne.symm⟩
|
||||
theorem Ne.symm (h : a ≠ b) : b ≠ a :=
|
||||
fun h₁ => h (h₁.symm)
|
||||
|
||||
theorem false_of_ne : a ≠ a → False := Ne.irrefl
|
||||
|
||||
@@ -713,8 +588,8 @@ theorem ne_true_of_not : ¬p → p ≠ True :=
|
||||
have : ¬True := h ▸ hnp
|
||||
this trivial
|
||||
|
||||
theorem true_ne_false : ¬True = False := ne_false_of_self trivial
|
||||
theorem false_ne_true : False ≠ True := fun h => h.symm ▸ trivial
|
||||
theorem true_ne_false : ¬True = False :=
|
||||
ne_false_of_self trivial
|
||||
|
||||
end Ne
|
||||
|
||||
@@ -793,29 +668,22 @@ protected theorem Iff.rfl {a : Prop} : a ↔ a :=
|
||||
|
||||
macro_rules | `(tactic| rfl) => `(tactic| exact Iff.rfl)
|
||||
|
||||
theorem Iff.of_eq (h : a = b) : a ↔ b := h ▸ Iff.rfl
|
||||
|
||||
theorem Iff.trans (h₁ : a ↔ b) (h₂ : b ↔ c) : a ↔ c :=
|
||||
Iff.intro (h₂.mp ∘ h₁.mp) (h₁.mpr ∘ h₂.mpr)
|
||||
Iff.intro
|
||||
(fun ha => Iff.mp h₂ (Iff.mp h₁ ha))
|
||||
(fun hc => Iff.mpr h₁ (Iff.mpr h₂ hc))
|
||||
|
||||
-- This is needed for `calc` to work with `iff`.
|
||||
instance : Trans Iff Iff Iff where
|
||||
trans := Iff.trans
|
||||
theorem Iff.symm (h : a ↔ b) : b ↔ a :=
|
||||
Iff.intro (Iff.mpr h) (Iff.mp h)
|
||||
|
||||
theorem Eq.comm {a b : α} : a = b ↔ b = a := Iff.intro Eq.symm Eq.symm
|
||||
theorem eq_comm {a b : α} : a = b ↔ b = a := Eq.comm
|
||||
theorem Iff.comm : (a ↔ b) ↔ (b ↔ a) :=
|
||||
Iff.intro Iff.symm Iff.symm
|
||||
|
||||
theorem Iff.symm (h : a ↔ b) : b ↔ a := Iff.intro h.mpr h.mp
|
||||
theorem Iff.comm: (a ↔ b) ↔ (b ↔ a) := Iff.intro Iff.symm Iff.symm
|
||||
theorem iff_comm : (a ↔ b) ↔ (b ↔ a) := Iff.comm
|
||||
theorem Iff.of_eq (h : a = b) : a ↔ b :=
|
||||
h ▸ Iff.refl _
|
||||
|
||||
theorem And.symm : a ∧ b → b ∧ a := fun ⟨ha, hb⟩ => ⟨hb, ha⟩
|
||||
theorem And.comm : a ∧ b ↔ b ∧ a := Iff.intro And.symm And.symm
|
||||
theorem and_comm : a ∧ b ↔ b ∧ a := And.comm
|
||||
|
||||
theorem Or.symm : a ∨ b → b ∨ a := .rec .inr .inl
|
||||
theorem Or.comm : a ∨ b ↔ b ∨ a := Iff.intro Or.symm Or.symm
|
||||
theorem or_comm : a ∨ b ↔ b ∨ a := Or.comm
|
||||
theorem And.comm : a ∧ b ↔ b ∧ a := by
|
||||
constructor <;> intro ⟨h₁, h₂⟩ <;> exact ⟨h₂, h₁⟩
|
||||
|
||||
/-! # Exists -/
|
||||
|
||||
@@ -1015,13 +883,8 @@ protected theorem Subsingleton.helim {α β : Sort u} [h₁ : Subsingleton α] (
|
||||
apply heq_of_eq
|
||||
apply Subsingleton.elim
|
||||
|
||||
instance (p : Prop) : Subsingleton p := ⟨fun a b => proof_irrel a b⟩
|
||||
|
||||
instance : Subsingleton Empty := ⟨(·.elim)⟩
|
||||
instance : Subsingleton PEmpty := ⟨(·.elim)⟩
|
||||
|
||||
instance [Subsingleton α] [Subsingleton β] : Subsingleton (α × β) :=
|
||||
⟨fun {..} {..} => by congr <;> apply Subsingleton.elim⟩
|
||||
instance (p : Prop) : Subsingleton p :=
|
||||
⟨fun a b => proofIrrel a b⟩
|
||||
|
||||
instance (p : Prop) : Subsingleton (Decidable p) :=
|
||||
Subsingleton.intro fun
|
||||
@@ -1032,9 +895,6 @@ instance (p : Prop) : Subsingleton (Decidable p) :=
|
||||
| isTrue t₂ => absurd t₂ f₁
|
||||
| isFalse _ => rfl
|
||||
|
||||
example [Subsingleton α] (p : α → Prop) : Subsingleton (Subtype p) :=
|
||||
⟨fun ⟨x, _⟩ ⟨y, _⟩ => by congr; exact Subsingleton.elim x y⟩
|
||||
|
||||
theorem recSubsingleton
|
||||
{p : Prop} [h : Decidable p]
|
||||
{h₁ : p → Sort u}
|
||||
@@ -1314,117 +1174,12 @@ gen_injective_theorems% Lean.Syntax
|
||||
@[simp] theorem beq_iff_eq [BEq α] [LawfulBEq α] (a b : α) : a == b ↔ a = b :=
|
||||
⟨eq_of_beq, by intro h; subst h; exact LawfulBEq.rfl⟩
|
||||
|
||||
/-! # Prop lemmas -/
|
||||
|
||||
/-- *Ex falso* for negation: from `¬a` and `a` anything follows. This is the same as `absurd` with
|
||||
the arguments flipped, but it is in the `Not` namespace so that projection notation can be used. -/
|
||||
def Not.elim {α : Sort _} (H1 : ¬a) (H2 : a) : α := absurd H2 H1
|
||||
|
||||
/-- Non-dependent eliminator for `And`. -/
|
||||
abbrev And.elim (f : a → b → α) (h : a ∧ b) : α := f h.left h.right
|
||||
|
||||
/-- Non-dependent eliminator for `Iff`. -/
|
||||
def Iff.elim (f : (a → b) → (b → a) → α) (h : a ↔ b) : α := f h.mp h.mpr
|
||||
/-! # Quotients -/
|
||||
|
||||
/-- Iff can now be used to do substitutions in a calculation -/
|
||||
theorem Iff.subst {a b : Prop} {p : Prop → Prop} (h₁ : a ↔ b) (h₂ : p a) : p b :=
|
||||
Eq.subst (propext h₁) h₂
|
||||
|
||||
theorem Not.intro {a : Prop} (h : a → False) : ¬a := h
|
||||
|
||||
theorem Not.imp {a b : Prop} (H2 : ¬b) (H1 : a → b) : ¬a := mt H1 H2
|
||||
|
||||
theorem not_congr (h : a ↔ b) : ¬a ↔ ¬b := ⟨mt h.2, mt h.1⟩
|
||||
|
||||
theorem not_not_not : ¬¬¬a ↔ ¬a := ⟨mt not_not_intro, not_not_intro⟩
|
||||
|
||||
theorem iff_of_true (ha : a) (hb : b) : a ↔ b := Iff.intro (fun _ => hb) (fun _ => ha)
|
||||
theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b := Iff.intro ha.elim hb.elim
|
||||
|
||||
theorem iff_true_left (ha : a) : (a ↔ b) ↔ b := Iff.intro (·.mp ha) (iff_of_true ha)
|
||||
theorem iff_true_right (ha : a) : (b ↔ a) ↔ b := Iff.comm.trans (iff_true_left ha)
|
||||
|
||||
theorem iff_false_left (ha : ¬a) : (a ↔ b) ↔ ¬b := Iff.intro (mt ·.mpr ha) (iff_of_false ha)
|
||||
theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b := Iff.comm.trans (iff_false_left ha)
|
||||
|
||||
theorem of_iff_true (h : a ↔ True) : a := h.mpr trivial
|
||||
theorem iff_true_intro (h : a) : a ↔ True := iff_of_true h trivial
|
||||
|
||||
theorem not_of_iff_false : (p ↔ False) → ¬p := Iff.mp
|
||||
theorem iff_false_intro (h : ¬a) : a ↔ False := iff_of_false h id
|
||||
|
||||
theorem not_iff_false_intro (h : a) : ¬a ↔ False := iff_false_intro (not_not_intro h)
|
||||
theorem not_true : (¬True) ↔ False := iff_false_intro (not_not_intro trivial)
|
||||
|
||||
theorem not_false_iff : (¬False) ↔ True := iff_true_intro not_false
|
||||
|
||||
theorem Eq.to_iff : a = b → (a ↔ b) := Iff.of_eq
|
||||
theorem iff_of_eq : a = b → (a ↔ b) := Iff.of_eq
|
||||
theorem neq_of_not_iff : ¬(a ↔ b) → a ≠ b := mt Iff.of_eq
|
||||
|
||||
theorem iff_iff_eq : (a ↔ b) ↔ a = b := Iff.intro propext Iff.of_eq
|
||||
@[simp] theorem eq_iff_iff : (a = b) ↔ (a ↔ b) := iff_iff_eq.symm
|
||||
|
||||
theorem eq_self_iff_true (a : α) : a = a ↔ True := iff_true_intro rfl
|
||||
theorem ne_self_iff_false (a : α) : a ≠ a ↔ False := not_iff_false_intro rfl
|
||||
|
||||
theorem false_of_true_iff_false (h : True ↔ False) : False := h.mp trivial
|
||||
theorem false_of_true_eq_false (h : True = False) : False := false_of_true_iff_false (Iff.of_eq h)
|
||||
|
||||
theorem true_eq_false_of_false : False → (True = False) := False.elim
|
||||
|
||||
theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) := iff_iff_implies_and_implies a b
|
||||
theorem iff_def' : (a ↔ b) ↔ (b → a) ∧ (a → b) := Iff.trans iff_def And.comm
|
||||
|
||||
theorem true_iff_false : (True ↔ False) ↔ False := iff_false_intro (·.mp True.intro)
|
||||
theorem false_iff_true : (False ↔ True) ↔ False := iff_false_intro (·.mpr True.intro)
|
||||
|
||||
theorem iff_not_self : ¬(a ↔ ¬a) | H => let f h := H.1 h h; f (H.2 f)
|
||||
theorem heq_self_iff_true (a : α) : HEq a a ↔ True := iff_true_intro HEq.rfl
|
||||
|
||||
/-! ## implies -/
|
||||
|
||||
theorem not_not_of_not_imp : ¬(a → b) → ¬¬a := mt Not.elim
|
||||
|
||||
theorem not_of_not_imp {a : Prop} : ¬(a → b) → ¬b := mt fun h _ => h
|
||||
|
||||
@[simp] theorem imp_not_self : (a → ¬a) ↔ ¬a := Iff.intro (fun h ha => h ha ha) (fun h _ => h)
|
||||
|
||||
theorem imp_intro {α β : Prop} (h : α) : β → α := fun _ => h
|
||||
|
||||
theorem imp_imp_imp {a b c d : Prop} (h₀ : c → a) (h₁ : b → d) : (a → b) → (c → d) := (h₁ ∘ · ∘ h₀)
|
||||
|
||||
theorem imp_iff_right {a : Prop} (ha : a) : (a → b) ↔ b := Iff.intro (· ha) (fun a _ => a)
|
||||
|
||||
-- This is not marked `@[simp]` because we have `implies_true : (α → True) = True`
|
||||
theorem imp_true_iff (α : Sort u) : (α → True) ↔ True := iff_true_intro (fun _ => trivial)
|
||||
|
||||
theorem false_imp_iff (a : Prop) : (False → a) ↔ True := iff_true_intro False.elim
|
||||
|
||||
theorem true_imp_iff (α : Prop) : (True → α) ↔ α := imp_iff_right True.intro
|
||||
|
||||
@[simp] theorem imp_self : (a → a) ↔ True := iff_true_intro id
|
||||
|
||||
theorem imp_false : (a → False) ↔ ¬a := Iff.rfl
|
||||
|
||||
theorem imp.swap : (a → b → c) ↔ (b → a → c) := Iff.intro flip flip
|
||||
|
||||
theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) := imp.swap
|
||||
|
||||
theorem imp_congr_left (h : a ↔ b) : (a → c) ↔ (b → c) := Iff.intro (· ∘ h.mpr) (· ∘ h.mp)
|
||||
|
||||
theorem imp_congr_right (h : a → (b ↔ c)) : (a → b) ↔ (a → c) :=
|
||||
Iff.intro (fun hab ha => (h ha).mp (hab ha)) (fun hcd ha => (h ha).mpr (hcd ha))
|
||||
|
||||
theorem imp_congr_ctx (h₁ : a ↔ c) (h₂ : c → (b ↔ d)) : (a → b) ↔ (c → d) :=
|
||||
Iff.trans (imp_congr_left h₁) (imp_congr_right h₂)
|
||||
|
||||
theorem imp_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a → b) ↔ (c → d) := imp_congr_ctx h₁ fun _ => h₂
|
||||
|
||||
theorem imp_iff_not (hb : ¬b) : a → b ↔ ¬a := imp_congr_right fun _ => iff_false_intro hb
|
||||
|
||||
/-! # Quotients -/
|
||||
|
||||
namespace Quot
|
||||
/--
|
||||
The **quotient axiom**, or at least the nontrivial part of the quotient
|
||||
@@ -1932,18 +1687,6 @@ axiom ofReduceNat (a b : Nat) (h : reduceNat a = b) : a = b
|
||||
|
||||
end Lean
|
||||
|
||||
@[simp] theorem ge_iff_le [LE α] {x y : α} : x ≥ y ↔ y ≤ x := Iff.rfl
|
||||
|
||||
@[simp] theorem gt_iff_lt [LT α] {x y : α} : x > y ↔ y < x := Iff.rfl
|
||||
|
||||
theorem le_of_eq_of_le {a b c : α} [LE α] (h₁ : a = b) (h₂ : b ≤ c) : a ≤ c := h₁ ▸ h₂
|
||||
|
||||
theorem le_of_le_of_eq {a b c : α} [LE α] (h₁ : a ≤ b) (h₂ : b = c) : a ≤ c := h₂ ▸ h₁
|
||||
|
||||
theorem lt_of_eq_of_lt {a b c : α} [LT α] (h₁ : a = b) (h₂ : b < c) : a < c := h₁ ▸ h₂
|
||||
|
||||
theorem lt_of_lt_of_eq {a b c : α} [LT α] (h₁ : a < b) (h₂ : b = c) : a < c := h₂ ▸ h₁
|
||||
|
||||
namespace Std
|
||||
variable {α : Sort u}
|
||||
|
||||
|
||||
@@ -6,7 +6,6 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Init.Data.Basic
|
||||
import Init.Data.Nat
|
||||
import Init.Data.Cast
|
||||
import Init.Data.Char
|
||||
import Init.Data.String
|
||||
import Init.Data.List
|
||||
|
||||
@@ -11,4 +11,3 @@ import Init.Data.Array.InsertionSort
|
||||
import Init.Data.Array.DecidableEq
|
||||
import Init.Data.Array.Mem
|
||||
import Init.Data.Array.BasicAux
|
||||
import Init.Data.Array.Lemmas
|
||||
|
||||
@@ -5,7 +5,7 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Array.Basic
|
||||
import Init.ByCases
|
||||
import Init.Classical
|
||||
|
||||
namespace Array
|
||||
|
||||
|
||||
@@ -1,187 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Nat
|
||||
import Init.Data.List.Lemmas
|
||||
import Init.Data.Fin.Basic
|
||||
import Init.Data.Array.Mem
|
||||
|
||||
/-!
|
||||
## Bootstrapping theorems about arrays
|
||||
|
||||
This file contains some theorems about `Array` and `List` needed for `Std.List.Basic`.
|
||||
-/
|
||||
|
||||
namespace Array
|
||||
|
||||
attribute [simp] data_toArray uset
|
||||
|
||||
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
|
||||
|
||||
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
|
||||
|
||||
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
|
||||
|
||||
theorem getElem_eq_data_get (a : Array α) (h : i < a.size) : a[i] = a.data.get ⟨i, h⟩ := by
|
||||
by_cases i < a.size <;> (try simp [*]) <;> rfl
|
||||
|
||||
theorem foldlM_eq_foldlM_data.aux [Monad m]
|
||||
(f : β → α → m β) (arr : Array α) (i j) (H : arr.size ≤ i + j) (b) :
|
||||
foldlM.loop f arr arr.size (Nat.le_refl _) i j b = (arr.data.drop j).foldlM f b := by
|
||||
unfold foldlM.loop
|
||||
split; split
|
||||
· cases Nat.not_le_of_gt ‹_› (Nat.zero_add _ ▸ H)
|
||||
· rename_i i; rw [Nat.succ_add] at H
|
||||
simp [foldlM_eq_foldlM_data.aux f arr i (j+1) H]
|
||||
rw (config := {occs := .pos [2]}) [← List.get_drop_eq_drop _ _ ‹_›]
|
||||
rfl
|
||||
· rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
|
||||
|
||||
theorem foldlM_eq_foldlM_data [Monad m]
|
||||
(f : β → α → m β) (init : β) (arr : Array α) :
|
||||
arr.foldlM f init = arr.data.foldlM f init := by
|
||||
simp [foldlM, foldlM_eq_foldlM_data.aux]
|
||||
|
||||
theorem foldl_eq_foldl_data (f : β → α → β) (init : β) (arr : Array α) :
|
||||
arr.foldl f init = arr.data.foldl f init :=
|
||||
List.foldl_eq_foldlM .. ▸ foldlM_eq_foldlM_data ..
|
||||
|
||||
theorem foldrM_eq_reverse_foldlM_data.aux [Monad m]
|
||||
(f : α → β → m β) (arr : Array α) (init : β) (i h) :
|
||||
(arr.data.take i).reverse.foldlM (fun x y => f y x) init = foldrM.fold f arr 0 i h init := by
|
||||
unfold foldrM.fold
|
||||
match i with
|
||||
| 0 => simp [List.foldlM, List.take]
|
||||
| i+1 => rw [← List.take_concat_get _ _ h]; simp [← (aux f arr · i)]; rfl
|
||||
|
||||
theorem foldrM_eq_reverse_foldlM_data [Monad m] (f : α → β → m β) (init : β) (arr : Array α) :
|
||||
arr.foldrM f init = arr.data.reverse.foldlM (fun x y => f y x) init := by
|
||||
have : arr = #[] ∨ 0 < arr.size :=
|
||||
match arr with | ⟨[]⟩ => .inl rfl | ⟨a::l⟩ => .inr (Nat.zero_lt_succ _)
|
||||
match arr, this with | _, .inl rfl => rfl | arr, .inr h => ?_
|
||||
simp [foldrM, h, ← foldrM_eq_reverse_foldlM_data.aux, List.take_length]
|
||||
|
||||
theorem foldrM_eq_foldrM_data [Monad m]
|
||||
(f : α → β → m β) (init : β) (arr : Array α) :
|
||||
arr.foldrM f init = arr.data.foldrM f init := by
|
||||
rw [foldrM_eq_reverse_foldlM_data, List.foldlM_reverse]
|
||||
|
||||
theorem foldr_eq_foldr_data (f : α → β → β) (init : β) (arr : Array α) :
|
||||
arr.foldr f init = arr.data.foldr f init :=
|
||||
List.foldr_eq_foldrM .. ▸ foldrM_eq_foldrM_data ..
|
||||
|
||||
@[simp] theorem push_data (arr : Array α) (a : α) : (arr.push a).data = arr.data ++ [a] := by
|
||||
simp [push, List.concat_eq_append]
|
||||
|
||||
theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
|
||||
simp [foldrM_eq_reverse_foldlM_data, -size_push]
|
||||
|
||||
@[simp] theorem foldrM_push' [Monad m] (f : α → β → m β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldrM f init (start := arr.size + 1) = f a init >>= arr.foldrM f := by
|
||||
simp [← foldrM_push]
|
||||
|
||||
theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
|
||||
|
||||
@[simp] theorem foldr_push' (f : α → β → β) (init : β) (arr : Array α) (a : α) :
|
||||
(arr.push a).foldr f init (start := arr.size + 1) = arr.foldr f (f a init) := foldrM_push' ..
|
||||
|
||||
@[simp] theorem toListAppend_eq (arr : Array α) (l) : arr.toListAppend l = arr.data ++ l := by
|
||||
simp [toListAppend, foldr_eq_foldr_data]
|
||||
|
||||
@[simp] theorem toList_eq (arr : Array α) : arr.toList = arr.data := by
|
||||
simp [toList, foldr_eq_foldr_data]
|
||||
|
||||
/-- A more efficient version of `arr.toList.reverse`. -/
|
||||
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
|
||||
|
||||
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.data.reverse := by
|
||||
rw [toListRev, foldl_eq_foldl_data, ← List.foldr_reverse, List.foldr_self]
|
||||
|
||||
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
|
||||
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
|
||||
(a.push x)[i] = a[i] := by
|
||||
simp only [push, getElem_eq_data_get, List.concat_eq_append, List.get_append_left, h]
|
||||
|
||||
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
|
||||
simp only [push, getElem_eq_data_get, List.concat_eq_append]
|
||||
rw [List.get_append_right] <;> simp [getElem_eq_data_get, Nat.zero_lt_one]
|
||||
|
||||
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
|
||||
(a.push x)[i] = if h : i < a.size then a[i] else x := by
|
||||
by_cases h' : i < a.size
|
||||
· simp [get_push_lt, h']
|
||||
· simp at h
|
||||
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
|
||||
|
||||
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α → m β) (arr : Array α) :
|
||||
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
|
||||
rw [mapM, aux, foldlM_eq_foldlM_data]; rfl
|
||||
where
|
||||
aux (i r) :
|
||||
mapM.map f arr i r = (arr.data.drop i).foldlM (fun bs a => bs.push <$> f a) r := by
|
||||
unfold mapM.map; split
|
||||
· rw [← List.get_drop_eq_drop _ i ‹_›]
|
||||
simp [aux (i+1), map_eq_pure_bind]; rfl
|
||||
· rw [List.drop_length_le (Nat.ge_of_not_lt ‹_›)]; rfl
|
||||
termination_by arr.size - i
|
||||
|
||||
@[simp] theorem map_data (f : α → β) (arr : Array α) : (arr.map f).data = arr.data.map f := by
|
||||
rw [map, mapM_eq_foldlM]
|
||||
apply congrArg data (foldl_eq_foldl_data (fun bs a => push bs (f a)) #[] arr) |>.trans
|
||||
have H (l arr) : List.foldl (fun bs a => push bs (f a)) arr l = ⟨arr.data ++ l.map f⟩ := by
|
||||
induction l generalizing arr <;> simp [*]
|
||||
simp [H]
|
||||
|
||||
@[simp] theorem size_map (f : α → β) (arr : Array α) : (arr.map f).size = arr.size := by
|
||||
simp [size]
|
||||
|
||||
@[simp] theorem pop_data (arr : Array α) : arr.pop.data = arr.data.dropLast := rfl
|
||||
|
||||
@[simp] theorem append_eq_append (arr arr' : Array α) : arr.append arr' = arr ++ arr' := rfl
|
||||
|
||||
@[simp] theorem append_data (arr arr' : Array α) :
|
||||
(arr ++ arr').data = arr.data ++ arr'.data := by
|
||||
rw [← append_eq_append]; unfold Array.append
|
||||
rw [foldl_eq_foldl_data]
|
||||
induction arr'.data generalizing arr <;> simp [*]
|
||||
|
||||
@[simp] theorem appendList_eq_append
|
||||
(arr : Array α) (l : List α) : arr.appendList l = arr ++ l := rfl
|
||||
|
||||
@[simp] theorem appendList_data (arr : Array α) (l : List α) :
|
||||
(arr ++ l).data = arr.data ++ l := by
|
||||
rw [← appendList_eq_append]; unfold Array.appendList
|
||||
induction l generalizing arr <;> simp [*]
|
||||
|
||||
@[simp] theorem appendList_nil (arr : Array α) : arr ++ ([] : List α) = arr := Array.ext' (by simp)
|
||||
|
||||
@[simp] theorem appendList_cons (arr : Array α) (a : α) (l : List α) :
|
||||
arr ++ (a :: l) = arr.push a ++ l := Array.ext' (by simp)
|
||||
|
||||
theorem foldl_data_eq_bind (l : List α) (acc : Array β)
|
||||
(F : Array β → α → Array β) (G : α → List β)
|
||||
(H : ∀ acc a, (F acc a).data = acc.data ++ G a) :
|
||||
(l.foldl F acc).data = acc.data ++ l.bind G := by
|
||||
induction l generalizing acc <;> simp [*, List.bind]
|
||||
|
||||
theorem foldl_data_eq_map (l : List α) (acc : Array β) (G : α → β) :
|
||||
(l.foldl (fun acc a => acc.push (G a)) acc).data = acc.data ++ l.map G := by
|
||||
induction l generalizing acc <;> simp [*]
|
||||
|
||||
theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by simp
|
||||
|
||||
theorem anyM_eq_anyM_loop [Monad m] (p : α → m Bool) (as : Array α) (start stop) :
|
||||
anyM p as start stop = anyM.loop p as (min stop as.size) (Nat.min_le_right ..) start := by
|
||||
simp only [anyM, Nat.min_def]; split <;> rfl
|
||||
|
||||
theorem anyM_stop_le_start [Monad m] (p : α → m Bool) (as : Array α) (start stop)
|
||||
(h : min stop as.size ≤ start) : anyM p as start stop = pure false := by
|
||||
rw [anyM_eq_anyM_loop, anyM.loop, dif_neg (Nat.not_lt.2 h)]
|
||||
|
||||
theorem mem_def (a : α) (as : Array α) : a ∈ as ↔ a ∈ as.data :=
|
||||
⟨fun | .mk h => h, Array.Mem.mk⟩
|
||||
@@ -1,72 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2014 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro, Gabriel Ebner
|
||||
-/
|
||||
prelude
|
||||
import Init.Coe
|
||||
|
||||
/-!
|
||||
# `NatCast`
|
||||
|
||||
We introduce the typeclass `NatCast R` for a type `R` with a "canonical
|
||||
homomorphism" `Nat → R`. The typeclass carries the data of the function,
|
||||
but no required axioms.
|
||||
|
||||
This typeclass was introduced to support a uniform `simp` normal form
|
||||
for such morphisms.
|
||||
|
||||
Without such a typeclass, we would have specific coercions such as
|
||||
`Int.ofNat`, but also later the generic coercion from `Nat` into any
|
||||
Mathlib semiring (including `Int`), and we would need to use `simp` to
|
||||
move between them. However `simp` lemmas expressed using a non-normal
|
||||
form on the LHS would then not fire.
|
||||
|
||||
Typically different instances of this class for the same target type `R`
|
||||
are definitionally equal, and so differences in the instance do not
|
||||
block `simp` or `rw`.
|
||||
|
||||
This logic also applies to `Int` and so we also introduce `IntCast` alongside
|
||||
`Int.
|
||||
|
||||
## Note about coercions into arbitrary types:
|
||||
|
||||
Coercions such as `Nat.cast` that go from a concrete structure such as
|
||||
`Nat` to an arbitrary type `R` should be set up as follows:
|
||||
```lean
|
||||
instance : CoeTail Nat R where coe := ...
|
||||
instance : CoeHTCT Nat R where coe := ...
|
||||
```
|
||||
|
||||
It needs to be `CoeTail` instead of `Coe` because otherwise type-class
|
||||
inference would loop when constructing the transitive coercion `Nat →
|
||||
Nat → Nat → ...`. Sometimes we also need to declare the `CoeHTCT`
|
||||
instance if we need to shadow another coercion.
|
||||
-/
|
||||
|
||||
/-- Type class for the canonical homomorphism `Nat → R`. -/
|
||||
class NatCast (R : Type u) where
|
||||
/-- The canonical map `Nat → R`. -/
|
||||
protected natCast : Nat → R
|
||||
|
||||
instance : NatCast Nat where natCast n := n
|
||||
|
||||
/--
|
||||
Canonical homomorphism from `Nat` to a type `R`.
|
||||
|
||||
It contains just the function, with no axioms.
|
||||
In practice, the target type will likely have a (semi)ring structure,
|
||||
and this homomorphism should be a ring homomorphism.
|
||||
|
||||
The prototypical example is `Int.ofNat`.
|
||||
|
||||
This class and `IntCast` exist to allow different libraries with their own types that can be notated as natural numbers to have consistent `simp` normal forms without needing to create coercion simplification sets that are aware of all combinations. Libraries should make it easy to work with `NatCast` where possible. For instance, in Mathlib there will be such a homomorphism (and thus a `NatCast R` instance) whenever `R` is an additive monoid with a `1`.
|
||||
-/
|
||||
@[coe, reducible, match_pattern] protected def Nat.cast {R : Type u} [NatCast R] : Nat → R :=
|
||||
NatCast.natCast
|
||||
|
||||
-- see the notes about coercions into arbitrary types in the module doc-string
|
||||
instance [NatCast R] : CoeTail Nat R where coe := Nat.cast
|
||||
|
||||
-- see the notes about coercions into arbitrary types in the module doc-string
|
||||
instance [NatCast R] : CoeHTCT Nat R where coe := Nat.cast
|
||||
@@ -106,8 +106,6 @@ instance instOfNat : OfNat (Fin (no_index (n+1))) i where
|
||||
instance : Inhabited (Fin (no_index (n+1))) where
|
||||
default := 0
|
||||
|
||||
@[simp] theorem zero_eta : (⟨0, Nat.zero_lt_succ _⟩ : Fin (n + 1)) = 0 := rfl
|
||||
|
||||
theorem val_ne_of_ne {i j : Fin n} (h : i ≠ j) : val i ≠ val j :=
|
||||
fun h' => absurd (eq_of_val_eq h') h
|
||||
|
||||
|
||||
@@ -5,9 +5,3 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.Basic
|
||||
import Init.Data.Int.Bitwise
|
||||
import Init.Data.Int.DivMod
|
||||
import Init.Data.Int.DivModLemmas
|
||||
import Init.Data.Int.Gcd
|
||||
import Init.Data.Int.Lemmas
|
||||
import Init.Data.Int.Order
|
||||
|
||||
@@ -6,7 +6,7 @@ Authors: Jeremy Avigad, Leonardo de Moura
|
||||
The integers, with addition, multiplication, and subtraction.
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Cast
|
||||
import Init.Coe
|
||||
import Init.Data.Nat.Div
|
||||
import Init.Data.List.Basic
|
||||
set_option linter.missingDocs true -- keep it documented
|
||||
@@ -47,35 +47,14 @@ inductive Int : Type where
|
||||
attribute [extern "lean_nat_to_int"] Int.ofNat
|
||||
attribute [extern "lean_int_neg_succ_of_nat"] Int.negSucc
|
||||
|
||||
instance : NatCast Int where natCast n := Int.ofNat n
|
||||
instance : Coe Nat Int := ⟨Int.ofNat⟩
|
||||
|
||||
instance instOfNat : OfNat Int n where
|
||||
ofNat := Int.ofNat n
|
||||
|
||||
namespace Int
|
||||
|
||||
/--
|
||||
`-[n+1]` is suggestive notation for `negSucc n`, which is the second constructor of
|
||||
`Int` for making strictly negative numbers by mapping `n : Nat` to `-(n + 1)`.
|
||||
-/
|
||||
scoped notation "-[" n "+1]" => negSucc n
|
||||
|
||||
instance : Inhabited Int := ⟨ofNat 0⟩
|
||||
|
||||
@[simp] theorem default_eq_zero : default = (0 : Int) := rfl
|
||||
|
||||
protected theorem zero_ne_one : (0 : Int) ≠ 1 := nofun
|
||||
|
||||
/-! ## Coercions -/
|
||||
|
||||
@[simp] theorem ofNat_eq_coe : Int.ofNat n = Nat.cast n := rfl
|
||||
|
||||
@[simp] theorem ofNat_zero : ((0 : Nat) : Int) = 0 := rfl
|
||||
|
||||
@[simp] theorem ofNat_one : ((1 : Nat) : Int) = 1 := rfl
|
||||
|
||||
theorem ofNat_two : ((2 : Nat) : Int) = 2 := rfl
|
||||
|
||||
/-- Negation of a natural number. -/
|
||||
def negOfNat : Nat → Int
|
||||
| 0 => 0
|
||||
@@ -121,10 +100,10 @@ set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_int_add"]
|
||||
protected def add (m n : @& Int) : Int :=
|
||||
match m, n with
|
||||
| ofNat m, ofNat n => ofNat (m + n)
|
||||
| ofNat m, -[n +1] => subNatNat m (succ n)
|
||||
| -[m +1], ofNat n => subNatNat n (succ m)
|
||||
| -[m +1], -[n +1] => negSucc (succ (m + n))
|
||||
| ofNat m, ofNat n => ofNat (m + n)
|
||||
| ofNat m, negSucc n => subNatNat m (succ n)
|
||||
| negSucc m, ofNat n => subNatNat n (succ m)
|
||||
| negSucc m, negSucc n => negSucc (succ (m + n))
|
||||
|
||||
instance : Add Int where
|
||||
add := Int.add
|
||||
@@ -142,10 +121,10 @@ set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_int_mul"]
|
||||
protected def mul (m n : @& Int) : Int :=
|
||||
match m, n with
|
||||
| ofNat m, ofNat n => ofNat (m * n)
|
||||
| ofNat m, -[n +1] => negOfNat (m * succ n)
|
||||
| -[m +1], ofNat n => negOfNat (succ m * n)
|
||||
| -[m +1], -[n +1] => ofNat (succ m * succ n)
|
||||
| ofNat m, ofNat n => ofNat (m * n)
|
||||
| ofNat m, negSucc n => negOfNat (m * succ n)
|
||||
| negSucc m, ofNat n => negOfNat (succ m * n)
|
||||
| negSucc m, negSucc n => ofNat (succ m * succ n)
|
||||
|
||||
instance : Mul Int where
|
||||
mul := Int.mul
|
||||
@@ -160,7 +139,8 @@ instance : Mul Int where
|
||||
|
||||
Implemented by efficient native code. -/
|
||||
@[extern "lean_int_sub"]
|
||||
protected def sub (m n : @& Int) : Int := m + (- n)
|
||||
protected def sub (m n : @& Int) : Int :=
|
||||
m + (- n)
|
||||
|
||||
instance : Sub Int where
|
||||
sub := Int.sub
|
||||
@@ -198,11 +178,11 @@ protected def decEq (a b : @& Int) : Decidable (a = b) :=
|
||||
| ofNat a, ofNat b => match decEq a b with
|
||||
| isTrue h => isTrue <| h ▸ rfl
|
||||
| isFalse h => isFalse <| fun h' => Int.noConfusion h' (fun h' => absurd h' h)
|
||||
| ofNat _, -[_ +1] => isFalse <| fun h => Int.noConfusion h
|
||||
| -[_ +1], ofNat _ => isFalse <| fun h => Int.noConfusion h
|
||||
| -[a +1], -[b +1] => match decEq a b with
|
||||
| negSucc a, negSucc b => match decEq a b with
|
||||
| isTrue h => isTrue <| h ▸ rfl
|
||||
| isFalse h => isFalse <| fun h' => Int.noConfusion h' (fun h' => absurd h' h)
|
||||
| ofNat _, negSucc _ => isFalse <| fun h => Int.noConfusion h
|
||||
| negSucc _, ofNat _ => isFalse <| fun h => Int.noConfusion h
|
||||
|
||||
instance : DecidableEq Int := Int.decEq
|
||||
|
||||
@@ -219,8 +199,8 @@ set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_int_dec_nonneg"]
|
||||
private def decNonneg (m : @& Int) : Decidable (NonNeg m) :=
|
||||
match m with
|
||||
| ofNat m => isTrue <| NonNeg.mk m
|
||||
| -[_ +1] => isFalse <| fun h => nomatch h
|
||||
| ofNat m => isTrue <| NonNeg.mk m
|
||||
| negSucc _ => isFalse <| fun h => nomatch h
|
||||
|
||||
/-- Decides whether `a ≤ b`.
|
||||
|
||||
@@ -261,21 +241,85 @@ set_option bootstrap.genMatcherCode false in
|
||||
@[extern "lean_nat_abs"]
|
||||
def natAbs (m : @& Int) : Nat :=
|
||||
match m with
|
||||
| ofNat m => m
|
||||
| -[m +1] => m.succ
|
||||
| ofNat m => m
|
||||
| negSucc m => m.succ
|
||||
|
||||
/-! ## sign -/
|
||||
/-- Integer division. This function uses the
|
||||
[*"T-rounding"*][t-rounding] (**T**runcation-rounding) convention,
|
||||
meaning that it rounds toward zero. Also note that division by zero
|
||||
is defined to equal zero.
|
||||
|
||||
/--
|
||||
Returns the "sign" of the integer as another integer: `1` for positive numbers,
|
||||
`-1` for negative numbers, and `0` for `0`.
|
||||
-/
|
||||
def sign : Int → Int
|
||||
| Int.ofNat (succ _) => 1
|
||||
| Int.ofNat 0 => 0
|
||||
| -[_+1] => -1
|
||||
The relation between integer division and modulo is found in [the
|
||||
`Int.mod_add_div` theorem in std][theo mod_add_div] which states
|
||||
that `a % b + b * (a / b) = a`, unconditionally.
|
||||
|
||||
/-! ## Conversion -/
|
||||
[t-rounding]: https://dl.acm.org/doi/pdf/10.1145/128861.128862
|
||||
[theo mod_add_div]: https://leanprover-community.github.io/mathlib4_docs/find/?pattern=Int.mod_add_div#doc
|
||||
|
||||
Examples:
|
||||
|
||||
```
|
||||
#eval (7 : Int) / (0 : Int) -- 0
|
||||
#eval (0 : Int) / (7 : Int) -- 0
|
||||
|
||||
#eval (12 : Int) / (6 : Int) -- 2
|
||||
#eval (12 : Int) / (-6 : Int) -- -2
|
||||
#eval (-12 : Int) / (6 : Int) -- -2
|
||||
#eval (-12 : Int) / (-6 : Int) -- 2
|
||||
|
||||
#eval (12 : Int) / (7 : Int) -- 1
|
||||
#eval (12 : Int) / (-7 : Int) -- -1
|
||||
#eval (-12 : Int) / (7 : Int) -- -1
|
||||
#eval (-12 : Int) / (-7 : Int) -- 1
|
||||
```
|
||||
|
||||
Implemented by efficient native code. -/
|
||||
@[extern "lean_int_div"]
|
||||
def div : (@& Int) → (@& Int) → Int
|
||||
| ofNat m, ofNat n => ofNat (m / n)
|
||||
| ofNat m, negSucc n => -ofNat (m / succ n)
|
||||
| negSucc m, ofNat n => -ofNat (succ m / n)
|
||||
| negSucc m, negSucc n => ofNat (succ m / succ n)
|
||||
|
||||
instance : Div Int where
|
||||
div := Int.div
|
||||
|
||||
/-- Integer modulo. This function uses the
|
||||
[*"T-rounding"*][t-rounding] (**T**runcation-rounding) convention
|
||||
to pair with `Int.div`, meaning that `a % b + b * (a / b) = a`
|
||||
unconditionally (see [`Int.mod_add_div`][theo mod_add_div]). In
|
||||
particular, `a % 0 = a`.
|
||||
|
||||
[t-rounding]: https://dl.acm.org/doi/pdf/10.1145/128861.128862
|
||||
[theo mod_add_div]: https://leanprover-community.github.io/mathlib4_docs/find/?pattern=Int.mod_add_div#doc
|
||||
|
||||
Examples:
|
||||
|
||||
```
|
||||
#eval (7 : Int) % (0 : Int) -- 7
|
||||
#eval (0 : Int) % (7 : Int) -- 0
|
||||
|
||||
#eval (12 : Int) % (6 : Int) -- 0
|
||||
#eval (12 : Int) % (-6 : Int) -- 0
|
||||
#eval (-12 : Int) % (6 : Int) -- 0
|
||||
#eval (-12 : Int) % (-6 : Int) -- 0
|
||||
|
||||
#eval (12 : Int) % (7 : Int) -- 5
|
||||
#eval (12 : Int) % (-7 : Int) -- 5
|
||||
#eval (-12 : Int) % (7 : Int) -- 2
|
||||
#eval (-12 : Int) % (-7 : Int) -- 2
|
||||
```
|
||||
|
||||
Implemented by efficient native code. -/
|
||||
@[extern "lean_int_mod"]
|
||||
def mod : (@& Int) → (@& Int) → Int
|
||||
| ofNat m, ofNat n => ofNat (m % n)
|
||||
| ofNat m, negSucc n => ofNat (m % succ n)
|
||||
| negSucc m, ofNat n => -ofNat (succ m % n)
|
||||
| negSucc m, negSucc n => -ofNat (succ m % succ n)
|
||||
|
||||
instance : Mod Int where
|
||||
mod := Int.mod
|
||||
|
||||
/-- Turns an integer into a natural number, negative numbers become
|
||||
`0`.
|
||||
@@ -290,25 +334,6 @@ def toNat : Int → Nat
|
||||
| ofNat n => n
|
||||
| negSucc _ => 0
|
||||
|
||||
/--
|
||||
* If `n : Nat`, then `int.toNat' n = some n`
|
||||
* If `n : Int` is negative, then `int.toNat' n = none`.
|
||||
-/
|
||||
def toNat' : Int → Option Nat
|
||||
| (n : Nat) => some n
|
||||
| -[_+1] => none
|
||||
|
||||
/-! ## divisibility -/
|
||||
|
||||
/--
|
||||
Divisibility of integers. `a ∣ b` (typed as `\|`) says that
|
||||
there is some `c` such that `b = a * c`.
|
||||
-/
|
||||
instance : Dvd Int where
|
||||
dvd a b := Exists (fun c => b = a * c)
|
||||
|
||||
/-! ## Powers -/
|
||||
|
||||
/-- Power of an integer to some natural number.
|
||||
|
||||
```
|
||||
@@ -334,27 +359,3 @@ instance : Min Int := minOfLe
|
||||
instance : Max Int := maxOfLe
|
||||
|
||||
end Int
|
||||
|
||||
/--
|
||||
The canonical homomorphism `Int → R`.
|
||||
In most use cases `R` will have a ring structure and this will be a ring homomorphism.
|
||||
-/
|
||||
class IntCast (R : Type u) where
|
||||
/-- The canonical map `Int → R`. -/
|
||||
protected intCast : Int → R
|
||||
|
||||
instance : IntCast Int where intCast n := n
|
||||
|
||||
/--
|
||||
Apply the canonical homomorphism from `Int` to a type `R` from an `IntCast R` instance.
|
||||
|
||||
In Mathlib there will be such a homomorphism whenever `R` is an additive group with a `1`.
|
||||
-/
|
||||
@[coe, reducible, match_pattern] protected def Int.cast {R : Type u} [IntCast R] : Int → R :=
|
||||
IntCast.intCast
|
||||
|
||||
-- see the notes about coercions into arbitrary types in the module doc-string
|
||||
instance [IntCast R] : CoeTail Int R where coe := Int.cast
|
||||
|
||||
-- see the notes about coercions into arbitrary types in the module doc-string
|
||||
instance [IntCast R] : CoeHTCT Int R where coe := Int.cast
|
||||
|
||||
@@ -1,50 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.Basic
|
||||
import Init.Data.Nat.Bitwise
|
||||
|
||||
namespace Int
|
||||
|
||||
/-! ## bit operations -/
|
||||
|
||||
/--
|
||||
Bitwise not
|
||||
|
||||
Interprets the integer as an infinite sequence of bits in two's complement
|
||||
and complements each bit.
|
||||
```
|
||||
~~~(0:Int) = -1
|
||||
~~~(1:Int) = -2
|
||||
~~~(-1:Int) = 0
|
||||
```
|
||||
-/
|
||||
protected def not : Int -> Int
|
||||
| Int.ofNat n => Int.negSucc n
|
||||
| Int.negSucc n => Int.ofNat n
|
||||
|
||||
instance : Complement Int := ⟨.not⟩
|
||||
|
||||
/--
|
||||
Bitwise shift right.
|
||||
|
||||
Conceptually, this treats the integer as an infinite sequence of bits in two's
|
||||
complement and shifts the value to the right.
|
||||
|
||||
```lean
|
||||
( 0b0111:Int) >>> 1 = 0b0011
|
||||
( 0b1000:Int) >>> 1 = 0b0100
|
||||
(-0b1000:Int) >>> 1 = -0b0100
|
||||
(-0b0111:Int) >>> 1 = -0b0100
|
||||
```
|
||||
-/
|
||||
protected def shiftRight : Int → Nat → Int
|
||||
| Int.ofNat n, s => Int.ofNat (n >>> s)
|
||||
| Int.negSucc n, s => Int.negSucc (n >>> s)
|
||||
|
||||
instance : HShiftRight Int Nat Int := ⟨.shiftRight⟩
|
||||
|
||||
end Int
|
||||
@@ -1,159 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Jeremy Avigad, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.Basic
|
||||
|
||||
open Nat
|
||||
|
||||
namespace Int
|
||||
|
||||
/-! ## Quotient and remainder
|
||||
|
||||
There are three main conventions for integer division,
|
||||
referred here as the E, F, T rounding conventions.
|
||||
All three pairs satisfy the identity `x % y + (x / y) * y = x` unconditionally,
|
||||
and satisfy `x / 0 = 0` and `x % 0 = x`.
|
||||
-/
|
||||
|
||||
/-! ### T-rounding division -/
|
||||
|
||||
/--
|
||||
`div` uses the [*"T-rounding"*][t-rounding]
|
||||
(**T**runcation-rounding) convention, meaning that it rounds toward
|
||||
zero. Also note that division by zero is defined to equal zero.
|
||||
|
||||
The relation between integer division and modulo is found in
|
||||
`Int.mod_add_div` which states that
|
||||
`a % b + b * (a / b) = a`, unconditionally.
|
||||
|
||||
[t-rounding]: https://dl.acm.org/doi/pdf/10.1145/128861.128862 [theo
|
||||
mod_add_div]:
|
||||
https://leanprover-community.github.io/mathlib4_docs/find/?pattern=Int.mod_add_div#doc
|
||||
|
||||
Examples:
|
||||
|
||||
```
|
||||
#eval (7 : Int) / (0 : Int) -- 0
|
||||
#eval (0 : Int) / (7 : Int) -- 0
|
||||
|
||||
#eval (12 : Int) / (6 : Int) -- 2
|
||||
#eval (12 : Int) / (-6 : Int) -- -2
|
||||
#eval (-12 : Int) / (6 : Int) -- -2
|
||||
#eval (-12 : Int) / (-6 : Int) -- 2
|
||||
|
||||
#eval (12 : Int) / (7 : Int) -- 1
|
||||
#eval (12 : Int) / (-7 : Int) -- -1
|
||||
#eval (-12 : Int) / (7 : Int) -- -1
|
||||
#eval (-12 : Int) / (-7 : Int) -- 1
|
||||
```
|
||||
|
||||
Implemented by efficient native code.
|
||||
-/
|
||||
@[extern "lean_int_div"]
|
||||
def div : (@& Int) → (@& Int) → Int
|
||||
| ofNat m, ofNat n => ofNat (m / n)
|
||||
| ofNat m, -[n +1] => -ofNat (m / succ n)
|
||||
| -[m +1], ofNat n => -ofNat (succ m / n)
|
||||
| -[m +1], -[n +1] => ofNat (succ m / succ n)
|
||||
|
||||
/-- Integer modulo. This function uses the
|
||||
[*"T-rounding"*][t-rounding] (**T**runcation-rounding) convention
|
||||
to pair with `Int.div`, meaning that `a % b + b * (a / b) = a`
|
||||
unconditionally (see [`Int.mod_add_div`][theo mod_add_div]). In
|
||||
particular, `a % 0 = a`.
|
||||
|
||||
[t-rounding]: https://dl.acm.org/doi/pdf/10.1145/128861.128862
|
||||
[theo mod_add_div]: https://leanprover-community.github.io/mathlib4_docs/find/?pattern=Int.mod_add_div#doc
|
||||
|
||||
Examples:
|
||||
|
||||
```
|
||||
#eval (7 : Int) % (0 : Int) -- 7
|
||||
#eval (0 : Int) % (7 : Int) -- 0
|
||||
|
||||
#eval (12 : Int) % (6 : Int) -- 0
|
||||
#eval (12 : Int) % (-6 : Int) -- 0
|
||||
#eval (-12 : Int) % (6 : Int) -- 0
|
||||
#eval (-12 : Int) % (-6 : Int) -- 0
|
||||
|
||||
#eval (12 : Int) % (7 : Int) -- 5
|
||||
#eval (12 : Int) % (-7 : Int) -- 5
|
||||
#eval (-12 : Int) % (7 : Int) -- 2
|
||||
#eval (-12 : Int) % (-7 : Int) -- 2
|
||||
```
|
||||
|
||||
Implemented by efficient native code. -/
|
||||
@[extern "lean_int_mod"]
|
||||
def mod : (@& Int) → (@& Int) → Int
|
||||
| ofNat m, ofNat n => ofNat (m % n)
|
||||
| ofNat m, -[n +1] => ofNat (m % succ n)
|
||||
| -[m +1], ofNat n => -ofNat (succ m % n)
|
||||
| -[m +1], -[n +1] => -ofNat (succ m % succ n)
|
||||
|
||||
/-! ### F-rounding division
|
||||
This pair satisfies `fdiv x y = floor (x / y)`.
|
||||
-/
|
||||
|
||||
/--
|
||||
Integer division. This version of division uses the F-rounding convention
|
||||
(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)`
|
||||
and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`.
|
||||
-/
|
||||
def fdiv : Int → Int → Int
|
||||
| 0, _ => 0
|
||||
| ofNat m, ofNat n => ofNat (m / n)
|
||||
| ofNat (succ m), -[n+1] => -[m / succ n +1]
|
||||
| -[_+1], 0 => 0
|
||||
| -[m+1], ofNat (succ n) => -[m / succ n +1]
|
||||
| -[m+1], -[n+1] => ofNat (succ m / succ n)
|
||||
|
||||
/--
|
||||
Integer modulus. This version of `Int.mod` uses the F-rounding convention
|
||||
(flooring division), in which `Int.fdiv x y` satisfies `fdiv x y = floor (x / y)`
|
||||
and `Int.fmod` is the unique function satisfying `fmod x y + (fdiv x y) * y = x`.
|
||||
-/
|
||||
def fmod : Int → Int → Int
|
||||
| 0, _ => 0
|
||||
| ofNat m, ofNat n => ofNat (m % n)
|
||||
| ofNat (succ m), -[n+1] => subNatNat (m % succ n) n
|
||||
| -[m+1], ofNat n => subNatNat n (succ (m % n))
|
||||
| -[m+1], -[n+1] => -ofNat (succ m % succ n)
|
||||
|
||||
/-! ### E-rounding division
|
||||
This pair satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0`.
|
||||
-/
|
||||
|
||||
/--
|
||||
Integer division. This version of `Int.div` uses the E-rounding convention
|
||||
(euclidean division), in which `Int.emod x y` satisfies `0 ≤ mod x y < natAbs y` for `y ≠ 0`
|
||||
and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`.
|
||||
-/
|
||||
def ediv : Int → Int → Int
|
||||
| ofNat m, ofNat n => ofNat (m / n)
|
||||
| ofNat m, -[n+1] => -ofNat (m / succ n)
|
||||
| -[_+1], 0 => 0
|
||||
| -[m+1], ofNat (succ n) => -[m / succ n +1]
|
||||
| -[m+1], -[n+1] => ofNat (succ (m / succ n))
|
||||
|
||||
/--
|
||||
Integer modulus. This version of `Int.mod` uses the E-rounding convention
|
||||
(euclidean division), in which `Int.emod x y` satisfies `0 ≤ emod x y < natAbs y` for `y ≠ 0`
|
||||
and `Int.ediv` is the unique function satisfying `emod x y + (ediv x y) * y = x`.
|
||||
-/
|
||||
def emod : Int → Int → Int
|
||||
| ofNat m, n => ofNat (m % natAbs n)
|
||||
| -[m+1], n => subNatNat (natAbs n) (succ (m % natAbs n))
|
||||
|
||||
/--
|
||||
The Div and Mod syntax uses ediv and emod for compatibility with SMTLIb and mathematical
|
||||
reasoning tends to be easier.
|
||||
-/
|
||||
instance : Div Int where
|
||||
div := Int.ediv
|
||||
instance : Mod Int where
|
||||
mod := Int.emod
|
||||
|
||||
end Int
|
||||
@@ -1,347 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Jeremy Avigad, Mario Carneiro
|
||||
-/
|
||||
|
||||
prelude
|
||||
import Init.Data.Int.DivMod
|
||||
import Init.Data.Int.Order
|
||||
import Init.Data.Nat.Dvd
|
||||
import Init.RCases
|
||||
import Init.TacticsExtra
|
||||
|
||||
/-!
|
||||
# Lemmas about integer division needed to bootstrap `omega`.
|
||||
-/
|
||||
|
||||
|
||||
open Nat (succ)
|
||||
|
||||
namespace Int
|
||||
|
||||
/-! ### `/` -/
|
||||
|
||||
@[simp] theorem ofNat_ediv (m n : Nat) : (↑(m / n) : Int) = ↑m / ↑n := rfl
|
||||
|
||||
@[simp] theorem zero_ediv : ∀ b : Int, 0 / b = 0
|
||||
| ofNat _ => show ofNat _ = _ by simp
|
||||
| -[_+1] => show -ofNat _ = _ by simp
|
||||
|
||||
@[simp] protected theorem ediv_zero : ∀ a : Int, a / 0 = 0
|
||||
| ofNat _ => show ofNat _ = _ by simp
|
||||
| -[_+1] => rfl
|
||||
|
||||
|
||||
@[simp] protected theorem ediv_neg : ∀ a b : Int, a / (-b) = -(a / b)
|
||||
| ofNat m, 0 => show ofNat (m / 0) = -↑(m / 0) by rw [Nat.div_zero]; rfl
|
||||
| ofNat m, -[n+1] => (Int.neg_neg _).symm
|
||||
| ofNat m, succ n | -[m+1], 0 | -[m+1], succ n | -[m+1], -[n+1] => rfl
|
||||
|
||||
protected theorem div_def (a b : Int) : a / b = Int.ediv a b := rfl
|
||||
|
||||
theorem add_mul_ediv_right (a b : Int) {c : Int} (H : c ≠ 0) : (a + b * c) / c = a / c + b :=
|
||||
suffices ∀ {{a b c : Int}}, 0 < c → (a + b * c).ediv c = a.ediv c + b from
|
||||
match Int.lt_trichotomy c 0 with
|
||||
| Or.inl hlt => by
|
||||
rw [← Int.neg_inj, ← Int.ediv_neg, Int.neg_add, ← Int.ediv_neg, ← Int.neg_mul_neg]
|
||||
exact this (Int.neg_pos_of_neg hlt)
|
||||
| Or.inr (Or.inl HEq) => absurd HEq H
|
||||
| Or.inr (Or.inr hgt) => this hgt
|
||||
suffices ∀ {k n : Nat} {a : Int}, (a + n * k.succ).ediv k.succ = a.ediv k.succ + n from
|
||||
fun a b c H => match c, eq_succ_of_zero_lt H, b with
|
||||
| _, ⟨_, rfl⟩, ofNat _ => this
|
||||
| _, ⟨k, rfl⟩, -[n+1] => show (a - n.succ * k.succ).ediv k.succ = a.ediv k.succ - n.succ by
|
||||
rw [← Int.add_sub_cancel (ediv ..), ← this, Int.sub_add_cancel]
|
||||
fun {k n} => @fun
|
||||
| ofNat m => congrArg ofNat <| Nat.add_mul_div_right _ _ k.succ_pos
|
||||
| -[m+1] => by
|
||||
show ((n * k.succ : Nat) - m.succ : Int).ediv k.succ = n - (m / k.succ + 1 : Nat)
|
||||
if h : m < n * k.succ then
|
||||
rw [← Int.ofNat_sub h, ← Int.ofNat_sub ((Nat.div_lt_iff_lt_mul k.succ_pos).2 h)]
|
||||
apply congrArg ofNat
|
||||
rw [Nat.mul_comm, Nat.mul_sub_div]; rwa [Nat.mul_comm]
|
||||
else
|
||||
have h := Nat.not_lt.1 h
|
||||
have H {a b : Nat} (h : a ≤ b) : (a : Int) + -((b : Int) + 1) = -[b - a +1] := by
|
||||
rw [negSucc_eq, Int.ofNat_sub h]
|
||||
simp only [Int.sub_eq_add_neg, Int.neg_add, Int.neg_neg, Int.add_left_comm, Int.add_assoc]
|
||||
show ediv (↑(n * succ k) + -((m : Int) + 1)) (succ k) = n + -(↑(m / succ k) + 1 : Int)
|
||||
rw [H h, H ((Nat.le_div_iff_mul_le k.succ_pos).2 h)]
|
||||
apply congrArg negSucc
|
||||
rw [Nat.mul_comm, Nat.sub_mul_div]; rwa [Nat.mul_comm]
|
||||
|
||||
theorem add_ediv_of_dvd_right {a b c : Int} (H : c ∣ b) : (a + b) / c = a / c + b / c :=
|
||||
if h : c = 0 then by simp [h] else by
|
||||
let ⟨k, hk⟩ := H
|
||||
rw [hk, Int.mul_comm c k, Int.add_mul_ediv_right _ _ h,
|
||||
← Int.zero_add (k * c), Int.add_mul_ediv_right _ _ h, Int.zero_ediv, Int.zero_add]
|
||||
|
||||
theorem add_ediv_of_dvd_left {a b c : Int} (H : c ∣ a) : (a + b) / c = a / c + b / c := by
|
||||
rw [Int.add_comm, Int.add_ediv_of_dvd_right H, Int.add_comm]
|
||||
|
||||
@[simp] theorem mul_ediv_cancel (a : Int) {b : Int} (H : b ≠ 0) : (a * b) / b = a := by
|
||||
have := Int.add_mul_ediv_right 0 a H
|
||||
rwa [Int.zero_add, Int.zero_ediv, Int.zero_add] at this
|
||||
|
||||
@[simp] theorem mul_ediv_cancel_left (b : Int) (H : a ≠ 0) : (a * b) / a = b :=
|
||||
Int.mul_comm .. ▸ Int.mul_ediv_cancel _ H
|
||||
|
||||
theorem div_nonneg_iff_of_pos {a b : Int} (h : 0 < b) : a / b ≥ 0 ↔ a ≥ 0 := by
|
||||
rw [Int.div_def]
|
||||
match b, h with
|
||||
| Int.ofNat (b+1), _ =>
|
||||
rcases a with ⟨a⟩ <;> simp [Int.ediv]
|
||||
exact decide_eq_decide.mp rfl
|
||||
|
||||
/-! ### mod -/
|
||||
|
||||
theorem mod_def' (m n : Int) : m % n = emod m n := rfl
|
||||
|
||||
theorem ofNat_mod (m n : Nat) : (↑(m % n) : Int) = mod m n := rfl
|
||||
|
||||
theorem ofNat_mod_ofNat (m n : Nat) : (m % n : Int) = ↑(m % n) := rfl
|
||||
|
||||
@[simp] theorem ofNat_emod (m n : Nat) : (↑(m % n) : Int) = m % n := rfl
|
||||
|
||||
@[simp] theorem zero_emod (b : Int) : 0 % b = 0 := by simp [mod_def', emod]
|
||||
|
||||
@[simp] theorem emod_zero : ∀ a : Int, a % 0 = a
|
||||
| ofNat _ => congrArg ofNat <| Nat.mod_zero _
|
||||
| -[_+1] => congrArg negSucc <| Nat.mod_zero _
|
||||
|
||||
theorem emod_add_ediv : ∀ a b : Int, a % b + b * (a / b) = a
|
||||
| ofNat _, ofNat _ => congrArg ofNat <| Nat.mod_add_div ..
|
||||
| ofNat m, -[n+1] => by
|
||||
show (m % succ n + -↑(succ n) * -↑(m / succ n) : Int) = m
|
||||
rw [Int.neg_mul_neg]; exact congrArg ofNat <| Nat.mod_add_div ..
|
||||
| -[_+1], 0 => by rw [emod_zero]; rfl
|
||||
| -[m+1], succ n => aux m n.succ
|
||||
| -[m+1], -[n+1] => aux m n.succ
|
||||
where
|
||||
aux (m n : Nat) : n - (m % n + 1) - (n * (m / n) + n) = -[m+1] := by
|
||||
rw [← ofNat_emod, ← ofNat_ediv, ← Int.sub_sub, negSucc_eq, Int.sub_sub n,
|
||||
← Int.neg_neg (_-_), Int.neg_sub, Int.sub_sub_self, Int.add_right_comm]
|
||||
exact congrArg (fun x => -(ofNat x + 1)) (Nat.mod_add_div ..)
|
||||
|
||||
theorem ediv_add_emod (a b : Int) : b * (a / b) + a % b = a :=
|
||||
(Int.add_comm ..).trans (emod_add_ediv ..)
|
||||
|
||||
theorem emod_def (a b : Int) : a % b = a - b * (a / b) := by
|
||||
rw [← Int.add_sub_cancel (a % b), emod_add_ediv]
|
||||
|
||||
theorem emod_nonneg : ∀ (a : Int) {b : Int}, b ≠ 0 → 0 ≤ a % b
|
||||
| ofNat _, _, _ => ofNat_zero_le _
|
||||
| -[_+1], _, H => Int.sub_nonneg_of_le <| ofNat_le.2 <| Nat.mod_lt _ (natAbs_pos.2 H)
|
||||
|
||||
theorem emod_lt_of_pos (a : Int) {b : Int} (H : 0 < b) : a % b < b :=
|
||||
match a, b, eq_succ_of_zero_lt H with
|
||||
| ofNat _, _, ⟨_, rfl⟩ => ofNat_lt.2 (Nat.mod_lt _ (Nat.succ_pos _))
|
||||
| -[_+1], _, ⟨_, rfl⟩ => Int.sub_lt_self _ (ofNat_lt.2 <| Nat.succ_pos _)
|
||||
|
||||
theorem mul_ediv_self_le {x k : Int} (h : k ≠ 0) : k * (x / k) ≤ x :=
|
||||
calc k * (x / k)
|
||||
_ ≤ k * (x / k) + x % k := Int.le_add_of_nonneg_right (emod_nonneg x h)
|
||||
_ = x := ediv_add_emod _ _
|
||||
|
||||
theorem lt_mul_ediv_self_add {x k : Int} (h : 0 < k) : x < k * (x / k) + k :=
|
||||
calc x
|
||||
_ = k * (x / k) + x % k := (ediv_add_emod _ _).symm
|
||||
_ < k * (x / k) + k := Int.add_lt_add_left (emod_lt_of_pos x h) _
|
||||
|
||||
theorem emod_add_ediv' (m k : Int) : m % k + m / k * k = m := by
|
||||
rw [Int.mul_comm]; apply emod_add_ediv
|
||||
|
||||
@[simp] theorem add_mul_emod_self {a b c : Int} : (a + b * c) % c = a % c :=
|
||||
if cz : c = 0 then by
|
||||
rw [cz, Int.mul_zero, Int.add_zero]
|
||||
else by
|
||||
rw [Int.emod_def, Int.emod_def, Int.add_mul_ediv_right _ _ cz, Int.add_comm _ b,
|
||||
Int.mul_add, Int.mul_comm, ← Int.sub_sub, Int.add_sub_cancel]
|
||||
|
||||
@[simp] theorem add_mul_emod_self_left (a b c : Int) : (a + b * c) % b = a % b := by
|
||||
rw [Int.mul_comm, Int.add_mul_emod_self]
|
||||
|
||||
@[simp] theorem add_emod_self {a b : Int} : (a + b) % b = a % b := by
|
||||
have := add_mul_emod_self_left a b 1; rwa [Int.mul_one] at this
|
||||
|
||||
@[simp] theorem add_emod_self_left {a b : Int} : (a + b) % a = b % a := by
|
||||
rw [Int.add_comm, Int.add_emod_self]
|
||||
|
||||
theorem neg_emod {a b : Int} : -a % b = (b - a) % b := by
|
||||
rw [← add_emod_self_left]; rfl
|
||||
|
||||
@[simp] theorem emod_add_emod (m n k : Int) : (m % n + k) % n = (m + k) % n := by
|
||||
have := (add_mul_emod_self_left (m % n + k) n (m / n)).symm
|
||||
rwa [Int.add_right_comm, emod_add_ediv] at this
|
||||
|
||||
@[simp] theorem add_emod_emod (m n k : Int) : (m + n % k) % k = (m + n) % k := by
|
||||
rw [Int.add_comm, emod_add_emod, Int.add_comm]
|
||||
|
||||
theorem add_emod (a b n : Int) : (a + b) % n = (a % n + b % n) % n := by
|
||||
rw [add_emod_emod, emod_add_emod]
|
||||
|
||||
theorem add_emod_eq_add_emod_right {m n k : Int} (i : Int)
|
||||
(H : m % n = k % n) : (m + i) % n = (k + i) % n := by
|
||||
rw [← emod_add_emod, ← emod_add_emod k, H]
|
||||
|
||||
theorem emod_add_cancel_right {m n k : Int} (i) : (m + i) % n = (k + i) % n ↔ m % n = k % n :=
|
||||
⟨fun H => by
|
||||
have := add_emod_eq_add_emod_right (-i) H
|
||||
rwa [Int.add_neg_cancel_right, Int.add_neg_cancel_right] at this,
|
||||
add_emod_eq_add_emod_right _⟩
|
||||
|
||||
@[simp] theorem mul_emod_left (a b : Int) : (a * b) % b = 0 := by
|
||||
rw [← Int.zero_add (a * b), Int.add_mul_emod_self, Int.zero_emod]
|
||||
|
||||
@[simp] theorem mul_emod_right (a b : Int) : (a * b) % a = 0 := by
|
||||
rw [Int.mul_comm, mul_emod_left]
|
||||
|
||||
theorem mul_emod (a b n : Int) : (a * b) % n = (a % n) * (b % n) % n := by
|
||||
conv => lhs; rw [
|
||||
← emod_add_ediv a n, ← emod_add_ediv' b n, Int.add_mul, Int.mul_add, Int.mul_add,
|
||||
Int.mul_assoc, Int.mul_assoc, ← Int.mul_add n _ _, add_mul_emod_self_left,
|
||||
← Int.mul_assoc, add_mul_emod_self]
|
||||
|
||||
@[local simp] theorem emod_self {a : Int} : a % a = 0 := by
|
||||
have := mul_emod_left 1 a; rwa [Int.one_mul] at this
|
||||
|
||||
@[simp] theorem emod_emod_of_dvd (n : Int) {m k : Int}
|
||||
(h : m ∣ k) : (n % k) % m = n % m := by
|
||||
conv => rhs; rw [← emod_add_ediv n k]
|
||||
match k, h with
|
||||
| _, ⟨t, rfl⟩ => rw [Int.mul_assoc, add_mul_emod_self_left]
|
||||
|
||||
@[simp] theorem emod_emod (a b : Int) : (a % b) % b = a % b := by
|
||||
conv => rhs; rw [← emod_add_ediv a b, add_mul_emod_self_left]
|
||||
|
||||
theorem sub_emod (a b n : Int) : (a - b) % n = (a % n - b % n) % n := by
|
||||
apply (emod_add_cancel_right b).mp
|
||||
rw [Int.sub_add_cancel, ← Int.add_emod_emod, Int.sub_add_cancel, emod_emod]
|
||||
|
||||
/-! ### properties of `/` and `%` -/
|
||||
|
||||
theorem mul_ediv_cancel_of_emod_eq_zero {a b : Int} (H : a % b = 0) : b * (a / b) = a := by
|
||||
have := emod_add_ediv a b; rwa [H, Int.zero_add] at this
|
||||
|
||||
theorem ediv_mul_cancel_of_emod_eq_zero {a b : Int} (H : a % b = 0) : a / b * b = a := by
|
||||
rw [Int.mul_comm, mul_ediv_cancel_of_emod_eq_zero H]
|
||||
|
||||
/-! ### dvd -/
|
||||
|
||||
protected theorem dvd_zero (n : Int) : n ∣ 0 := ⟨0, (Int.mul_zero _).symm⟩
|
||||
|
||||
protected theorem dvd_refl (n : Int) : n ∣ n := ⟨1, (Int.mul_one _).symm⟩
|
||||
|
||||
protected theorem one_dvd (n : Int) : 1 ∣ n := ⟨n, (Int.one_mul n).symm⟩
|
||||
|
||||
protected theorem dvd_trans : ∀ {a b c : Int}, a ∣ b → b ∣ c → a ∣ c
|
||||
| _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d * e, by rw [Int.mul_assoc]⟩
|
||||
|
||||
@[simp] protected theorem zero_dvd {n : Int} : 0 ∣ n ↔ n = 0 :=
|
||||
⟨fun ⟨k, e⟩ => by rw [e, Int.zero_mul], fun h => h.symm ▸ Int.dvd_refl _⟩
|
||||
|
||||
protected theorem neg_dvd {a b : Int} : -a ∣ b ↔ a ∣ b := by
|
||||
constructor <;> exact fun ⟨k, e⟩ =>
|
||||
⟨-k, by simp [e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩
|
||||
|
||||
protected theorem dvd_neg {a b : Int} : a ∣ -b ↔ a ∣ b := by
|
||||
constructor <;> exact fun ⟨k, e⟩ =>
|
||||
⟨-k, by simp [← e, Int.neg_mul, Int.mul_neg, Int.neg_neg]⟩
|
||||
|
||||
protected theorem dvd_mul_right (a b : Int) : a ∣ a * b := ⟨_, rfl⟩
|
||||
|
||||
protected theorem dvd_mul_left (a b : Int) : b ∣ a * b := ⟨_, Int.mul_comm ..⟩
|
||||
|
||||
protected theorem dvd_add : ∀ {a b c : Int}, a ∣ b → a ∣ c → a ∣ b + c
|
||||
| _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d + e, by rw [Int.mul_add]⟩
|
||||
|
||||
protected theorem dvd_sub : ∀ {a b c : Int}, a ∣ b → a ∣ c → a ∣ b - c
|
||||
| _, _, _, ⟨d, rfl⟩, ⟨e, rfl⟩ => ⟨d - e, by rw [Int.mul_sub]⟩
|
||||
|
||||
|
||||
theorem ofNat_dvd {m n : Nat} : (↑m : Int) ∣ ↑n ↔ m ∣ n := by
|
||||
refine ⟨fun ⟨a, ae⟩ => ?_, fun ⟨k, e⟩ => ⟨k, by rw [e, Int.ofNat_mul]⟩⟩
|
||||
match Int.le_total a 0 with
|
||||
| .inl h =>
|
||||
have := ae.symm ▸ Int.mul_nonpos_of_nonneg_of_nonpos (ofNat_zero_le _) h
|
||||
rw [Nat.le_antisymm (ofNat_le.1 this) (Nat.zero_le _)]
|
||||
apply Nat.dvd_zero
|
||||
| .inr h => match a, eq_ofNat_of_zero_le h with
|
||||
| _, ⟨k, rfl⟩ => exact ⟨k, Int.ofNat.inj ae⟩
|
||||
|
||||
@[simp] theorem natAbs_dvd_natAbs {a b : Int} : natAbs a ∣ natAbs b ↔ a ∣ b := by
|
||||
refine ⟨fun ⟨k, hk⟩ => ?_, fun ⟨k, hk⟩ => ⟨natAbs k, hk.symm ▸ natAbs_mul a k⟩⟩
|
||||
rw [← natAbs_ofNat k, ← natAbs_mul, natAbs_eq_natAbs_iff] at hk
|
||||
cases hk <;> subst b
|
||||
· apply Int.dvd_mul_right
|
||||
· rw [← Int.mul_neg]; apply Int.dvd_mul_right
|
||||
|
||||
theorem ofNat_dvd_left {n : Nat} {z : Int} : (↑n : Int) ∣ z ↔ n ∣ z.natAbs := by
|
||||
rw [← natAbs_dvd_natAbs, natAbs_ofNat]
|
||||
|
||||
theorem dvd_of_emod_eq_zero {a b : Int} (H : b % a = 0) : a ∣ b :=
|
||||
⟨b / a, (mul_ediv_cancel_of_emod_eq_zero H).symm⟩
|
||||
|
||||
theorem dvd_emod_sub_self {x : Int} {m : Nat} : (m : Int) ∣ x % m - x := by
|
||||
apply dvd_of_emod_eq_zero
|
||||
simp [sub_emod]
|
||||
|
||||
theorem emod_eq_zero_of_dvd : ∀ {a b : Int}, a ∣ b → b % a = 0
|
||||
| _, _, ⟨_, rfl⟩ => mul_emod_right ..
|
||||
|
||||
theorem dvd_iff_emod_eq_zero (a b : Int) : a ∣ b ↔ b % a = 0 :=
|
||||
⟨emod_eq_zero_of_dvd, dvd_of_emod_eq_zero⟩
|
||||
|
||||
theorem emod_pos_of_not_dvd {a b : Int} (h : ¬ a ∣ b) : a = 0 ∨ 0 < b % a := by
|
||||
rw [dvd_iff_emod_eq_zero] at h
|
||||
if w : a = 0 then simp_all
|
||||
else exact Or.inr (Int.lt_iff_le_and_ne.mpr ⟨emod_nonneg b w, Ne.symm h⟩)
|
||||
|
||||
instance decidableDvd : DecidableRel (α := Int) (· ∣ ·) := fun _ _ =>
|
||||
decidable_of_decidable_of_iff (dvd_iff_emod_eq_zero ..).symm
|
||||
|
||||
protected theorem ediv_mul_cancel {a b : Int} (H : b ∣ a) : a / b * b = a :=
|
||||
ediv_mul_cancel_of_emod_eq_zero (emod_eq_zero_of_dvd H)
|
||||
|
||||
protected theorem mul_ediv_cancel' {a b : Int} (H : a ∣ b) : a * (b / a) = b := by
|
||||
rw [Int.mul_comm, Int.ediv_mul_cancel H]
|
||||
|
||||
protected theorem mul_ediv_assoc (a : Int) : ∀ {b c : Int}, c ∣ b → (a * b) / c = a * (b / c)
|
||||
| _, c, ⟨d, rfl⟩ =>
|
||||
if cz : c = 0 then by simp [cz, Int.mul_zero] else by
|
||||
rw [Int.mul_left_comm, Int.mul_ediv_cancel_left _ cz, Int.mul_ediv_cancel_left _ cz]
|
||||
|
||||
protected theorem mul_ediv_assoc' (b : Int) {a c : Int}
|
||||
(h : c ∣ a) : (a * b) / c = a / c * b := by
|
||||
rw [Int.mul_comm, Int.mul_ediv_assoc _ h, Int.mul_comm]
|
||||
|
||||
theorem neg_ediv_of_dvd : ∀ {a b : Int}, b ∣ a → (-a) / b = -(a / b)
|
||||
| _, b, ⟨c, rfl⟩ => by if bz : b = 0 then simp [bz] else
|
||||
rw [Int.neg_mul_eq_mul_neg, Int.mul_ediv_cancel_left _ bz, Int.mul_ediv_cancel_left _ bz]
|
||||
|
||||
theorem sub_ediv_of_dvd (a : Int) {b c : Int}
|
||||
(hcb : c ∣ b) : (a - b) / c = a / c - b / c := by
|
||||
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_ediv_of_dvd_right (Int.dvd_neg.2 hcb)]
|
||||
congr; exact Int.neg_ediv_of_dvd hcb
|
||||
|
||||
/-!
|
||||
# `bmod` ("balanced" mod)
|
||||
|
||||
We use balanced mod in the omega algorithm,
|
||||
to make ±1 coefficients appear in equations without them.
|
||||
-/
|
||||
|
||||
/--
|
||||
Balanced mod, taking values in the range [- m/2, (m - 1)/2].
|
||||
-/
|
||||
def bmod (x : Int) (m : Nat) : Int :=
|
||||
let r := x % m
|
||||
if r < (m + 1) / 2 then
|
||||
r
|
||||
else
|
||||
r - m
|
||||
|
||||
@[simp] theorem bmod_emod : bmod x m % m = x % m := by
|
||||
dsimp [bmod]
|
||||
split <;> simp [Int.sub_emod]
|
||||
@@ -1,17 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2022 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.Basic
|
||||
import Init.Data.Nat.Gcd
|
||||
|
||||
namespace Int
|
||||
|
||||
/-! ## gcd -/
|
||||
|
||||
/-- Computes the greatest common divisor of two integers, as a `Nat`. -/
|
||||
def gcd (m n : Int) : Nat := m.natAbs.gcd n.natAbs
|
||||
|
||||
end Int
|
||||
@@ -1,500 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.Basic
|
||||
import Init.Conv
|
||||
import Init.PropLemmas
|
||||
|
||||
namespace Int
|
||||
|
||||
open Nat
|
||||
|
||||
/-! ## Definitions of basic functions -/
|
||||
|
||||
theorem subNatNat_of_sub_eq_zero {m n : Nat} (h : n - m = 0) : subNatNat m n = ↑(m - n) := by
|
||||
rw [subNatNat, h, ofNat_eq_coe]
|
||||
|
||||
theorem subNatNat_of_sub_eq_succ {m n k : Nat} (h : n - m = succ k) : subNatNat m n = -[k+1] := by
|
||||
rw [subNatNat, h]
|
||||
|
||||
@[simp] protected theorem neg_zero : -(0:Int) = 0 := rfl
|
||||
|
||||
theorem ofNat_add (n m : Nat) : (↑(n + m) : Int) = n + m := rfl
|
||||
theorem ofNat_mul (n m : Nat) : (↑(n * m) : Int) = n * m := rfl
|
||||
theorem ofNat_succ (n : Nat) : (succ n : Int) = n + 1 := rfl
|
||||
|
||||
@[local simp] theorem neg_ofNat_zero : -((0 : Nat) : Int) = 0 := rfl
|
||||
@[local simp] theorem neg_ofNat_succ (n : Nat) : -(succ n : Int) = -[n+1] := rfl
|
||||
@[local simp] theorem neg_negSucc (n : Nat) : -(-[n+1]) = succ n := rfl
|
||||
|
||||
theorem negSucc_coe (n : Nat) : -[n+1] = -↑(n + 1) := rfl
|
||||
|
||||
theorem negOfNat_eq : negOfNat n = -ofNat n := rfl
|
||||
|
||||
/-! ## These are only for internal use -/
|
||||
|
||||
@[simp] theorem add_def {a b : Int} : Int.add a b = a + b := rfl
|
||||
|
||||
@[local simp] theorem ofNat_add_ofNat (m n : Nat) : (↑m + ↑n : Int) = ↑(m + n) := rfl
|
||||
@[local simp] theorem ofNat_add_negSucc (m n : Nat) : ↑m + -[n+1] = subNatNat m (succ n) := rfl
|
||||
@[local simp] theorem negSucc_add_ofNat (m n : Nat) : -[m+1] + ↑n = subNatNat n (succ m) := rfl
|
||||
@[local simp] theorem negSucc_add_negSucc (m n : Nat) : -[m+1] + -[n+1] = -[succ (m + n) +1] := rfl
|
||||
|
||||
@[simp] theorem mul_def {a b : Int} : Int.mul a b = a * b := rfl
|
||||
|
||||
@[local simp] theorem ofNat_mul_ofNat (m n : Nat) : (↑m * ↑n : Int) = ↑(m * n) := rfl
|
||||
@[local simp] theorem ofNat_mul_negSucc' (m n : Nat) : ↑m * -[n+1] = negOfNat (m * succ n) := rfl
|
||||
@[local simp] theorem negSucc_mul_ofNat' (m n : Nat) : -[m+1] * ↑n = negOfNat (succ m * n) := rfl
|
||||
@[local simp] theorem negSucc_mul_negSucc' (m n : Nat) :
|
||||
-[m+1] * -[n+1] = ofNat (succ m * succ n) := rfl
|
||||
|
||||
/- ## some basic functions and properties -/
|
||||
|
||||
theorem ofNat_inj : ((m : Nat) : Int) = (n : Nat) ↔ m = n := ⟨ofNat.inj, congrArg _⟩
|
||||
|
||||
theorem ofNat_eq_zero : ((n : Nat) : Int) = 0 ↔ n = 0 := ofNat_inj
|
||||
|
||||
theorem ofNat_ne_zero : ((n : Nat) : Int) ≠ 0 ↔ n ≠ 0 := not_congr ofNat_eq_zero
|
||||
|
||||
theorem negSucc_inj : negSucc m = negSucc n ↔ m = n := ⟨negSucc.inj, fun H => by simp [H]⟩
|
||||
|
||||
theorem negSucc_eq (n : Nat) : -[n+1] = -((n : Int) + 1) := rfl
|
||||
|
||||
@[simp] theorem negSucc_ne_zero (n : Nat) : -[n+1] ≠ 0 := nofun
|
||||
|
||||
@[simp] theorem zero_ne_negSucc (n : Nat) : 0 ≠ -[n+1] := nofun
|
||||
|
||||
@[simp] theorem Nat.cast_ofNat_Int :
|
||||
(Nat.cast (no_index (OfNat.ofNat n)) : Int) = OfNat.ofNat n := rfl
|
||||
|
||||
/- ## neg -/
|
||||
|
||||
@[simp] protected theorem neg_neg : ∀ a : Int, -(-a) = a
|
||||
| 0 => rfl
|
||||
| succ _ => rfl
|
||||
| -[_+1] => rfl
|
||||
|
||||
protected theorem neg_inj {a b : Int} : -a = -b ↔ a = b :=
|
||||
⟨fun h => by rw [← Int.neg_neg a, ← Int.neg_neg b, h], congrArg _⟩
|
||||
|
||||
@[simp] protected theorem neg_eq_zero : -a = 0 ↔ a = 0 := Int.neg_inj (b := 0)
|
||||
|
||||
protected theorem neg_ne_zero : -a ≠ 0 ↔ a ≠ 0 := not_congr Int.neg_eq_zero
|
||||
|
||||
protected theorem sub_eq_add_neg {a b : Int} : a - b = a + -b := rfl
|
||||
|
||||
theorem add_neg_one (i : Int) : i + -1 = i - 1 := rfl
|
||||
|
||||
/- ## basic properties of subNatNat -/
|
||||
|
||||
-- @[elabAsElim] -- TODO(Mario): unexpected eliminator resulting type
|
||||
theorem subNatNat_elim (m n : Nat) (motive : Nat → Nat → Int → Prop)
|
||||
(hp : ∀ i n, motive (n + i) n i)
|
||||
(hn : ∀ i m, motive m (m + i + 1) -[i+1]) :
|
||||
motive m n (subNatNat m n) := by
|
||||
unfold subNatNat
|
||||
match h : n - m with
|
||||
| 0 =>
|
||||
have ⟨k, h⟩ := Nat.le.dest (Nat.le_of_sub_eq_zero h)
|
||||
rw [h.symm, Nat.add_sub_cancel_left]; apply hp
|
||||
| succ k =>
|
||||
rw [Nat.sub_eq_iff_eq_add (Nat.le_of_lt (Nat.lt_of_sub_eq_succ h))] at h
|
||||
rw [h, Nat.add_comm]; apply hn
|
||||
|
||||
theorem subNatNat_add_left : subNatNat (m + n) m = n := by
|
||||
unfold subNatNat
|
||||
rw [Nat.sub_eq_zero_of_le (Nat.le_add_right ..), Nat.add_sub_cancel_left, ofNat_eq_coe]
|
||||
|
||||
theorem subNatNat_add_right : subNatNat m (m + n + 1) = negSucc n := by
|
||||
simp [subNatNat, Nat.add_assoc, Nat.add_sub_cancel_left]
|
||||
|
||||
theorem subNatNat_add_add (m n k : Nat) : subNatNat (m + k) (n + k) = subNatNat m n := by
|
||||
apply subNatNat_elim m n (fun m n i => subNatNat (m + k) (n + k) = i)
|
||||
focus
|
||||
intro i j
|
||||
rw [Nat.add_assoc, Nat.add_comm i k, ← Nat.add_assoc]
|
||||
exact subNatNat_add_left
|
||||
focus
|
||||
intro i j
|
||||
rw [Nat.add_assoc j i 1, Nat.add_comm j (i+1), Nat.add_assoc, Nat.add_comm (i+1) (j+k)]
|
||||
exact subNatNat_add_right
|
||||
|
||||
theorem subNatNat_of_le {m n : Nat} (h : n ≤ m) : subNatNat m n = ↑(m - n) :=
|
||||
subNatNat_of_sub_eq_zero (Nat.sub_eq_zero_of_le h)
|
||||
|
||||
theorem subNatNat_of_lt {m n : Nat} (h : m < n) : subNatNat m n = -[pred (n - m) +1] :=
|
||||
subNatNat_of_sub_eq_succ <| (Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)).symm
|
||||
|
||||
/- # Additive group properties -/
|
||||
|
||||
/- addition -/
|
||||
|
||||
protected theorem add_comm : ∀ a b : Int, a + b = b + a
|
||||
| ofNat n, ofNat m => by simp [Nat.add_comm]
|
||||
| ofNat _, -[_+1] => rfl
|
||||
| -[_+1], ofNat _ => rfl
|
||||
| -[_+1], -[_+1] => by simp [Nat.add_comm]
|
||||
|
||||
@[simp] protected theorem add_zero : ∀ a : Int, a + 0 = a
|
||||
| ofNat _ => rfl
|
||||
| -[_+1] => rfl
|
||||
|
||||
@[simp] protected theorem zero_add (a : Int) : 0 + a = a := Int.add_comm .. ▸ a.add_zero
|
||||
|
||||
theorem ofNat_add_negSucc_of_lt (h : m < n.succ) : ofNat m + -[n+1] = -[n - m+1] :=
|
||||
show subNatNat .. = _ by simp [succ_sub (le_of_lt_succ h), subNatNat]
|
||||
|
||||
theorem subNatNat_sub (h : n ≤ m) (k : Nat) : subNatNat (m - n) k = subNatNat m (k + n) := by
|
||||
rwa [← subNatNat_add_add _ _ n, Nat.sub_add_cancel]
|
||||
|
||||
theorem subNatNat_add (m n k : Nat) : subNatNat (m + n) k = m + subNatNat n k := by
|
||||
cases n.lt_or_ge k with
|
||||
| inl h' =>
|
||||
simp [subNatNat_of_lt h', succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')]
|
||||
conv => lhs; rw [← Nat.sub_add_cancel (Nat.le_of_lt h')]
|
||||
apply subNatNat_add_add
|
||||
| inr h' => simp [subNatNat_of_le h',
|
||||
subNatNat_of_le (Nat.le_trans h' (le_add_left ..)), Nat.add_sub_assoc h']
|
||||
|
||||
theorem subNatNat_add_negSucc (m n k : Nat) :
|
||||
subNatNat m n + -[k+1] = subNatNat m (n + succ k) := by
|
||||
have h := Nat.lt_or_ge m n
|
||||
cases h with
|
||||
| inr h' =>
|
||||
rw [subNatNat_of_le h']
|
||||
simp
|
||||
rw [subNatNat_sub h', Nat.add_comm]
|
||||
| inl h' =>
|
||||
have h₂ : m < n + succ k := Nat.lt_of_lt_of_le h' (le_add_right _ _)
|
||||
have h₃ : m ≤ n + k := le_of_succ_le_succ h₂
|
||||
rw [subNatNat_of_lt h', subNatNat_of_lt h₂]
|
||||
simp [Nat.add_comm]
|
||||
rw [← add_succ, succ_pred_eq_of_pos (Nat.sub_pos_of_lt h'), add_succ, succ_sub h₃,
|
||||
Nat.pred_succ]
|
||||
rw [Nat.add_comm n, Nat.add_sub_assoc (Nat.le_of_lt h')]
|
||||
|
||||
protected theorem add_assoc : ∀ a b c : Int, a + b + c = a + (b + c)
|
||||
| (m:Nat), (n:Nat), c => aux1 ..
|
||||
| Nat.cast m, b, Nat.cast k => by
|
||||
rw [Int.add_comm, ← aux1, Int.add_comm k, aux1, Int.add_comm b]
|
||||
| a, (n:Nat), (k:Nat) => by
|
||||
rw [Int.add_comm, Int.add_comm a, ← aux1, Int.add_comm a, Int.add_comm k]
|
||||
| -[m+1], -[n+1], (k:Nat) => aux2 ..
|
||||
| -[m+1], (n:Nat), -[k+1] => by
|
||||
rw [Int.add_comm, ← aux2, Int.add_comm n, ← aux2, Int.add_comm -[m+1]]
|
||||
| (m:Nat), -[n+1], -[k+1] => by
|
||||
rw [Int.add_comm, Int.add_comm m, Int.add_comm m, ← aux2, Int.add_comm -[k+1]]
|
||||
| -[m+1], -[n+1], -[k+1] => by
|
||||
simp [add_succ, Nat.add_comm, Nat.add_left_comm, neg_ofNat_succ]
|
||||
where
|
||||
aux1 (m n : Nat) : ∀ c : Int, m + n + c = m + (n + c)
|
||||
| (k:Nat) => by simp [Nat.add_assoc]
|
||||
| -[k+1] => by simp [subNatNat_add]
|
||||
aux2 (m n k : Nat) : -[m+1] + -[n+1] + k = -[m+1] + (-[n+1] + k) := by
|
||||
simp [add_succ]
|
||||
rw [Int.add_comm, subNatNat_add_negSucc]
|
||||
simp [add_succ, succ_add, Nat.add_comm]
|
||||
|
||||
protected theorem add_left_comm (a b c : Int) : a + (b + c) = b + (a + c) := by
|
||||
rw [← Int.add_assoc, Int.add_comm a, Int.add_assoc]
|
||||
|
||||
protected theorem add_right_comm (a b c : Int) : a + b + c = a + c + b := by
|
||||
rw [Int.add_assoc, Int.add_comm b, ← Int.add_assoc]
|
||||
|
||||
/- ## negation -/
|
||||
|
||||
theorem subNatNat_self : ∀ n, subNatNat n n = 0
|
||||
| 0 => rfl
|
||||
| succ m => by rw [subNatNat_of_sub_eq_zero (Nat.sub_self ..), Nat.sub_self, ofNat_zero]
|
||||
|
||||
attribute [local simp] subNatNat_self
|
||||
|
||||
@[local simp] protected theorem add_left_neg : ∀ a : Int, -a + a = 0
|
||||
| 0 => rfl
|
||||
| succ m => by simp
|
||||
| -[m+1] => by simp
|
||||
|
||||
@[local simp] protected theorem add_right_neg (a : Int) : a + -a = 0 := by
|
||||
rw [Int.add_comm, Int.add_left_neg]
|
||||
|
||||
@[simp] protected theorem neg_eq_of_add_eq_zero {a b : Int} (h : a + b = 0) : -a = b := by
|
||||
rw [← Int.add_zero (-a), ← h, ← Int.add_assoc, Int.add_left_neg, Int.zero_add]
|
||||
|
||||
protected theorem eq_neg_of_eq_neg {a b : Int} (h : a = -b) : b = -a := by
|
||||
rw [h, Int.neg_neg]
|
||||
|
||||
protected theorem eq_neg_comm {a b : Int} : a = -b ↔ b = -a :=
|
||||
⟨Int.eq_neg_of_eq_neg, Int.eq_neg_of_eq_neg⟩
|
||||
|
||||
protected theorem neg_eq_comm {a b : Int} : -a = b ↔ -b = a := by
|
||||
rw [eq_comm, Int.eq_neg_comm, eq_comm]
|
||||
|
||||
protected theorem neg_add_cancel_left (a b : Int) : -a + (a + b) = b := by
|
||||
rw [← Int.add_assoc, Int.add_left_neg, Int.zero_add]
|
||||
|
||||
protected theorem add_neg_cancel_left (a b : Int) : a + (-a + b) = b := by
|
||||
rw [← Int.add_assoc, Int.add_right_neg, Int.zero_add]
|
||||
|
||||
protected theorem add_neg_cancel_right (a b : Int) : a + b + -b = a := by
|
||||
rw [Int.add_assoc, Int.add_right_neg, Int.add_zero]
|
||||
|
||||
protected theorem neg_add_cancel_right (a b : Int) : a + -b + b = a := by
|
||||
rw [Int.add_assoc, Int.add_left_neg, Int.add_zero]
|
||||
|
||||
protected theorem add_left_cancel {a b c : Int} (h : a + b = a + c) : b = c := by
|
||||
have h₁ : -a + (a + b) = -a + (a + c) := by rw [h]
|
||||
simp [← Int.add_assoc, Int.add_left_neg, Int.zero_add] at h₁; exact h₁
|
||||
|
||||
@[local simp] protected theorem neg_add {a b : Int} : -(a + b) = -a + -b := by
|
||||
apply Int.add_left_cancel (a := a + b)
|
||||
rw [Int.add_right_neg, Int.add_comm a, ← Int.add_assoc, Int.add_assoc b,
|
||||
Int.add_right_neg, Int.add_zero, Int.add_right_neg]
|
||||
|
||||
/- ## subtraction -/
|
||||
|
||||
@[simp] theorem negSucc_sub_one (n : Nat) : -[n+1] - 1 = -[n + 1 +1] := rfl
|
||||
|
||||
@[simp] protected theorem sub_self (a : Int) : a - a = 0 := by
|
||||
rw [Int.sub_eq_add_neg, Int.add_right_neg]
|
||||
|
||||
@[simp] protected theorem sub_zero (a : Int) : a - 0 = a := by simp [Int.sub_eq_add_neg]
|
||||
|
||||
@[simp] protected theorem zero_sub (a : Int) : 0 - a = -a := by simp [Int.sub_eq_add_neg]
|
||||
|
||||
protected theorem sub_eq_zero_of_eq {a b : Int} (h : a = b) : a - b = 0 := by
|
||||
rw [h, Int.sub_self]
|
||||
|
||||
protected theorem eq_of_sub_eq_zero {a b : Int} (h : a - b = 0) : a = b := by
|
||||
have : 0 + b = b := by rw [Int.zero_add]
|
||||
have : a - b + b = b := by rwa [h]
|
||||
rwa [Int.sub_eq_add_neg, Int.neg_add_cancel_right] at this
|
||||
|
||||
protected theorem sub_eq_zero {a b : Int} : a - b = 0 ↔ a = b :=
|
||||
⟨Int.eq_of_sub_eq_zero, Int.sub_eq_zero_of_eq⟩
|
||||
|
||||
protected theorem sub_sub (a b c : Int) : a - b - c = a - (b + c) := by
|
||||
simp [Int.sub_eq_add_neg, Int.add_assoc]
|
||||
|
||||
protected theorem neg_sub (a b : Int) : -(a - b) = b - a := by
|
||||
simp [Int.sub_eq_add_neg, Int.add_comm]
|
||||
|
||||
protected theorem sub_sub_self (a b : Int) : a - (a - b) = b := by
|
||||
simp [Int.sub_eq_add_neg, ← Int.add_assoc]
|
||||
|
||||
protected theorem sub_neg (a b : Int) : a - -b = a + b := by simp [Int.sub_eq_add_neg]
|
||||
|
||||
@[simp] protected theorem sub_add_cancel (a b : Int) : a - b + b = a :=
|
||||
Int.neg_add_cancel_right a b
|
||||
|
||||
@[simp] protected theorem add_sub_cancel (a b : Int) : a + b - b = a :=
|
||||
Int.add_neg_cancel_right a b
|
||||
|
||||
protected theorem add_sub_assoc (a b c : Int) : a + b - c = a + (b - c) := by
|
||||
rw [Int.sub_eq_add_neg, Int.add_assoc, ← Int.sub_eq_add_neg]
|
||||
|
||||
theorem ofNat_sub (h : m ≤ n) : ((n - m : Nat) : Int) = n - m := by
|
||||
match m with
|
||||
| 0 => rfl
|
||||
| succ m =>
|
||||
show ofNat (n - succ m) = subNatNat n (succ m)
|
||||
rw [subNatNat, Nat.sub_eq_zero_of_le h]
|
||||
|
||||
theorem negSucc_coe' (n : Nat) : -[n+1] = -↑n - 1 := by
|
||||
rw [Int.sub_eq_add_neg, ← Int.neg_add]; rfl
|
||||
|
||||
protected theorem subNatNat_eq_coe {m n : Nat} : subNatNat m n = ↑m - ↑n := by
|
||||
apply subNatNat_elim m n fun m n i => i = m - n
|
||||
· intros i n
|
||||
rw [Int.ofNat_add, Int.sub_eq_add_neg, Int.add_assoc, Int.add_left_comm,
|
||||
Int.add_right_neg, Int.add_zero]
|
||||
· intros i n
|
||||
simp only [negSucc_coe, ofNat_add, Int.sub_eq_add_neg, Int.neg_add, ← Int.add_assoc]
|
||||
rw [← @Int.sub_eq_add_neg n, ← ofNat_sub, Nat.sub_self, ofNat_zero, Int.zero_add]
|
||||
apply Nat.le_refl
|
||||
|
||||
theorem toNat_sub (m n : Nat) : toNat (m - n) = m - n := by
|
||||
rw [← Int.subNatNat_eq_coe]
|
||||
refine subNatNat_elim m n (fun m n i => toNat i = m - n) (fun i n => ?_) (fun i n => ?_)
|
||||
· exact (Nat.add_sub_cancel_left ..).symm
|
||||
· dsimp; rw [Nat.add_assoc, Nat.sub_eq_zero_of_le (Nat.le_add_right ..)]; rfl
|
||||
|
||||
/- ## Ring properties -/
|
||||
|
||||
@[simp] theorem ofNat_mul_negSucc (m n : Nat) : (m : Int) * -[n+1] = -↑(m * succ n) := rfl
|
||||
|
||||
@[simp] theorem negSucc_mul_ofNat (m n : Nat) : -[m+1] * n = -↑(succ m * n) := rfl
|
||||
|
||||
@[simp] theorem negSucc_mul_negSucc (m n : Nat) : -[m+1] * -[n+1] = succ m * succ n := rfl
|
||||
|
||||
protected theorem mul_comm (a b : Int) : a * b = b * a := by
|
||||
cases a <;> cases b <;> simp [Nat.mul_comm]
|
||||
|
||||
theorem ofNat_mul_negOfNat (m n : Nat) : (m : Nat) * negOfNat n = negOfNat (m * n) := by
|
||||
cases n <;> rfl
|
||||
|
||||
theorem negOfNat_mul_ofNat (m n : Nat) : negOfNat m * (n : Nat) = negOfNat (m * n) := by
|
||||
rw [Int.mul_comm]; simp [ofNat_mul_negOfNat, Nat.mul_comm]
|
||||
|
||||
theorem negSucc_mul_negOfNat (m n : Nat) : -[m+1] * negOfNat n = ofNat (succ m * n) := by
|
||||
cases n <;> rfl
|
||||
|
||||
theorem negOfNat_mul_negSucc (m n : Nat) : negOfNat n * -[m+1] = ofNat (n * succ m) := by
|
||||
rw [Int.mul_comm, negSucc_mul_negOfNat, Nat.mul_comm]
|
||||
|
||||
attribute [local simp] ofNat_mul_negOfNat negOfNat_mul_ofNat
|
||||
negSucc_mul_negOfNat negOfNat_mul_negSucc
|
||||
|
||||
protected theorem mul_assoc (a b c : Int) : a * b * c = a * (b * c) := by
|
||||
cases a <;> cases b <;> cases c <;> simp [Nat.mul_assoc]
|
||||
|
||||
protected theorem mul_left_comm (a b c : Int) : a * (b * c) = b * (a * c) := by
|
||||
rw [← Int.mul_assoc, ← Int.mul_assoc, Int.mul_comm a]
|
||||
|
||||
protected theorem mul_right_comm (a b c : Int) : a * b * c = a * c * b := by
|
||||
rw [Int.mul_assoc, Int.mul_assoc, Int.mul_comm b]
|
||||
|
||||
@[simp] protected theorem mul_zero (a : Int) : a * 0 = 0 := by cases a <;> rfl
|
||||
|
||||
@[simp] protected theorem zero_mul (a : Int) : 0 * a = 0 := Int.mul_comm .. ▸ a.mul_zero
|
||||
|
||||
theorem negOfNat_eq_subNatNat_zero (n) : negOfNat n = subNatNat 0 n := by cases n <;> rfl
|
||||
|
||||
theorem ofNat_mul_subNatNat (m n k : Nat) :
|
||||
m * subNatNat n k = subNatNat (m * n) (m * k) := by
|
||||
cases m with
|
||||
| zero => simp [ofNat_zero, Int.zero_mul, Nat.zero_mul]
|
||||
| succ m => cases n.lt_or_ge k with
|
||||
| inl h =>
|
||||
have h' : succ m * n < succ m * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m)
|
||||
simp [subNatNat_of_lt h, subNatNat_of_lt h']
|
||||
rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), ← neg_ofNat_succ, Nat.mul_sub_left_distrib,
|
||||
← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')]; rfl
|
||||
| inr h =>
|
||||
have h' : succ m * k ≤ succ m * n := Nat.mul_le_mul_left _ h
|
||||
simp [subNatNat_of_le h, subNatNat_of_le h', Nat.mul_sub_left_distrib]
|
||||
|
||||
theorem negOfNat_add (m n : Nat) : negOfNat m + negOfNat n = negOfNat (m + n) := by
|
||||
cases m <;> cases n <;> simp [Nat.succ_add] <;> rfl
|
||||
|
||||
theorem negSucc_mul_subNatNat (m n k : Nat) :
|
||||
-[m+1] * subNatNat n k = subNatNat (succ m * k) (succ m * n) := by
|
||||
cases n.lt_or_ge k with
|
||||
| inl h =>
|
||||
have h' : succ m * n < succ m * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m)
|
||||
rw [subNatNat_of_lt h, subNatNat_of_le (Nat.le_of_lt h')]
|
||||
simp [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), Nat.mul_sub_left_distrib]
|
||||
| inr h => cases Nat.lt_or_ge k n with
|
||||
| inl h' =>
|
||||
have h₁ : succ m * n > succ m * k := Nat.mul_lt_mul_of_pos_left h' (Nat.succ_pos m)
|
||||
rw [subNatNat_of_le h, subNatNat_of_lt h₁, negSucc_mul_ofNat,
|
||||
Nat.mul_sub_left_distrib, ← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁)]; rfl
|
||||
| inr h' => rw [Nat.le_antisymm h h', subNatNat_self, subNatNat_self, Int.mul_zero]
|
||||
|
||||
attribute [local simp] ofNat_mul_subNatNat negOfNat_add negSucc_mul_subNatNat
|
||||
|
||||
protected theorem mul_add : ∀ a b c : Int, a * (b + c) = a * b + a * c
|
||||
| (m:Nat), (n:Nat), (k:Nat) => by simp [Nat.left_distrib]
|
||||
| (m:Nat), (n:Nat), -[k+1] => by
|
||||
simp [negOfNat_eq_subNatNat_zero]; rw [← subNatNat_add]; rfl
|
||||
| (m:Nat), -[n+1], (k:Nat) => by
|
||||
simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ← subNatNat_add]; rfl
|
||||
| (m:Nat), -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, succ_add]; rfl
|
||||
| -[m+1], (n:Nat), (k:Nat) => by simp [Nat.mul_comm]; rw [← Nat.right_distrib, Nat.mul_comm]
|
||||
| -[m+1], (n:Nat), -[k+1] => by
|
||||
simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ← subNatNat_add]; rfl
|
||||
| -[m+1], -[n+1], (k:Nat) => by simp [negOfNat_eq_subNatNat_zero]; rw [← subNatNat_add]; rfl
|
||||
| -[m+1], -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, succ_add]; rfl
|
||||
|
||||
protected theorem add_mul (a b c : Int) : (a + b) * c = a * c + b * c := by
|
||||
simp [Int.mul_comm, Int.mul_add]
|
||||
|
||||
protected theorem neg_mul_eq_neg_mul (a b : Int) : -(a * b) = -a * b :=
|
||||
Int.neg_eq_of_add_eq_zero <| by rw [← Int.add_mul, Int.add_right_neg, Int.zero_mul]
|
||||
|
||||
protected theorem neg_mul_eq_mul_neg (a b : Int) : -(a * b) = a * -b :=
|
||||
Int.neg_eq_of_add_eq_zero <| by rw [← Int.mul_add, Int.add_right_neg, Int.mul_zero]
|
||||
|
||||
@[local simp] protected theorem neg_mul (a b : Int) : -a * b = -(a * b) :=
|
||||
(Int.neg_mul_eq_neg_mul a b).symm
|
||||
|
||||
@[local simp] protected theorem mul_neg (a b : Int) : a * -b = -(a * b) :=
|
||||
(Int.neg_mul_eq_mul_neg a b).symm
|
||||
|
||||
protected theorem neg_mul_neg (a b : Int) : -a * -b = a * b := by simp
|
||||
|
||||
protected theorem neg_mul_comm (a b : Int) : -a * b = a * -b := by simp
|
||||
|
||||
protected theorem mul_sub (a b c : Int) : a * (b - c) = a * b - a * c := by
|
||||
simp [Int.sub_eq_add_neg, Int.mul_add]
|
||||
|
||||
protected theorem sub_mul (a b c : Int) : (a - b) * c = a * c - b * c := by
|
||||
simp [Int.sub_eq_add_neg, Int.add_mul]
|
||||
|
||||
@[simp] protected theorem one_mul : ∀ a : Int, 1 * a = a
|
||||
| ofNat n => show ofNat (1 * n) = ofNat n by rw [Nat.one_mul]
|
||||
| -[n+1] => show -[1 * n +1] = -[n+1] by rw [Nat.one_mul]
|
||||
|
||||
@[simp] protected theorem mul_one (a : Int) : a * 1 = a := by rw [Int.mul_comm, Int.one_mul]
|
||||
|
||||
protected theorem mul_neg_one (a : Int) : a * -1 = -a := by rw [Int.mul_neg, Int.mul_one]
|
||||
|
||||
protected theorem neg_eq_neg_one_mul : ∀ a : Int, -a = -1 * a
|
||||
| 0 => rfl
|
||||
| succ n => show _ = -[1 * n +1] by rw [Nat.one_mul]; rfl
|
||||
| -[n+1] => show _ = ofNat _ by rw [Nat.one_mul]; rfl
|
||||
|
||||
protected theorem mul_eq_zero {a b : Int} : a * b = 0 ↔ a = 0 ∨ b = 0 := by
|
||||
refine ⟨fun h => ?_, fun h => h.elim (by simp [·, Int.zero_mul]) (by simp [·, Int.mul_zero])⟩
|
||||
exact match a, b, h with
|
||||
| .ofNat 0, _, _ => by simp
|
||||
| _, .ofNat 0, _ => by simp
|
||||
| .ofNat (a+1), .negSucc b, h => by cases h
|
||||
|
||||
protected theorem mul_ne_zero {a b : Int} (a0 : a ≠ 0) (b0 : b ≠ 0) : a * b ≠ 0 :=
|
||||
Or.rec a0 b0 ∘ Int.mul_eq_zero.mp
|
||||
|
||||
protected theorem eq_of_mul_eq_mul_right {a b c : Int} (ha : a ≠ 0) (h : b * a = c * a) : b = c :=
|
||||
have : (b - c) * a = 0 := by rwa [Int.sub_mul, Int.sub_eq_zero]
|
||||
Int.sub_eq_zero.1 <| (Int.mul_eq_zero.mp this).resolve_right ha
|
||||
|
||||
protected theorem eq_of_mul_eq_mul_left {a b c : Int} (ha : a ≠ 0) (h : a * b = a * c) : b = c :=
|
||||
have : a * b - a * c = 0 := Int.sub_eq_zero_of_eq h
|
||||
have : a * (b - c) = 0 := by rw [Int.mul_sub, this]
|
||||
have : b - c = 0 := (Int.mul_eq_zero.1 this).resolve_left ha
|
||||
Int.eq_of_sub_eq_zero this
|
||||
|
||||
theorem mul_eq_mul_left_iff {a b c : Int} (h : c ≠ 0) : c * a = c * b ↔ a = b :=
|
||||
⟨Int.eq_of_mul_eq_mul_left h, fun w => congrArg (fun x => c * x) w⟩
|
||||
|
||||
theorem mul_eq_mul_right_iff {a b c : Int} (h : c ≠ 0) : a * c = b * c ↔ a = b :=
|
||||
⟨Int.eq_of_mul_eq_mul_right h, fun w => congrArg (fun x => x * c) w⟩
|
||||
|
||||
theorem eq_one_of_mul_eq_self_left {a b : Int} (Hpos : a ≠ 0) (H : b * a = a) : b = 1 :=
|
||||
Int.eq_of_mul_eq_mul_right Hpos <| by rw [Int.one_mul, H]
|
||||
|
||||
theorem eq_one_of_mul_eq_self_right {a b : Int} (Hpos : b ≠ 0) (H : b * a = b) : a = 1 :=
|
||||
Int.eq_of_mul_eq_mul_left Hpos <| by rw [Int.mul_one, H]
|
||||
|
||||
/-! NatCast lemmas -/
|
||||
|
||||
/-!
|
||||
The following lemmas are later subsumed by e.g. `Nat.cast_add` and `Nat.cast_mul` in Mathlib
|
||||
but it is convenient to have these earlier, for users who only need `Nat` and `Int`.
|
||||
-/
|
||||
|
||||
theorem natCast_zero : ((0 : Nat) : Int) = (0 : Int) := rfl
|
||||
|
||||
theorem natCast_one : ((1 : Nat) : Int) = (1 : Int) := rfl
|
||||
|
||||
@[simp] theorem natCast_add (a b : Nat) : ((a + b : Nat) : Int) = (a : Int) + (b : Int) := by
|
||||
-- Note this only works because of local simp attributes in this file,
|
||||
-- so it still makes sense to tag the lemmas with `@[simp]`.
|
||||
simp
|
||||
|
||||
@[simp] theorem natCast_mul (a b : Nat) : ((a * b : Nat) : Int) = (a : Int) * (b : Int) := by
|
||||
simp
|
||||
|
||||
end Int
|
||||
@@ -1,438 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Int.Lemmas
|
||||
import Init.ByCases
|
||||
|
||||
/-!
|
||||
# Results about the order properties of the integers, and the integers as an ordered ring.
|
||||
-/
|
||||
|
||||
open Nat
|
||||
|
||||
namespace Int
|
||||
|
||||
/-! ## Order properties of the integers -/
|
||||
|
||||
theorem nonneg_def {a : Int} : NonNeg a ↔ ∃ n : Nat, a = n :=
|
||||
⟨fun ⟨n⟩ => ⟨n, rfl⟩, fun h => match a, h with | _, ⟨n, rfl⟩ => ⟨n⟩⟩
|
||||
|
||||
theorem NonNeg.elim {a : Int} : NonNeg a → ∃ n : Nat, a = n := nonneg_def.1
|
||||
|
||||
theorem nonneg_or_nonneg_neg : ∀ (a : Int), NonNeg a ∨ NonNeg (-a)
|
||||
| (_:Nat) => .inl ⟨_⟩
|
||||
| -[_+1] => .inr ⟨_⟩
|
||||
|
||||
theorem le_def (a b : Int) : a ≤ b ↔ NonNeg (b - a) := .rfl
|
||||
|
||||
theorem lt_iff_add_one_le (a b : Int) : a < b ↔ a + 1 ≤ b := .rfl
|
||||
|
||||
theorem le.intro_sub {a b : Int} (n : Nat) (h : b - a = n) : a ≤ b := by
|
||||
simp [le_def, h]; constructor
|
||||
|
||||
attribute [local simp] Int.add_left_neg Int.add_right_neg Int.neg_add
|
||||
|
||||
theorem le.intro {a b : Int} (n : Nat) (h : a + n = b) : a ≤ b :=
|
||||
le.intro_sub n <| by rw [← h, Int.add_comm]; simp [Int.sub_eq_add_neg, Int.add_assoc]
|
||||
|
||||
theorem le.dest_sub {a b : Int} (h : a ≤ b) : ∃ n : Nat, b - a = n := nonneg_def.1 h
|
||||
|
||||
theorem le.dest {a b : Int} (h : a ≤ b) : ∃ n : Nat, a + n = b :=
|
||||
let ⟨n, h₁⟩ := le.dest_sub h
|
||||
⟨n, by rw [← h₁, Int.add_comm]; simp [Int.sub_eq_add_neg, Int.add_assoc]⟩
|
||||
|
||||
protected theorem le_total (a b : Int) : a ≤ b ∨ b ≤ a :=
|
||||
(nonneg_or_nonneg_neg (b - a)).imp_right fun H => by
|
||||
rwa [show -(b - a) = a - b by simp [Int.add_comm, Int.sub_eq_add_neg]] at H
|
||||
|
||||
@[simp] theorem ofNat_le {m n : Nat} : (↑m : Int) ≤ ↑n ↔ m ≤ n :=
|
||||
⟨fun h =>
|
||||
let ⟨k, hk⟩ := le.dest h
|
||||
Nat.le.intro <| Int.ofNat.inj <| (Int.ofNat_add m k).trans hk,
|
||||
fun h =>
|
||||
let ⟨k, (hk : m + k = n)⟩ := Nat.le.dest h
|
||||
le.intro k (by rw [← hk]; rfl)⟩
|
||||
|
||||
theorem ofNat_zero_le (n : Nat) : 0 ≤ (↑n : Int) := ofNat_le.2 n.zero_le
|
||||
|
||||
theorem eq_ofNat_of_zero_le {a : Int} (h : 0 ≤ a) : ∃ n : Nat, a = n := by
|
||||
have t := le.dest_sub h; rwa [Int.sub_zero] at t
|
||||
|
||||
theorem eq_succ_of_zero_lt {a : Int} (h : 0 < a) : ∃ n : Nat, a = n.succ :=
|
||||
let ⟨n, (h : ↑(1 + n) = a)⟩ := le.dest h
|
||||
⟨n, by rw [Nat.add_comm] at h; exact h.symm⟩
|
||||
|
||||
theorem lt_add_succ (a : Int) (n : Nat) : a < a + Nat.succ n :=
|
||||
le.intro n <| by rw [Int.add_comm, Int.add_left_comm]; rfl
|
||||
|
||||
theorem lt.intro {a b : Int} {n : Nat} (h : a + Nat.succ n = b) : a < b :=
|
||||
h ▸ lt_add_succ a n
|
||||
|
||||
theorem lt.dest {a b : Int} (h : a < b) : ∃ n : Nat, a + Nat.succ n = b :=
|
||||
let ⟨n, h⟩ := le.dest h; ⟨n, by rwa [Int.add_comm, Int.add_left_comm] at h⟩
|
||||
|
||||
@[simp] theorem ofNat_lt {n m : Nat} : (↑n : Int) < ↑m ↔ n < m := by
|
||||
rw [lt_iff_add_one_le, ← ofNat_succ, ofNat_le]; rfl
|
||||
|
||||
@[simp] theorem ofNat_pos {n : Nat} : 0 < (↑n : Int) ↔ 0 < n := ofNat_lt
|
||||
|
||||
theorem ofNat_nonneg (n : Nat) : 0 ≤ (n : Int) := ⟨_⟩
|
||||
|
||||
theorem ofNat_succ_pos (n : Nat) : 0 < (succ n : Int) := ofNat_lt.2 <| Nat.succ_pos _
|
||||
|
||||
@[simp] protected theorem le_refl (a : Int) : a ≤ a :=
|
||||
le.intro _ (Int.add_zero a)
|
||||
|
||||
protected theorem le_trans {a b c : Int} (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c :=
|
||||
let ⟨n, hn⟩ := le.dest h₁; let ⟨m, hm⟩ := le.dest h₂
|
||||
le.intro (n + m) <| by rw [← hm, ← hn, Int.add_assoc, ofNat_add]
|
||||
|
||||
protected theorem le_antisymm {a b : Int} (h₁ : a ≤ b) (h₂ : b ≤ a) : a = b := by
|
||||
let ⟨n, hn⟩ := le.dest h₁; let ⟨m, hm⟩ := le.dest h₂
|
||||
have := hn; rw [← hm, Int.add_assoc, ← ofNat_add] at this
|
||||
have := Int.ofNat.inj <| Int.add_left_cancel <| this.trans (Int.add_zero _).symm
|
||||
rw [← hn, Nat.eq_zero_of_add_eq_zero_left this, ofNat_zero, Int.add_zero a]
|
||||
|
||||
protected theorem lt_irrefl (a : Int) : ¬a < a := fun H =>
|
||||
let ⟨n, hn⟩ := lt.dest H
|
||||
have : (a+Nat.succ n) = a+0 := by
|
||||
rw [hn, Int.add_zero]
|
||||
have : Nat.succ n = 0 := Int.ofNat.inj (Int.add_left_cancel this)
|
||||
show False from Nat.succ_ne_zero _ this
|
||||
|
||||
protected theorem ne_of_lt {a b : Int} (h : a < b) : a ≠ b := fun e => by
|
||||
cases e; exact Int.lt_irrefl _ h
|
||||
|
||||
protected theorem ne_of_gt {a b : Int} (h : b < a) : a ≠ b := (Int.ne_of_lt h).symm
|
||||
|
||||
protected theorem le_of_lt {a b : Int} (h : a < b) : a ≤ b :=
|
||||
let ⟨_, hn⟩ := lt.dest h; le.intro _ hn
|
||||
|
||||
protected theorem lt_iff_le_and_ne {a b : Int} : a < b ↔ a ≤ b ∧ a ≠ b := by
|
||||
refine ⟨fun h => ⟨Int.le_of_lt h, Int.ne_of_lt h⟩, fun ⟨aleb, aneb⟩ => ?_⟩
|
||||
let ⟨n, hn⟩ := le.dest aleb
|
||||
have : n ≠ 0 := aneb.imp fun eq => by rw [← hn, eq, ofNat_zero, Int.add_zero]
|
||||
apply lt.intro; rwa [← Nat.succ_pred_eq_of_pos (Nat.pos_of_ne_zero this)] at hn
|
||||
|
||||
theorem lt_succ (a : Int) : a < a + 1 := Int.le_refl _
|
||||
|
||||
protected theorem zero_lt_one : (0 : Int) < 1 := ⟨_⟩
|
||||
|
||||
protected theorem lt_iff_le_not_le {a b : Int} : a < b ↔ a ≤ b ∧ ¬b ≤ a := by
|
||||
rw [Int.lt_iff_le_and_ne]
|
||||
constructor <;> refine fun ⟨h, h'⟩ => ⟨h, h'.imp fun h' => ?_⟩
|
||||
· exact Int.le_antisymm h h'
|
||||
· subst h'; apply Int.le_refl
|
||||
|
||||
protected theorem not_le {a b : Int} : ¬a ≤ b ↔ b < a :=
|
||||
⟨fun h => Int.lt_iff_le_not_le.2 ⟨(Int.le_total ..).resolve_right h, h⟩,
|
||||
fun h => (Int.lt_iff_le_not_le.1 h).2⟩
|
||||
|
||||
protected theorem not_lt {a b : Int} : ¬a < b ↔ b ≤ a :=
|
||||
by rw [← Int.not_le, Decidable.not_not]
|
||||
|
||||
protected theorem lt_trichotomy (a b : Int) : a < b ∨ a = b ∨ b < a :=
|
||||
if eq : a = b then .inr <| .inl eq else
|
||||
if le : a ≤ b then .inl <| Int.lt_iff_le_and_ne.2 ⟨le, eq⟩ else
|
||||
.inr <| .inr <| Int.not_le.1 le
|
||||
|
||||
protected theorem ne_iff_lt_or_gt {a b : Int} : a ≠ b ↔ a < b ∨ b < a := by
|
||||
constructor
|
||||
· intro h
|
||||
cases Int.lt_trichotomy a b
|
||||
case inl lt => exact Or.inl lt
|
||||
case inr h =>
|
||||
cases h
|
||||
case inl =>simp_all
|
||||
case inr gt => exact Or.inr gt
|
||||
· intro h
|
||||
cases h
|
||||
case inl lt => exact Int.ne_of_lt lt
|
||||
case inr gt => exact Int.ne_of_gt gt
|
||||
|
||||
protected theorem lt_or_gt_of_ne {a b : Int} : a ≠ b → a < b ∨ b < a:= Int.ne_iff_lt_or_gt.mp
|
||||
|
||||
protected theorem eq_iff_le_and_ge {x y : Int} : x = y ↔ x ≤ y ∧ y ≤ x := by
|
||||
constructor
|
||||
· simp_all
|
||||
· intro ⟨h₁, h₂⟩
|
||||
exact Int.le_antisymm h₁ h₂
|
||||
|
||||
protected theorem lt_of_le_of_lt {a b c : Int} (h₁ : a ≤ b) (h₂ : b < c) : a < c :=
|
||||
Int.not_le.1 fun h => Int.not_le.2 h₂ (Int.le_trans h h₁)
|
||||
|
||||
protected theorem lt_of_lt_of_le {a b c : Int} (h₁ : a < b) (h₂ : b ≤ c) : a < c :=
|
||||
Int.not_le.1 fun h => Int.not_le.2 h₁ (Int.le_trans h₂ h)
|
||||
|
||||
protected theorem lt_trans {a b c : Int} (h₁ : a < b) (h₂ : b < c) : a < c :=
|
||||
Int.lt_of_le_of_lt (Int.le_of_lt h₁) h₂
|
||||
|
||||
instance : Trans (α := Int) (· ≤ ·) (· ≤ ·) (· ≤ ·) := ⟨Int.le_trans⟩
|
||||
|
||||
instance : Trans (α := Int) (· < ·) (· ≤ ·) (· < ·) := ⟨Int.lt_of_lt_of_le⟩
|
||||
|
||||
instance : Trans (α := Int) (· ≤ ·) (· < ·) (· < ·) := ⟨Int.lt_of_le_of_lt⟩
|
||||
|
||||
instance : Trans (α := Int) (· < ·) (· < ·) (· < ·) := ⟨Int.lt_trans⟩
|
||||
|
||||
protected theorem min_def (n m : Int) : min n m = if n ≤ m then n else m := rfl
|
||||
|
||||
protected theorem max_def (n m : Int) : max n m = if n ≤ m then m else n := rfl
|
||||
|
||||
protected theorem min_comm (a b : Int) : min a b = min b a := by
|
||||
simp [Int.min_def]
|
||||
by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂]
|
||||
· exact Int.le_antisymm h₁ h₂
|
||||
· cases not_or_intro h₁ h₂ <| Int.le_total ..
|
||||
|
||||
protected theorem min_le_right (a b : Int) : min a b ≤ b := by rw [Int.min_def]; split <;> simp [*]
|
||||
|
||||
protected theorem min_le_left (a b : Int) : min a b ≤ a := Int.min_comm .. ▸ Int.min_le_right ..
|
||||
|
||||
protected theorem le_min {a b c : Int} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c :=
|
||||
⟨fun h => ⟨Int.le_trans h (Int.min_le_left ..), Int.le_trans h (Int.min_le_right ..)⟩,
|
||||
fun ⟨h₁, h₂⟩ => by rw [Int.min_def]; split <;> assumption⟩
|
||||
|
||||
protected theorem max_comm (a b : Int) : max a b = max b a := by
|
||||
simp only [Int.max_def]
|
||||
by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂]
|
||||
· exact Int.le_antisymm h₂ h₁
|
||||
· cases not_or_intro h₁ h₂ <| Int.le_total ..
|
||||
|
||||
protected theorem le_max_left (a b : Int) : a ≤ max a b := by rw [Int.max_def]; split <;> simp [*]
|
||||
|
||||
protected theorem le_max_right (a b : Int) : b ≤ max a b := Int.max_comm .. ▸ Int.le_max_left ..
|
||||
|
||||
protected theorem max_le {a b c : Int} : max a b ≤ c ↔ a ≤ c ∧ b ≤ c :=
|
||||
⟨fun h => ⟨Int.le_trans (Int.le_max_left ..) h, Int.le_trans (Int.le_max_right ..) h⟩,
|
||||
fun ⟨h₁, h₂⟩ => by rw [Int.max_def]; split <;> assumption⟩
|
||||
|
||||
theorem eq_natAbs_of_zero_le {a : Int} (h : 0 ≤ a) : a = natAbs a := by
|
||||
let ⟨n, e⟩ := eq_ofNat_of_zero_le h
|
||||
rw [e]; rfl
|
||||
|
||||
theorem le_natAbs {a : Int} : a ≤ natAbs a :=
|
||||
match Int.le_total 0 a with
|
||||
| .inl h => by rw [eq_natAbs_of_zero_le h]; apply Int.le_refl
|
||||
| .inr h => Int.le_trans h (ofNat_zero_le _)
|
||||
|
||||
theorem negSucc_lt_zero (n : Nat) : -[n+1] < 0 :=
|
||||
Int.not_le.1 fun h => let ⟨_, h⟩ := eq_ofNat_of_zero_le h; nomatch h
|
||||
|
||||
@[simp] theorem negSucc_not_nonneg (n : Nat) : 0 ≤ -[n+1] ↔ False := by
|
||||
simp only [Int.not_le, iff_false]; exact Int.negSucc_lt_zero n
|
||||
|
||||
protected theorem add_le_add_left {a b : Int} (h : a ≤ b) (c : Int) : c + a ≤ c + b :=
|
||||
let ⟨n, hn⟩ := le.dest h; le.intro n <| by rw [Int.add_assoc, hn]
|
||||
|
||||
protected theorem add_lt_add_left {a b : Int} (h : a < b) (c : Int) : c + a < c + b :=
|
||||
Int.lt_iff_le_and_ne.2 ⟨Int.add_le_add_left (Int.le_of_lt h) _, fun heq =>
|
||||
b.lt_irrefl <| by rwa [Int.add_left_cancel heq] at h⟩
|
||||
|
||||
protected theorem add_le_add_right {a b : Int} (h : a ≤ b) (c : Int) : a + c ≤ b + c :=
|
||||
Int.add_comm c a ▸ Int.add_comm c b ▸ Int.add_le_add_left h c
|
||||
|
||||
protected theorem add_lt_add_right {a b : Int} (h : a < b) (c : Int) : a + c < b + c :=
|
||||
Int.add_comm c a ▸ Int.add_comm c b ▸ Int.add_lt_add_left h c
|
||||
|
||||
protected theorem le_of_add_le_add_left {a b c : Int} (h : a + b ≤ a + c) : b ≤ c := by
|
||||
have : -a + (a + b) ≤ -a + (a + c) := Int.add_le_add_left h _
|
||||
simp [Int.neg_add_cancel_left] at this
|
||||
assumption
|
||||
|
||||
protected theorem le_of_add_le_add_right {a b c : Int} (h : a + b ≤ c + b) : a ≤ c :=
|
||||
Int.le_of_add_le_add_left (a := b) <| by rwa [Int.add_comm b a, Int.add_comm b c]
|
||||
|
||||
protected theorem add_le_add_iff_left (a : Int) : a + b ≤ a + c ↔ b ≤ c :=
|
||||
⟨Int.le_of_add_le_add_left, (Int.add_le_add_left · _)⟩
|
||||
|
||||
protected theorem add_le_add_iff_right (c : Int) : a + c ≤ b + c ↔ a ≤ b :=
|
||||
⟨Int.le_of_add_le_add_right, (Int.add_le_add_right · _)⟩
|
||||
|
||||
protected theorem add_le_add {a b c d : Int} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d :=
|
||||
Int.le_trans (Int.add_le_add_right h₁ c) (Int.add_le_add_left h₂ b)
|
||||
|
||||
protected theorem le_add_of_nonneg_right {a b : Int} (h : 0 ≤ b) : a ≤ a + b := by
|
||||
have : a + b ≥ a + 0 := Int.add_le_add_left h a
|
||||
rwa [Int.add_zero] at this
|
||||
|
||||
protected theorem le_add_of_nonneg_left {a b : Int} (h : 0 ≤ b) : a ≤ b + a := by
|
||||
have : 0 + a ≤ b + a := Int.add_le_add_right h a
|
||||
rwa [Int.zero_add] at this
|
||||
|
||||
protected theorem neg_le_neg {a b : Int} (h : a ≤ b) : -b ≤ -a := by
|
||||
have : 0 ≤ -a + b := Int.add_left_neg a ▸ Int.add_le_add_left h (-a)
|
||||
have : 0 + -b ≤ -a + b + -b := Int.add_le_add_right this (-b)
|
||||
rwa [Int.add_neg_cancel_right, Int.zero_add] at this
|
||||
|
||||
protected theorem le_of_neg_le_neg {a b : Int} (h : -b ≤ -a) : a ≤ b :=
|
||||
suffices - -a ≤ - -b by simp [Int.neg_neg] at this; assumption
|
||||
Int.neg_le_neg h
|
||||
|
||||
protected theorem neg_nonpos_of_nonneg {a : Int} (h : 0 ≤ a) : -a ≤ 0 := by
|
||||
have : -a ≤ -0 := Int.neg_le_neg h
|
||||
rwa [Int.neg_zero] at this
|
||||
|
||||
protected theorem neg_nonneg_of_nonpos {a : Int} (h : a ≤ 0) : 0 ≤ -a := by
|
||||
have : -0 ≤ -a := Int.neg_le_neg h
|
||||
rwa [Int.neg_zero] at this
|
||||
|
||||
protected theorem neg_lt_neg {a b : Int} (h : a < b) : -b < -a := by
|
||||
have : 0 < -a + b := Int.add_left_neg a ▸ Int.add_lt_add_left h (-a)
|
||||
have : 0 + -b < -a + b + -b := Int.add_lt_add_right this (-b)
|
||||
rwa [Int.add_neg_cancel_right, Int.zero_add] at this
|
||||
|
||||
protected theorem neg_neg_of_pos {a : Int} (h : 0 < a) : -a < 0 := by
|
||||
have : -a < -0 := Int.neg_lt_neg h
|
||||
rwa [Int.neg_zero] at this
|
||||
|
||||
protected theorem neg_pos_of_neg {a : Int} (h : a < 0) : 0 < -a := by
|
||||
have : -0 < -a := Int.neg_lt_neg h
|
||||
rwa [Int.neg_zero] at this
|
||||
|
||||
protected theorem sub_nonneg_of_le {a b : Int} (h : b ≤ a) : 0 ≤ a - b := by
|
||||
have h := Int.add_le_add_right h (-b)
|
||||
rwa [Int.add_right_neg] at h
|
||||
|
||||
protected theorem le_of_sub_nonneg {a b : Int} (h : 0 ≤ a - b) : b ≤ a := by
|
||||
have h := Int.add_le_add_right h b
|
||||
rwa [Int.sub_add_cancel, Int.zero_add] at h
|
||||
|
||||
protected theorem sub_pos_of_lt {a b : Int} (h : b < a) : 0 < a - b := by
|
||||
have h := Int.add_lt_add_right h (-b)
|
||||
rwa [Int.add_right_neg] at h
|
||||
|
||||
protected theorem lt_of_sub_pos {a b : Int} (h : 0 < a - b) : b < a := by
|
||||
have h := Int.add_lt_add_right h b
|
||||
rwa [Int.sub_add_cancel, Int.zero_add] at h
|
||||
|
||||
protected theorem sub_left_le_of_le_add {a b c : Int} (h : a ≤ b + c) : a - b ≤ c := by
|
||||
have h := Int.add_le_add_right h (-b)
|
||||
rwa [Int.add_comm b c, Int.add_neg_cancel_right] at h
|
||||
|
||||
protected theorem sub_le_self (a : Int) {b : Int} (h : 0 ≤ b) : a - b ≤ a :=
|
||||
calc a + -b
|
||||
_ ≤ a + 0 := Int.add_le_add_left (Int.neg_nonpos_of_nonneg h) _
|
||||
_ = a := by rw [Int.add_zero]
|
||||
|
||||
protected theorem sub_lt_self (a : Int) {b : Int} (h : 0 < b) : a - b < a :=
|
||||
calc a + -b
|
||||
_ < a + 0 := Int.add_lt_add_left (Int.neg_neg_of_pos h) _
|
||||
_ = a := by rw [Int.add_zero]
|
||||
|
||||
theorem add_one_le_of_lt {a b : Int} (H : a < b) : a + 1 ≤ b := H
|
||||
|
||||
/- ### Order properties and multiplication -/
|
||||
|
||||
|
||||
protected theorem mul_nonneg {a b : Int} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := by
|
||||
let ⟨n, hn⟩ := eq_ofNat_of_zero_le ha
|
||||
let ⟨m, hm⟩ := eq_ofNat_of_zero_le hb
|
||||
rw [hn, hm, ← ofNat_mul]; apply ofNat_nonneg
|
||||
|
||||
protected theorem mul_pos {a b : Int} (ha : 0 < a) (hb : 0 < b) : 0 < a * b := by
|
||||
let ⟨n, hn⟩ := eq_succ_of_zero_lt ha
|
||||
let ⟨m, hm⟩ := eq_succ_of_zero_lt hb
|
||||
rw [hn, hm, ← ofNat_mul]; apply ofNat_succ_pos
|
||||
|
||||
protected theorem mul_lt_mul_of_pos_left {a b c : Int}
|
||||
(h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := by
|
||||
have : 0 < c * (b - a) := Int.mul_pos h₂ (Int.sub_pos_of_lt h₁)
|
||||
rw [Int.mul_sub] at this
|
||||
exact Int.lt_of_sub_pos this
|
||||
|
||||
protected theorem mul_lt_mul_of_pos_right {a b c : Int}
|
||||
(h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := by
|
||||
have : 0 < b - a := Int.sub_pos_of_lt h₁
|
||||
have : 0 < (b - a) * c := Int.mul_pos this h₂
|
||||
rw [Int.sub_mul] at this
|
||||
exact Int.lt_of_sub_pos this
|
||||
|
||||
protected theorem mul_le_mul_of_nonneg_left {a b c : Int}
|
||||
(h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b :=
|
||||
if hba : b ≤ a then by
|
||||
rw [Int.le_antisymm hba h₁]; apply Int.le_refl
|
||||
else if hc0 : c ≤ 0 then by
|
||||
simp [Int.le_antisymm hc0 h₂, Int.zero_mul]
|
||||
else by
|
||||
exact Int.le_of_lt <| Int.mul_lt_mul_of_pos_left
|
||||
(Int.lt_iff_le_not_le.2 ⟨h₁, hba⟩) (Int.lt_iff_le_not_le.2 ⟨h₂, hc0⟩)
|
||||
|
||||
protected theorem mul_le_mul_of_nonneg_right {a b c : Int}
|
||||
(h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := by
|
||||
rw [Int.mul_comm, Int.mul_comm b]; exact Int.mul_le_mul_of_nonneg_left h₁ h₂
|
||||
|
||||
protected theorem mul_le_mul {a b c d : Int}
|
||||
(hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d :=
|
||||
Int.le_trans (Int.mul_le_mul_of_nonneg_right hac nn_b) (Int.mul_le_mul_of_nonneg_left hbd nn_c)
|
||||
|
||||
protected theorem mul_nonpos_of_nonneg_of_nonpos {a b : Int}
|
||||
(ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 := by
|
||||
have h : a * b ≤ a * 0 := Int.mul_le_mul_of_nonneg_left hb ha
|
||||
rwa [Int.mul_zero] at h
|
||||
|
||||
protected theorem mul_nonpos_of_nonpos_of_nonneg {a b : Int}
|
||||
(ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 := by
|
||||
have h : a * b ≤ 0 * b := Int.mul_le_mul_of_nonneg_right ha hb
|
||||
rwa [Int.zero_mul] at h
|
||||
|
||||
protected theorem mul_le_mul_of_nonpos_right {a b c : Int}
|
||||
(h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c :=
|
||||
have : -c ≥ 0 := Int.neg_nonneg_of_nonpos hc
|
||||
have : b * -c ≤ a * -c := Int.mul_le_mul_of_nonneg_right h this
|
||||
Int.le_of_neg_le_neg <| by rwa [← Int.neg_mul_eq_mul_neg, ← Int.neg_mul_eq_mul_neg] at this
|
||||
|
||||
protected theorem mul_le_mul_of_nonpos_left {a b c : Int}
|
||||
(ha : a ≤ 0) (h : c ≤ b) : a * b ≤ a * c := by
|
||||
rw [Int.mul_comm a b, Int.mul_comm a c]
|
||||
apply Int.mul_le_mul_of_nonpos_right h ha
|
||||
|
||||
/- ## natAbs -/
|
||||
|
||||
@[simp] theorem natAbs_ofNat (n : Nat) : natAbs ↑n = n := rfl
|
||||
@[simp] theorem natAbs_negSucc (n : Nat) : natAbs -[n+1] = n.succ := rfl
|
||||
@[simp] theorem natAbs_zero : natAbs (0 : Int) = (0 : Nat) := rfl
|
||||
@[simp] theorem natAbs_one : natAbs (1 : Int) = (1 : Nat) := rfl
|
||||
|
||||
@[simp] theorem natAbs_eq_zero : natAbs a = 0 ↔ a = 0 :=
|
||||
⟨fun H => match a with
|
||||
| ofNat _ => congrArg ofNat H
|
||||
| -[_+1] => absurd H (succ_ne_zero _),
|
||||
fun e => e ▸ rfl⟩
|
||||
|
||||
theorem natAbs_pos : 0 < natAbs a ↔ a ≠ 0 := by rw [Nat.pos_iff_ne_zero, Ne, natAbs_eq_zero]
|
||||
|
||||
@[simp] theorem natAbs_neg : ∀ (a : Int), natAbs (-a) = natAbs a
|
||||
| 0 => rfl
|
||||
| succ _ => rfl
|
||||
| -[_+1] => rfl
|
||||
|
||||
theorem natAbs_eq : ∀ (a : Int), a = natAbs a ∨ a = -↑(natAbs a)
|
||||
| ofNat _ => Or.inl rfl
|
||||
| -[_+1] => Or.inr rfl
|
||||
|
||||
theorem natAbs_negOfNat (n : Nat) : natAbs (negOfNat n) = n := by
|
||||
cases n <;> rfl
|
||||
|
||||
theorem natAbs_mul (a b : Int) : natAbs (a * b) = natAbs a * natAbs b := by
|
||||
cases a <;> cases b <;>
|
||||
simp only [← Int.mul_def, Int.mul, natAbs_negOfNat] <;> simp only [natAbs]
|
||||
|
||||
theorem natAbs_eq_natAbs_iff {a b : Int} : a.natAbs = b.natAbs ↔ a = b ∨ a = -b := by
|
||||
constructor <;> intro h
|
||||
· cases Int.natAbs_eq a with
|
||||
| inl h₁ | inr h₁ =>
|
||||
cases Int.natAbs_eq b with
|
||||
| inl h₂ | inr h₂ => rw [h₁, h₂]; simp [h]
|
||||
· cases h with (subst a; try rfl)
|
||||
| inr h => rw [Int.natAbs_neg]
|
||||
|
||||
theorem natAbs_of_nonneg {a : Int} (H : 0 ≤ a) : (natAbs a : Int) = a :=
|
||||
match a, eq_ofNat_of_zero_le H with
|
||||
| _, ⟨_, rfl⟩ => rfl
|
||||
|
||||
theorem ofNat_natAbs_of_nonpos {a : Int} (H : a ≤ 0) : (natAbs a : Int) = -a := by
|
||||
rw [← natAbs_neg, natAbs_of_nonneg (Int.neg_nonneg_of_nonpos H)]
|
||||
@@ -7,4 +7,3 @@ prelude
|
||||
import Init.Data.List.Basic
|
||||
import Init.Data.List.BasicAux
|
||||
import Init.Data.List.Control
|
||||
import Init.Data.List.Lemmas
|
||||
|
||||
@@ -603,27 +603,6 @@ The longer list is truncated to match the shorter list.
|
||||
def zip : List α → List β → List (Prod α β) :=
|
||||
zipWith Prod.mk
|
||||
|
||||
/--
|
||||
`O(max |xs| |ys|)`.
|
||||
Version of `List.zipWith` that continues to the end of both lists,
|
||||
passing `none` to one argument once the shorter list has run out.
|
||||
-/
|
||||
def zipWithAll (f : Option α → Option β → γ) : List α → List β → List γ
|
||||
| [], bs => bs.map fun b => f none (some b)
|
||||
| a :: as, [] => (a :: as).map fun a => f (some a) none
|
||||
| a :: as, b :: bs => f a b :: zipWithAll f as bs
|
||||
|
||||
@[simp] theorem zipWithAll_nil_right :
|
||||
zipWithAll f as [] = as.map fun a => f (some a) none := by
|
||||
cases as <;> rfl
|
||||
|
||||
@[simp] theorem zipWithAll_nil_left :
|
||||
zipWithAll f [] bs = bs.map fun b => f none (some b) := by
|
||||
rfl
|
||||
|
||||
@[simp] theorem zipWithAll_cons_cons :
|
||||
zipWithAll f (a :: as) (b :: bs) = f (some a) (some b) :: zipWithAll f as bs := rfl
|
||||
|
||||
/--
|
||||
`O(|l|)`. Separates a list of pairs into two lists containing the first components and second components.
|
||||
* `unzip [(x₁, y₁), (x₂, y₂), (x₃, y₃)] = ([x₁, x₂, x₃], [y₁, y₂, y₃])`
|
||||
@@ -897,7 +876,7 @@ instance [BEq α] [LawfulBEq α] : LawfulBEq (List α) where
|
||||
cases bs with
|
||||
| nil => intro h; contradiction
|
||||
| cons b bs =>
|
||||
simp [show (a::as == b::bs) = (a == b && as == bs) from rfl, -and_imp]
|
||||
simp [show (a::as == b::bs) = (a == b && as == bs) from rfl]
|
||||
intro ⟨h₁, h₂⟩
|
||||
exact ⟨h₁, ih h₂⟩
|
||||
rfl {as} := by
|
||||
|
||||
@@ -1,630 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.List.BasicAux
|
||||
import Init.Data.List.Control
|
||||
import Init.PropLemmas
|
||||
import Init.Control.Lawful
|
||||
import Init.Hints
|
||||
|
||||
namespace List
|
||||
|
||||
open Nat
|
||||
|
||||
/-!
|
||||
# Bootstrapping theorems for lists
|
||||
|
||||
These are theorems used in the definitions of `Std.Data.List.Basic` and tactics.
|
||||
New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap.
|
||||
-/
|
||||
|
||||
attribute [simp] concat_eq_append append_assoc
|
||||
|
||||
@[simp] theorem get?_nil : @get? α [] n = none := rfl
|
||||
@[simp] theorem get?_cons_zero : @get? α (a::l) 0 = some a := rfl
|
||||
@[simp] theorem get?_cons_succ : @get? α (a::l) (n+1) = get? l n := rfl
|
||||
@[simp] theorem get_cons_zero : get (a::l) (0 : Fin (l.length + 1)) = a := rfl
|
||||
@[simp] theorem head?_nil : @head? α [] = none := rfl
|
||||
@[simp] theorem head?_cons : @head? α (a::l) = some a := rfl
|
||||
@[simp 1100] theorem headD_nil : @headD α [] d = d := rfl
|
||||
@[simp 1100] theorem headD_cons : @headD α (a::l) d = a := rfl
|
||||
@[simp] theorem head_cons : @head α (a::l) h = a := rfl
|
||||
@[simp] theorem tail?_nil : @tail? α [] = none := rfl
|
||||
@[simp] theorem tail?_cons : @tail? α (a::l) = some l := rfl
|
||||
@[simp] theorem tail!_cons : @tail! α (a::l) = l := rfl
|
||||
@[simp 1100] theorem tailD_nil : @tailD α [] l' = l' := rfl
|
||||
@[simp 1100] theorem tailD_cons : @tailD α (a::l) l' = l := rfl
|
||||
@[simp] theorem any_nil : [].any f = false := rfl
|
||||
@[simp] theorem any_cons : (a::l).any f = (f a || l.any f) := rfl
|
||||
@[simp] theorem all_nil : [].all f = true := rfl
|
||||
@[simp] theorem all_cons : (a::l).all f = (f a && l.all f) := rfl
|
||||
@[simp] theorem or_nil : [].or = false := rfl
|
||||
@[simp] theorem or_cons : (a::l).or = (a || l.or) := rfl
|
||||
@[simp] theorem and_nil : [].and = true := rfl
|
||||
@[simp] theorem and_cons : (a::l).and = (a && l.and) := rfl
|
||||
|
||||
/-! ### length -/
|
||||
|
||||
theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
|
||||
|
||||
theorem ne_nil_of_length_eq_succ (_ : length l = succ n) : l ≠ [] := fun _ => nomatch l
|
||||
|
||||
theorem length_eq_zero : length l = 0 ↔ l = [] :=
|
||||
⟨eq_nil_of_length_eq_zero, fun h => h ▸ rfl⟩
|
||||
|
||||
/-! ### mem -/
|
||||
|
||||
@[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := nofun
|
||||
|
||||
@[simp] theorem mem_cons : a ∈ (b :: l) ↔ a = b ∨ a ∈ l :=
|
||||
⟨fun h => by cases h <;> simp [Membership.mem, *],
|
||||
fun | Or.inl rfl => by constructor | Or.inr h => by constructor; assumption⟩
|
||||
|
||||
theorem mem_cons_self (a : α) (l : List α) : a ∈ a :: l := .head ..
|
||||
|
||||
theorem mem_cons_of_mem (y : α) {a : α} {l : List α} : a ∈ l → a ∈ y :: l := .tail _
|
||||
|
||||
theorem eq_nil_iff_forall_not_mem {l : List α} : l = [] ↔ ∀ a, a ∉ l := by
|
||||
cases l <;> simp
|
||||
|
||||
/-! ### append -/
|
||||
|
||||
@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl
|
||||
|
||||
theorem append_inj :
|
||||
∀ {s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ → length s₁ = length s₂ → s₁ = s₂ ∧ t₁ = t₂
|
||||
| [], [], t₁, t₂, h, _ => ⟨rfl, h⟩
|
||||
| a :: s₁, b :: s₂, t₁, t₂, h, hl => by
|
||||
simp [append_inj (cons.inj h).2 (Nat.succ.inj hl)] at h ⊢; exact h
|
||||
|
||||
theorem append_inj_right (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : t₁ = t₂ :=
|
||||
(append_inj h hl).right
|
||||
|
||||
theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : s₁ = s₂ :=
|
||||
(append_inj h hl).left
|
||||
|
||||
theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ ∧ t₁ = t₂ :=
|
||||
append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by
|
||||
let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap
|
||||
|
||||
theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ :=
|
||||
(append_inj' h hl).right
|
||||
|
||||
theorem append_inj_left' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ :=
|
||||
(append_inj' h hl).left
|
||||
|
||||
theorem append_right_inj {t₁ t₂ : List α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ :=
|
||||
⟨fun h => append_inj_right h rfl, congrArg _⟩
|
||||
|
||||
theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
|
||||
⟨fun h => append_inj_left' h rfl, congrArg (· ++ _)⟩
|
||||
|
||||
@[simp] theorem append_eq_nil : p ++ q = [] ↔ p = [] ∧ q = [] := by
|
||||
cases p <;> simp
|
||||
|
||||
/-! ### map -/
|
||||
|
||||
@[simp] theorem map_nil {f : α → β} : map f [] = [] := rfl
|
||||
|
||||
@[simp] theorem map_cons (f : α → β) a l : map f (a :: l) = f a :: map f l := rfl
|
||||
|
||||
@[simp] theorem map_append (f : α → β) : ∀ l₁ l₂, map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
|
||||
intro l₁; induction l₁ <;> intros <;> simp_all
|
||||
|
||||
@[simp] theorem map_id (l : List α) : map id l = l := by induction l <;> simp_all
|
||||
|
||||
@[simp] theorem map_id' (l : List α) : map (fun a => a) l = l := by induction l <;> simp_all
|
||||
|
||||
@[simp] theorem mem_map {f : α → β} : ∀ {l : List α}, b ∈ l.map f ↔ ∃ a, a ∈ l ∧ f a = b
|
||||
| [] => by simp
|
||||
| _ :: l => by simp [mem_map (l := l), eq_comm (a := b)]
|
||||
|
||||
theorem mem_map_of_mem (f : α → β) (h : a ∈ l) : f a ∈ map f l := mem_map.2 ⟨_, h, rfl⟩
|
||||
|
||||
@[simp] theorem map_map (g : β → γ) (f : α → β) (l : List α) :
|
||||
map g (map f l) = map (g ∘ f) l := by induction l <;> simp_all
|
||||
|
||||
/-! ### bind -/
|
||||
|
||||
@[simp] theorem nil_bind (f : α → List β) : List.bind [] f = [] := by simp [join, List.bind]
|
||||
|
||||
@[simp] theorem cons_bind x xs (f : α → List β) :
|
||||
List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [join, List.bind]
|
||||
|
||||
@[simp] theorem append_bind xs ys (f : α → List β) :
|
||||
List.bind (xs ++ ys) f = List.bind xs f ++ List.bind ys f := by
|
||||
induction xs; {rfl}; simp_all [cons_bind, append_assoc]
|
||||
|
||||
@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.join := by simp [List.bind]
|
||||
|
||||
/-! ### join -/
|
||||
|
||||
@[simp] theorem join_nil : List.join ([] : List (List α)) = [] := rfl
|
||||
|
||||
@[simp] theorem join_cons : (l :: ls).join = l ++ ls.join := rfl
|
||||
|
||||
/-! ### bounded quantifiers over Lists -/
|
||||
|
||||
theorem forall_mem_cons {p : α → Prop} {a : α} {l : List α} :
|
||||
(∀ x, x ∈ a :: l → p x) ↔ p a ∧ ∀ x, x ∈ l → p x :=
|
||||
⟨fun H => ⟨H _ (.head ..), fun _ h => H _ (.tail _ h)⟩,
|
||||
fun ⟨H₁, H₂⟩ _ => fun | .head .. => H₁ | .tail _ h => H₂ _ h⟩
|
||||
|
||||
/-! ### reverse -/
|
||||
|
||||
@[simp] theorem reverseAux_nil : reverseAux [] r = r := rfl
|
||||
@[simp] theorem reverseAux_cons : reverseAux (a::l) r = reverseAux l (a::r) := rfl
|
||||
|
||||
theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
|
||||
reverseAux_eq_append ..
|
||||
|
||||
theorem reverse_map (f : α → β) (l : List α) : (l.map f).reverse = l.reverse.map f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[simp] theorem reverse_eq_nil_iff {xs : List α} : xs.reverse = [] ↔ xs = [] := by
|
||||
match xs with
|
||||
| [] => simp
|
||||
| x :: xs => simp
|
||||
|
||||
/-! ### nth element -/
|
||||
|
||||
theorem get_of_mem : ∀ {a} {l : List α}, a ∈ l → ∃ n, get l n = a
|
||||
| _, _ :: _, .head .. => ⟨⟨0, Nat.succ_pos _⟩, rfl⟩
|
||||
| _, _ :: _, .tail _ m => let ⟨⟨n, h⟩, e⟩ := get_of_mem m; ⟨⟨n+1, Nat.succ_lt_succ h⟩, e⟩
|
||||
|
||||
theorem get_mem : ∀ (l : List α) n h, get l ⟨n, h⟩ ∈ l
|
||||
| _ :: _, 0, _ => .head ..
|
||||
| _ :: l, _+1, _ => .tail _ (get_mem l ..)
|
||||
|
||||
theorem mem_iff_get {a} {l : List α} : a ∈ l ↔ ∃ n, get l n = a :=
|
||||
⟨get_of_mem, fun ⟨_, e⟩ => e ▸ get_mem ..⟩
|
||||
|
||||
theorem get?_len_le : ∀ {l : List α} {n}, length l ≤ n → l.get? n = none
|
||||
| [], _, _ => rfl
|
||||
| _ :: l, _+1, h => get?_len_le (l := l) <| Nat.le_of_succ_le_succ h
|
||||
|
||||
theorem get?_eq_get : ∀ {l : List α} {n} (h : n < l.length), l.get? n = some (get l ⟨n, h⟩)
|
||||
| _ :: _, 0, _ => rfl
|
||||
| _ :: l, _+1, _ => get?_eq_get (l := l) _
|
||||
|
||||
theorem get?_eq_some : l.get? n = some a ↔ ∃ h, get l ⟨n, h⟩ = a :=
|
||||
⟨fun e =>
|
||||
have : n < length l := Nat.gt_of_not_le fun hn => by cases get?_len_le hn ▸ e
|
||||
⟨this, by rwa [get?_eq_get this, Option.some.injEq] at e⟩,
|
||||
fun ⟨h, e⟩ => e ▸ get?_eq_get _⟩
|
||||
|
||||
@[simp] theorem get?_eq_none : l.get? n = none ↔ length l ≤ n :=
|
||||
⟨fun e => Nat.ge_of_not_lt (fun h' => by cases e ▸ get?_eq_some.2 ⟨h', rfl⟩), get?_len_le⟩
|
||||
|
||||
@[simp] theorem get?_map (f : α → β) : ∀ l n, (map f l).get? n = (l.get? n).map f
|
||||
| [], _ => rfl
|
||||
| _ :: _, 0 => rfl
|
||||
| _ :: l, n+1 => get?_map f l n
|
||||
|
||||
@[simp] theorem get?_concat_length : ∀ (l : List α) (a : α), (l ++ [a]).get? l.length = some a
|
||||
| [], a => rfl
|
||||
| b :: l, a => by rw [cons_append, length_cons]; simp only [get?, get?_concat_length]
|
||||
|
||||
theorem getLast_eq_get : ∀ (l : List α) (h : l ≠ []),
|
||||
getLast l h = l.get ⟨l.length - 1, by
|
||||
match l with
|
||||
| [] => contradiction
|
||||
| a :: l => exact Nat.le_refl _⟩
|
||||
| [a], h => rfl
|
||||
| a :: b :: l, h => by
|
||||
simp [getLast, get, Nat.succ_sub_succ, getLast_eq_get]
|
||||
|
||||
@[simp] theorem getLast?_nil : @getLast? α [] = none := rfl
|
||||
|
||||
theorem getLast?_eq_getLast : ∀ l h, @getLast? α l = some (getLast l h)
|
||||
| [], h => nomatch h rfl
|
||||
| _::_, _ => rfl
|
||||
|
||||
theorem getLast?_eq_get? : ∀ (l : List α), getLast? l = l.get? (l.length - 1)
|
||||
| [] => rfl
|
||||
| a::l => by rw [getLast?_eq_getLast (a::l) nofun, getLast_eq_get, get?_eq_get]
|
||||
|
||||
@[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by
|
||||
simp [getLast?_eq_get?, Nat.succ_sub_succ]
|
||||
|
||||
/-! ### take and drop -/
|
||||
|
||||
@[simp] theorem take_append_drop : ∀ (n : Nat) (l : List α), take n l ++ drop n l = l
|
||||
| 0, _ => rfl
|
||||
| _+1, [] => rfl
|
||||
| n+1, x :: xs => congrArg (cons x) <| take_append_drop n xs
|
||||
|
||||
@[simp] theorem length_drop : ∀ (i : Nat) (l : List α), length (drop i l) = length l - i
|
||||
| 0, _ => rfl
|
||||
| succ i, [] => Eq.symm (Nat.zero_sub (succ i))
|
||||
| succ i, x :: l => calc
|
||||
length (drop (succ i) (x :: l)) = length l - i := length_drop i l
|
||||
_ = succ (length l) - succ i := (Nat.succ_sub_succ_eq_sub (length l) i).symm
|
||||
|
||||
theorem drop_length_le {l : List α} (h : l.length ≤ i) : drop i l = [] :=
|
||||
length_eq_zero.1 (length_drop .. ▸ Nat.sub_eq_zero_of_le h)
|
||||
|
||||
theorem take_length_le {l : List α} (h : l.length ≤ i) : take i l = l := by
|
||||
have := take_append_drop i l
|
||||
rw [drop_length_le h, append_nil] at this; exact this
|
||||
|
||||
@[simp] theorem take_zero (l : List α) : l.take 0 = [] := rfl
|
||||
|
||||
@[simp] theorem take_nil : ([] : List α).take i = [] := by cases i <;> rfl
|
||||
|
||||
@[simp] theorem take_cons_succ : (a::as).take (i+1) = a :: as.take i := rfl
|
||||
|
||||
@[simp] theorem drop_zero (l : List α) : l.drop 0 = l := rfl
|
||||
|
||||
@[simp] theorem drop_succ_cons : (a :: l).drop (n + 1) = l.drop n := rfl
|
||||
|
||||
@[simp] theorem drop_length (l : List α) : drop l.length l = [] := drop_length_le (Nat.le_refl _)
|
||||
|
||||
@[simp] theorem take_length (l : List α) : take l.length l = l := take_length_le (Nat.le_refl _)
|
||||
|
||||
theorem take_concat_get (l : List α) (i : Nat) (h : i < l.length) :
|
||||
(l.take i).concat l[i] = l.take (i+1) :=
|
||||
Eq.symm <| (append_left_inj _).1 <| (take_append_drop (i+1) l).trans <| by
|
||||
rw [concat_eq_append, append_assoc, singleton_append, get_drop_eq_drop, take_append_drop]
|
||||
|
||||
theorem reverse_concat (l : List α) (a : α) : (l.concat a).reverse = a :: l.reverse := by
|
||||
rw [concat_eq_append, reverse_append]; rfl
|
||||
|
||||
/-! ### takeWhile and dropWhile -/
|
||||
|
||||
@[simp] theorem dropWhile_nil : ([] : List α).dropWhile p = [] := rfl
|
||||
|
||||
theorem dropWhile_cons :
|
||||
(x :: xs : List α).dropWhile p = if p x then xs.dropWhile p else x :: xs := by
|
||||
split <;> simp_all [dropWhile]
|
||||
|
||||
/-! ### foldlM and foldrM -/
|
||||
|
||||
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) :
|
||||
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
|
||||
|
||||
@[simp] theorem foldlM_nil [Monad m] (f : β → α → m β) (b) : [].foldlM f b = pure b := rfl
|
||||
|
||||
@[simp] theorem foldlM_cons [Monad m] (f : β → α → m β) (b) (a) (l : List α) :
|
||||
(a :: l).foldlM f b = f b a >>= l.foldlM f := by
|
||||
simp [List.foldlM]
|
||||
|
||||
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) :
|
||||
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
|
||||
induction l generalizing b <;> simp [*]
|
||||
|
||||
@[simp] theorem foldrM_nil [Monad m] (f : α → β → m β) (b) : [].foldrM f b = pure b := rfl
|
||||
|
||||
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) :
|
||||
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
|
||||
simp only [foldrM]
|
||||
induction l <;> simp_all
|
||||
|
||||
@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α → β → m β) (b) :
|
||||
l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b :=
|
||||
(foldlM_reverse ..).symm.trans <| by simp
|
||||
|
||||
theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) :
|
||||
l.foldl f b = l.foldlM (m := Id) f b := by
|
||||
induction l generalizing b <;> simp [*, foldl]
|
||||
|
||||
theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
|
||||
l.foldr f b = l.foldrM (m := Id) f b := by
|
||||
induction l <;> simp [*, foldr]
|
||||
|
||||
/-! ### foldl and foldr -/
|
||||
|
||||
@[simp] theorem foldl_reverse (l : List α) (f : β → α → β) (b) :
|
||||
l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM]
|
||||
|
||||
@[simp] theorem foldr_reverse (l : List α) (f : α → β → β) (b) :
|
||||
l.reverse.foldr f b = l.foldl (fun x y => f y x) b :=
|
||||
(foldl_reverse ..).symm.trans <| by simp
|
||||
|
||||
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) :
|
||||
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) :
|
||||
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
|
||||
|
||||
@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) :
|
||||
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
|
||||
|
||||
@[simp] theorem foldl_nil : [].foldl f b = b := rfl
|
||||
|
||||
@[simp] theorem foldl_cons (l : List α) (b : β) : (a :: l).foldl f b = l.foldl f (f b a) := rfl
|
||||
|
||||
@[simp] theorem foldr_nil : [].foldr f b = b := rfl
|
||||
|
||||
@[simp] theorem foldr_cons (l : List α) : (a :: l).foldr f b = f a (l.foldr f b) := rfl
|
||||
|
||||
@[simp] theorem foldr_self_append (l : List α) : l.foldr cons l' = l ++ l' := by
|
||||
induction l <;> simp [*]
|
||||
|
||||
theorem foldr_self (l : List α) : l.foldr cons [] = l := by simp
|
||||
|
||||
/-! ### mapM -/
|
||||
|
||||
/-- Alternate (non-tail-recursive) form of mapM for proofs. -/
|
||||
def mapM' [Monad m] (f : α → m β) : List α → m (List β)
|
||||
| [] => pure []
|
||||
| a :: l => return (← f a) :: (← l.mapM' f)
|
||||
|
||||
@[simp] theorem mapM'_nil [Monad m] {f : α → m β} : mapM' f [] = pure [] := rfl
|
||||
@[simp] theorem mapM'_cons [Monad m] {f : α → m β} :
|
||||
mapM' f (a :: l) = return ((← f a) :: (← l.mapM' f)) :=
|
||||
rfl
|
||||
|
||||
theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α) :
|
||||
mapM' f l = mapM f l := by simp [go, mapM] where
|
||||
go : ∀ l acc, mapM.loop f l acc = return acc.reverse ++ (← mapM' f l)
|
||||
| [], acc => by simp [mapM.loop, mapM']
|
||||
| a::l, acc => by simp [go l, mapM.loop, mapM']
|
||||
|
||||
@[simp] theorem mapM_nil [Monad m] (f : α → m β) : [].mapM f = pure [] := rfl
|
||||
|
||||
@[simp] theorem mapM_cons [Monad m] [LawfulMonad m] (f : α → m β) :
|
||||
(a :: l).mapM f = (return (← f a) :: (← l.mapM f)) := by simp [← mapM'_eq_mapM, mapM']
|
||||
|
||||
@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {l₁ l₂ : List α} :
|
||||
(l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by induction l₁ <;> simp [*]
|
||||
|
||||
/-! ### forM -/
|
||||
|
||||
-- We use `List.forM` as the simp normal form, rather that `ForM.forM`.
|
||||
-- As such we need to replace `List.forM_nil` and `List.forM_cons` from Lean:
|
||||
|
||||
@[simp] theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl
|
||||
|
||||
@[simp] theorem forM_cons' [Monad m] :
|
||||
(a::as).forM f = (f a >>= fun _ => as.forM f : m PUnit) :=
|
||||
List.forM_cons _ _ _
|
||||
|
||||
/-! ### eraseIdx -/
|
||||
|
||||
@[simp] theorem eraseIdx_nil : ([] : List α).eraseIdx i = [] := rfl
|
||||
@[simp] theorem eraseIdx_cons_zero : (a::as).eraseIdx 0 = as := rfl
|
||||
@[simp] theorem eraseIdx_cons_succ : (a::as).eraseIdx (i+1) = a :: as.eraseIdx i := rfl
|
||||
|
||||
/-! ### find? -/
|
||||
|
||||
@[simp] theorem find?_nil : ([] : List α).find? p = none := rfl
|
||||
theorem find?_cons : (a::as).find? p = match p a with | true => some a | false => as.find? p :=
|
||||
rfl
|
||||
|
||||
/-! ### filter -/
|
||||
|
||||
@[simp] theorem filter_nil (p : α → Bool) : filter p [] = [] := rfl
|
||||
|
||||
@[simp] theorem filter_cons_of_pos {p : α → Bool} {a : α} (l) (pa : p a) :
|
||||
filter p (a :: l) = a :: filter p l := by rw [filter, pa]
|
||||
|
||||
@[simp] theorem filter_cons_of_neg {p : α → Bool} {a : α} (l) (pa : ¬ p a) :
|
||||
filter p (a :: l) = filter p l := by rw [filter, eq_false_of_ne_true pa]
|
||||
|
||||
theorem filter_cons :
|
||||
(x :: xs : List α).filter p = if p x then x :: (xs.filter p) else xs.filter p := by
|
||||
split <;> simp [*]
|
||||
|
||||
theorem mem_filter : x ∈ filter p as ↔ x ∈ as ∧ p x := by
|
||||
induction as with
|
||||
| nil => simp [filter]
|
||||
| cons a as ih =>
|
||||
by_cases h : p a <;> simp [*, or_and_right]
|
||||
· exact or_congr_left (and_iff_left_of_imp fun | rfl => h).symm
|
||||
· exact (or_iff_right fun ⟨rfl, h'⟩ => h h').symm
|
||||
|
||||
theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a, a ∈ l → ¬p a := by
|
||||
simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and]
|
||||
|
||||
/-! ### findSome? -/
|
||||
|
||||
@[simp] theorem findSome?_nil : ([] : List α).findSome? f = none := rfl
|
||||
theorem findSome?_cons {f : α → Option β} :
|
||||
(a::as).findSome? f = match f a with | some b => some b | none => as.findSome? f :=
|
||||
rfl
|
||||
|
||||
/-! ### replace -/
|
||||
|
||||
@[simp] theorem replace_nil [BEq α] : ([] : List α).replace a b = [] := rfl
|
||||
theorem replace_cons [BEq α] {a : α} :
|
||||
(a::as).replace b c = match a == b with | true => c::as | false => a :: replace as b c :=
|
||||
rfl
|
||||
@[simp] theorem replace_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).replace a b = b::as := by
|
||||
simp [replace_cons]
|
||||
|
||||
/-! ### elem -/
|
||||
|
||||
@[simp] theorem elem_nil [BEq α] : ([] : List α).elem a = false := rfl
|
||||
theorem elem_cons [BEq α] {a : α} :
|
||||
(a::as).elem b = match b == a with | true => true | false => as.elem b :=
|
||||
rfl
|
||||
@[simp] theorem elem_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).elem a = true := by
|
||||
simp [elem_cons]
|
||||
|
||||
/-! ### lookup -/
|
||||
|
||||
@[simp] theorem lookup_nil [BEq α] : ([] : List (α × β)).lookup a = none := rfl
|
||||
theorem lookup_cons [BEq α] {k : α} :
|
||||
((k,b)::es).lookup a = match a == k with | true => some b | false => es.lookup a :=
|
||||
rfl
|
||||
@[simp] theorem lookup_cons_self [BEq α] [LawfulBEq α] {k : α} : ((k,b)::es).lookup k = some b := by
|
||||
simp [lookup_cons]
|
||||
|
||||
/-! ### zipWith -/
|
||||
|
||||
@[simp] theorem zipWith_nil_left {f : α → β → γ} : zipWith f [] l = [] := by
|
||||
rfl
|
||||
|
||||
@[simp] theorem zipWith_nil_right {f : α → β → γ} : zipWith f l [] = [] := by
|
||||
simp [zipWith]
|
||||
|
||||
@[simp] theorem zipWith_cons_cons {f : α → β → γ} :
|
||||
zipWith f (a :: as) (b :: bs) = f a b :: zipWith f as bs := by
|
||||
rfl
|
||||
|
||||
theorem zipWith_get? {f : α → β → γ} :
|
||||
(List.zipWith f as bs).get? i = match as.get? i, bs.get? i with
|
||||
| some a, some b => some (f a b) | _, _ => none := by
|
||||
induction as generalizing bs i with
|
||||
| nil => cases bs with
|
||||
| nil => simp
|
||||
| cons b bs => simp
|
||||
| cons a as aih => cases bs with
|
||||
| nil => simp
|
||||
| cons b bs => cases i <;> simp_all
|
||||
|
||||
/-! ### zipWithAll -/
|
||||
|
||||
theorem zipWithAll_get? {f : Option α → Option β → γ} :
|
||||
(zipWithAll f as bs).get? i = match as.get? i, bs.get? i with
|
||||
| none, none => .none | a?, b? => some (f a? b?) := by
|
||||
induction as generalizing bs i with
|
||||
| nil => induction bs generalizing i with
|
||||
| nil => simp
|
||||
| cons b bs bih => cases i <;> simp_all
|
||||
| cons a as aih => cases bs with
|
||||
| nil =>
|
||||
specialize @aih []
|
||||
cases i <;> simp_all
|
||||
| cons b bs => cases i <;> simp_all
|
||||
|
||||
/-! ### zip -/
|
||||
|
||||
@[simp] theorem zip_nil_left : zip ([] : List α) (l : List β) = [] := by
|
||||
rfl
|
||||
|
||||
@[simp] theorem zip_nil_right : zip (l : List α) ([] : List β) = [] := by
|
||||
simp [zip]
|
||||
|
||||
@[simp] theorem zip_cons_cons : zip (a :: as) (b :: bs) = (a, b) :: zip as bs := by
|
||||
rfl
|
||||
|
||||
/-! ### unzip -/
|
||||
|
||||
@[simp] theorem unzip_nil : ([] : List (α × β)).unzip = ([], []) := rfl
|
||||
@[simp] theorem unzip_cons {h : α × β} :
|
||||
(h :: t).unzip = match unzip t with | (al, bl) => (h.1::al, h.2::bl) := rfl
|
||||
|
||||
/-! ### all / any -/
|
||||
|
||||
@[simp] theorem all_eq_true {l : List α} : l.all p ↔ ∀ x, x ∈ l → p x := by induction l <;> simp [*]
|
||||
|
||||
@[simp] theorem any_eq_true {l : List α} : l.any p ↔ ∃ x, x ∈ l ∧ p x := by induction l <;> simp [*]
|
||||
|
||||
/-! ### enumFrom -/
|
||||
|
||||
@[simp] theorem enumFrom_nil : ([] : List α).enumFrom i = [] := rfl
|
||||
@[simp] theorem enumFrom_cons : (a::as).enumFrom i = (i, a) :: as.enumFrom (i+1) := rfl
|
||||
|
||||
/-! ### iota -/
|
||||
|
||||
@[simp] theorem iota_zero : iota 0 = [] := rfl
|
||||
@[simp] theorem iota_succ : iota (i+1) = (i+1) :: iota i := rfl
|
||||
|
||||
/-! ### intersperse -/
|
||||
|
||||
@[simp] theorem intersperse_nil (sep : α) : ([] : List α).intersperse sep = [] := rfl
|
||||
@[simp] theorem intersperse_single (sep : α) : [x].intersperse sep = [x] := rfl
|
||||
@[simp] theorem intersperse_cons₂ (sep : α) :
|
||||
(x::y::zs).intersperse sep = x::sep::((y::zs).intersperse sep) := rfl
|
||||
|
||||
/-! ### isPrefixOf -/
|
||||
|
||||
@[simp] theorem isPrefixOf_nil_left [BEq α] : isPrefixOf ([] : List α) l = true := by
|
||||
simp [isPrefixOf]
|
||||
@[simp] theorem isPrefixOf_cons_nil [BEq α] : isPrefixOf (a::as) ([] : List α) = false := rfl
|
||||
theorem isPrefixOf_cons₂ [BEq α] {a : α} :
|
||||
isPrefixOf (a::as) (b::bs) = (a == b && isPrefixOf as bs) := rfl
|
||||
@[simp] theorem isPrefixOf_cons₂_self [BEq α] [LawfulBEq α] {a : α} :
|
||||
isPrefixOf (a::as) (a::bs) = isPrefixOf as bs := by simp [isPrefixOf_cons₂]
|
||||
|
||||
/-! ### isEqv -/
|
||||
|
||||
@[simp] theorem isEqv_nil_nil : isEqv ([] : List α) [] eqv = true := rfl
|
||||
@[simp] theorem isEqv_nil_cons : isEqv ([] : List α) (a::as) eqv = false := rfl
|
||||
@[simp] theorem isEqv_cons_nil : isEqv (a::as : List α) [] eqv = false := rfl
|
||||
theorem isEqv_cons₂ : isEqv (a::as) (b::bs) eqv = (eqv a b && isEqv as bs eqv) := rfl
|
||||
|
||||
/-! ### dropLast -/
|
||||
|
||||
@[simp] theorem dropLast_nil : ([] : List α).dropLast = [] := rfl
|
||||
@[simp] theorem dropLast_single : [x].dropLast = [] := rfl
|
||||
@[simp] theorem dropLast_cons₂ :
|
||||
(x::y::zs).dropLast = x :: (y::zs).dropLast := rfl
|
||||
|
||||
-- We may want to replace these `simp` attributes with explicit equational lemmas,
|
||||
-- as we already have for all the non-monadic functions.
|
||||
attribute [simp] mapA forA filterAuxM firstM anyM allM findM? findSomeM?
|
||||
|
||||
-- Previously `range.loop`, `mapM.loop`, `filterMapM.loop`, `forIn.loop`, `forIn'.loop`
|
||||
-- had attribute `@[simp]`.
|
||||
-- We don't currently provide simp lemmas,
|
||||
-- as this is an internal implementation and they don't seem to be needed.
|
||||
|
||||
/-! ### minimum? -/
|
||||
|
||||
@[simp] theorem minimum?_nil [Min α] : ([] : List α).minimum? = none := rfl
|
||||
|
||||
-- We don't put `@[simp]` on `minimum?_cons`,
|
||||
-- because the definition in terms of `foldl` is not useful for proofs.
|
||||
theorem minimum?_cons [Min α] {xs : List α} : (x :: xs).minimum? = foldl min x xs := rfl
|
||||
|
||||
@[simp] theorem minimum?_eq_none_iff {xs : List α} [Min α] : xs.minimum? = none ↔ xs = [] := by
|
||||
cases xs <;> simp [minimum?]
|
||||
|
||||
theorem minimum?_mem [Min α] (min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b) :
|
||||
{xs : List α} → xs.minimum? = some a → a ∈ xs := by
|
||||
intro xs
|
||||
match xs with
|
||||
| nil => simp
|
||||
| x :: xs =>
|
||||
simp only [minimum?_cons, Option.some.injEq, List.mem_cons]
|
||||
intro eq
|
||||
induction xs generalizing x with
|
||||
| nil =>
|
||||
simp at eq
|
||||
simp [eq]
|
||||
| cons y xs ind =>
|
||||
simp at eq
|
||||
have p := ind _ eq
|
||||
cases p with
|
||||
| inl p =>
|
||||
cases min_eq_or x y with | _ q => simp [p, q]
|
||||
| inr p => simp [p, mem_cons]
|
||||
|
||||
theorem le_minimum?_iff [Min α] [LE α]
|
||||
(le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) :
|
||||
{xs : List α} → xs.minimum? = some a → ∀ x, x ≤ a ↔ ∀ b, b ∈ xs → x ≤ b
|
||||
| nil => by simp
|
||||
| cons x xs => by
|
||||
rw [minimum?]
|
||||
intro eq y
|
||||
simp only [Option.some.injEq] at eq
|
||||
induction xs generalizing x with
|
||||
| nil =>
|
||||
simp at eq
|
||||
simp [eq]
|
||||
| cons z xs ih =>
|
||||
simp at eq
|
||||
simp [ih _ eq, le_min_iff, and_assoc]
|
||||
|
||||
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`,
|
||||
-- and `le_min_iff`.
|
||||
theorem minimum?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ≤ ·)]
|
||||
(le_refl : ∀ a : α, a ≤ a)
|
||||
(min_eq_or : ∀ a b : α, min a b = a ∨ min a b = b)
|
||||
(le_min_iff : ∀ a b c : α, a ≤ min b c ↔ a ≤ b ∧ a ≤ c) {xs : List α} :
|
||||
xs.minimum? = some a ↔ a ∈ xs ∧ ∀ b, b ∈ xs → a ≤ b := by
|
||||
refine ⟨fun h => ⟨minimum?_mem min_eq_or h, (le_minimum?_iff le_min_iff h _).1 (le_refl _)⟩, ?_⟩
|
||||
intro ⟨h₁, h₂⟩
|
||||
cases xs with
|
||||
| nil => simp at h₁
|
||||
| cons x xs =>
|
||||
exact congrArg some <| anti.1
|
||||
((le_minimum?_iff le_min_iff (xs := x::xs) rfl _).1 (le_refl _) _ h₁)
|
||||
(h₂ _ (minimum?_mem min_eq_or (xs := x::xs) rfl))
|
||||
@@ -6,9 +6,7 @@ Authors: Leonardo de Moura
|
||||
prelude
|
||||
import Init.Data.Nat.Basic
|
||||
import Init.Data.Nat.Div
|
||||
import Init.Data.Nat.Dvd
|
||||
import Init.Data.Nat.Gcd
|
||||
import Init.Data.Nat.MinMax
|
||||
import Init.Data.Nat.Bitwise
|
||||
import Init.Data.Nat.Control
|
||||
import Init.Data.Nat.Log2
|
||||
|
||||
@@ -147,20 +147,13 @@ protected theorem add_right_comm (n m k : Nat) : (n + m) + k = (n + k) + m := by
|
||||
|
||||
protected theorem add_left_cancel {n m k : Nat} : n + m = n + k → m = k := by
|
||||
induction n with
|
||||
| zero => simp
|
||||
| zero => simp; intros; assumption
|
||||
| succ n ih => simp [succ_add]; intro h; apply ih h
|
||||
|
||||
protected theorem add_right_cancel {n m k : Nat} (h : n + m = k + m) : n = k := by
|
||||
rw [Nat.add_comm n m, Nat.add_comm k m] at h
|
||||
apply Nat.add_left_cancel h
|
||||
|
||||
theorem eq_zero_of_add_eq_zero : ∀ {n m}, n + m = 0 → n = 0 ∧ m = 0
|
||||
| 0, 0, _ => ⟨rfl, rfl⟩
|
||||
| _+1, 0, h => Nat.noConfusion h
|
||||
|
||||
protected theorem eq_zero_of_add_eq_zero_left (h : n + m = 0) : m = 0 :=
|
||||
(Nat.eq_zero_of_add_eq_zero h).2
|
||||
|
||||
/-! # Nat.mul theorems -/
|
||||
|
||||
@[simp] protected theorem mul_zero (n : Nat) : n * 0 = 0 :=
|
||||
@@ -213,13 +206,16 @@ protected theorem mul_left_comm (n m k : Nat) : n * (m * k) = m * (n * k) := by
|
||||
|
||||
attribute [simp] Nat.le_refl
|
||||
|
||||
theorem succ_lt_succ {n m : Nat} : n < m → succ n < succ m := succ_le_succ
|
||||
theorem succ_lt_succ {n m : Nat} : n < m → succ n < succ m :=
|
||||
succ_le_succ
|
||||
|
||||
theorem lt_succ_of_le {n m : Nat} : n ≤ m → n < succ m := succ_le_succ
|
||||
theorem lt_succ_of_le {n m : Nat} : n ≤ m → n < succ m :=
|
||||
succ_le_succ
|
||||
|
||||
@[simp] protected theorem sub_zero (n : Nat) : n - 0 = n := rfl
|
||||
@[simp] protected theorem sub_zero (n : Nat) : n - 0 = n :=
|
||||
rfl
|
||||
|
||||
@[simp] theorem succ_sub_succ_eq_sub (n m : Nat) : succ n - succ m = n - m := by
|
||||
theorem succ_sub_succ_eq_sub (n m : Nat) : succ n - succ m = n - m := by
|
||||
induction m with
|
||||
| zero => exact rfl
|
||||
| succ m ih => apply congrArg pred ih
|
||||
@@ -245,7 +241,8 @@ theorem sub_lt : ∀ {n m : Nat}, 0 < n → 0 < m → n - m < n
|
||||
show n - m < succ n from
|
||||
lt_succ_of_le (sub_le n m)
|
||||
|
||||
theorem sub_succ (n m : Nat) : n - succ m = pred (n - m) := rfl
|
||||
theorem sub_succ (n m : Nat) : n - succ m = pred (n - m) :=
|
||||
rfl
|
||||
|
||||
theorem succ_sub_succ (n m : Nat) : succ n - succ m = n - m :=
|
||||
succ_sub_succ_eq_sub n m
|
||||
@@ -280,24 +277,20 @@ instance : Trans (. ≤ . : Nat → Nat → Prop) (. < . : Nat → Nat → Prop)
|
||||
protected theorem le_of_eq {n m : Nat} (p : n = m) : n ≤ m :=
|
||||
p ▸ Nat.le_refl n
|
||||
|
||||
theorem le_of_succ_le {n m : Nat} (h : succ n ≤ m) : n ≤ m :=
|
||||
Nat.le_trans (le_succ n) h
|
||||
|
||||
protected theorem le_of_lt {n m : Nat} (h : n < m) : n ≤ m :=
|
||||
le_of_succ_le h
|
||||
|
||||
theorem lt.step {n m : Nat} : n < m → n < succ m := le_step
|
||||
|
||||
theorem le_of_succ_le {n m : Nat} (h : succ n ≤ m) : n ≤ m := Nat.le_trans (le_succ n) h
|
||||
theorem lt_of_succ_lt {n m : Nat} : succ n < m → n < m := le_of_succ_le
|
||||
protected theorem le_of_lt {n m : Nat} : n < m → n ≤ m := le_of_succ_le
|
||||
|
||||
theorem lt_of_succ_lt_succ {n m : Nat} : succ n < succ m → n < m := le_of_succ_le_succ
|
||||
|
||||
theorem lt_of_succ_le {n m : Nat} (h : succ n ≤ m) : n < m := h
|
||||
theorem succ_le_of_lt {n m : Nat} (h : n < m) : succ n ≤ m := h
|
||||
|
||||
theorem eq_zero_or_pos : ∀ (n : Nat), n = 0 ∨ n > 0
|
||||
| 0 => Or.inl rfl
|
||||
| _+1 => Or.inr (succ_pos _)
|
||||
|
||||
protected theorem pos_of_ne_zero {n : Nat} : n ≠ 0 → 0 < n := (eq_zero_or_pos n).resolve_left
|
||||
|
||||
theorem lt.base (n : Nat) : n < succ n := Nat.le_refl (succ n)
|
||||
|
||||
theorem lt_succ_self (n : Nat) : n < succ n := lt.base n
|
||||
|
||||
protected theorem le_total (m n : Nat) : m ≤ n ∨ n ≤ m :=
|
||||
@@ -305,7 +298,20 @@ protected theorem le_total (m n : Nat) : m ≤ n ∨ n ≤ m :=
|
||||
| Or.inl h => Or.inl (Nat.le_of_lt h)
|
||||
| Or.inr h => Or.inr h
|
||||
|
||||
theorem eq_zero_of_le_zero {n : Nat} (h : n ≤ 0) : n = 0 := Nat.le_antisymm h (zero_le _)
|
||||
theorem eq_zero_of_le_zero {n : Nat} (h : n ≤ 0) : n = 0 :=
|
||||
Nat.le_antisymm h (zero_le _)
|
||||
|
||||
theorem lt_of_succ_lt {n m : Nat} : succ n < m → n < m :=
|
||||
le_of_succ_le
|
||||
|
||||
theorem lt_of_succ_lt_succ {n m : Nat} : succ n < succ m → n < m :=
|
||||
le_of_succ_le_succ
|
||||
|
||||
theorem lt_of_succ_le {n m : Nat} (h : succ n ≤ m) : n < m :=
|
||||
h
|
||||
|
||||
theorem succ_le_of_lt {n m : Nat} (h : n < m) : succ n ≤ m :=
|
||||
h
|
||||
|
||||
theorem zero_lt_of_lt : {a b : Nat} → a < b → 0 < b
|
||||
| 0, _, h => h
|
||||
@@ -320,7 +326,8 @@ theorem zero_lt_of_ne_zero {a : Nat} (h : a ≠ 0) : 0 < a := by
|
||||
|
||||
attribute [simp] Nat.lt_irrefl
|
||||
|
||||
theorem ne_of_lt {a b : Nat} (h : a < b) : a ≠ b := fun he => absurd (he ▸ h) (Nat.lt_irrefl a)
|
||||
theorem ne_of_lt {a b : Nat} (h : a < b) : a ≠ b :=
|
||||
fun he => absurd (he ▸ h) (Nat.lt_irrefl a)
|
||||
|
||||
theorem le_or_eq_of_le_succ {m n : Nat} (h : m ≤ succ n) : m ≤ n ∨ m = succ n :=
|
||||
Decidable.byCases
|
||||
@@ -356,51 +363,16 @@ protected theorem not_le_of_gt {n m : Nat} (h : n > m) : ¬ n ≤ m := fun h₁
|
||||
| Or.inr h₂ =>
|
||||
have Heq : n = m := Nat.le_antisymm h₁ h₂
|
||||
absurd (@Eq.subst _ _ _ _ Heq h) (Nat.lt_irrefl m)
|
||||
protected theorem not_le_of_lt : ∀{a b : Nat}, a < b → ¬(b ≤ a) := Nat.not_le_of_gt
|
||||
protected theorem not_lt_of_ge : ∀{a b : Nat}, b ≥ a → ¬(b < a) := flip Nat.not_le_of_gt
|
||||
protected theorem not_lt_of_le : ∀{a b : Nat}, a ≤ b → ¬(b < a) := flip Nat.not_le_of_gt
|
||||
protected theorem lt_le_asymm : ∀{a b : Nat}, a < b → ¬(b ≤ a) := Nat.not_le_of_gt
|
||||
protected theorem le_lt_asymm : ∀{a b : Nat}, a ≤ b → ¬(b < a) := flip Nat.not_le_of_gt
|
||||
|
||||
theorem gt_of_not_le {n m : Nat} (h : ¬ n ≤ m) : n > m := (Nat.lt_or_ge m n).resolve_right h
|
||||
protected theorem lt_of_not_ge : ∀{a b : Nat}, ¬(b ≥ a) → b < a := Nat.gt_of_not_le
|
||||
protected theorem lt_of_not_le : ∀{a b : Nat}, ¬(a ≤ b) → b < a := Nat.gt_of_not_le
|
||||
theorem gt_of_not_le {n m : Nat} (h : ¬ n ≤ m) : n > m :=
|
||||
match Nat.lt_or_ge m n with
|
||||
| Or.inl h₁ => h₁
|
||||
| Or.inr h₁ => absurd h₁ h
|
||||
|
||||
theorem ge_of_not_lt {n m : Nat} (h : ¬ n < m) : n ≥ m := (Nat.lt_or_ge n m).resolve_left h
|
||||
protected theorem le_of_not_gt : ∀{a b : Nat}, ¬(b > a) → b ≤ a := Nat.ge_of_not_lt
|
||||
protected theorem le_of_not_lt : ∀{a b : Nat}, ¬(a < b) → b ≤ a := Nat.ge_of_not_lt
|
||||
|
||||
theorem ne_of_gt {a b : Nat} (h : b < a) : a ≠ b := (ne_of_lt h).symm
|
||||
protected theorem ne_of_lt' : ∀{a b : Nat}, a < b → b ≠ a := ne_of_gt
|
||||
|
||||
@[simp] protected theorem not_le {a b : Nat} : ¬ a ≤ b ↔ b < a :=
|
||||
Iff.intro Nat.gt_of_not_le Nat.not_le_of_gt
|
||||
@[simp] protected theorem not_lt {a b : Nat} : ¬ a < b ↔ b ≤ a :=
|
||||
Iff.intro Nat.ge_of_not_lt (flip Nat.not_le_of_gt)
|
||||
|
||||
protected theorem le_of_not_le {a b : Nat} (h : ¬ b ≤ a) : a ≤ b := Nat.le_of_lt (Nat.not_le.1 h)
|
||||
protected theorem le_of_not_ge : ∀{a b : Nat}, ¬(a ≥ b) → a ≤ b:= @Nat.le_of_not_le
|
||||
|
||||
protected theorem lt_trichotomy (a b : Nat) : a < b ∨ a = b ∨ b < a :=
|
||||
match Nat.lt_or_ge a b with
|
||||
| .inl h => .inl h
|
||||
| .inr h =>
|
||||
match Nat.eq_or_lt_of_le h with
|
||||
| .inl h => .inr (.inl h.symm)
|
||||
| .inr h => .inr (.inr h)
|
||||
|
||||
protected theorem lt_or_gt_of_ne {a b : Nat} (ne : a ≠ b) : a < b ∨ a > b :=
|
||||
match Nat.lt_trichotomy a b with
|
||||
| .inl h => .inl h
|
||||
| .inr (.inl e) => False.elim (ne e)
|
||||
| .inr (.inr h) => .inr h
|
||||
|
||||
protected theorem lt_or_lt_of_ne : ∀{a b : Nat}, a ≠ b → a < b ∨ b < a := Nat.lt_or_gt_of_ne
|
||||
|
||||
protected theorem le_antisymm_iff {a b : Nat} : a = b ↔ a ≤ b ∧ b ≤ a :=
|
||||
Iff.intro (fun p => And.intro (Nat.le_of_eq p) (Nat.le_of_eq p.symm))
|
||||
(fun ⟨hle, hge⟩ => Nat.le_antisymm hle hge)
|
||||
protected theorem eq_iff_le_and_ge : ∀{a b : Nat}, a = b ↔ a ≤ b ∧ b ≤ a := @Nat.le_antisymm_iff
|
||||
theorem ge_of_not_lt {n m : Nat} (h : ¬ n < m) : n ≥ m :=
|
||||
match Nat.lt_or_ge n m with
|
||||
| Or.inl h₁ => absurd h₁ h
|
||||
| Or.inr h₁ => h₁
|
||||
|
||||
instance : Antisymm ( . ≤ . : Nat → Nat → Prop) where
|
||||
antisymm h₁ h₂ := Nat.le_antisymm h₁ h₂
|
||||
@@ -429,8 +401,6 @@ protected theorem add_lt_add_right {n m : Nat} (h : n < m) (k : Nat) : n + k < m
|
||||
protected theorem zero_lt_one : 0 < (1:Nat) :=
|
||||
zero_lt_succ 0
|
||||
|
||||
protected theorem pos_iff_ne_zero : 0 < n ↔ n ≠ 0 := ⟨ne_of_gt, Nat.pos_of_ne_zero⟩
|
||||
|
||||
theorem add_le_add {a b c d : Nat} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d :=
|
||||
Nat.le_trans (Nat.add_le_add_right h₁ c) (Nat.add_le_add_left h₂ b)
|
||||
|
||||
@@ -448,9 +418,6 @@ protected theorem le_of_add_le_add_right {a b c : Nat} : a + b ≤ c + b → a
|
||||
rw [Nat.add_comm _ b, Nat.add_comm _ b]
|
||||
apply Nat.le_of_add_le_add_left
|
||||
|
||||
protected theorem add_le_add_iff_right {n : Nat} : m + n ≤ k + n ↔ m ≤ k :=
|
||||
⟨Nat.le_of_add_le_add_right, fun h => Nat.add_le_add_right h _⟩
|
||||
|
||||
/-! # Basic theorems for comparing numerals -/
|
||||
|
||||
theorem ctor_eq_zero : Nat.zero = 0 :=
|
||||
@@ -560,20 +527,7 @@ theorem not_eq_zero_of_lt (h : b < a) : a ≠ 0 := by
|
||||
theorem pred_lt' {n m : Nat} (h : m < n) : pred n < n :=
|
||||
pred_lt (not_eq_zero_of_lt h)
|
||||
|
||||
/-! # pred theorems -/
|
||||
|
||||
@[simp] protected theorem pred_zero : pred 0 = 0 := rfl
|
||||
@[simp] protected theorem pred_succ (n : Nat) : pred n.succ = n := rfl
|
||||
|
||||
theorem succ_pred {a : Nat} (h : a ≠ 0) : a.pred.succ = a := by
|
||||
induction a with
|
||||
| zero => contradiction
|
||||
| succ => rfl
|
||||
|
||||
theorem succ_pred_eq_of_pos : ∀ {n}, 0 < n → succ (pred n) = n
|
||||
| _+1, _ => rfl
|
||||
|
||||
/-! # sub theorems -/
|
||||
/-! # sub/pred theorems -/
|
||||
|
||||
theorem add_sub_self_left (a b : Nat) : (a + b) - a = b := by
|
||||
induction a with
|
||||
@@ -607,6 +561,11 @@ theorem sub_succ_lt_self (a i : Nat) (h : i < a) : a - (i + 1) < a - i := by
|
||||
apply Nat.zero_lt_sub_of_lt
|
||||
assumption
|
||||
|
||||
theorem succ_pred {a : Nat} (h : a ≠ 0) : a.pred.succ = a := by
|
||||
induction a with
|
||||
| zero => contradiction
|
||||
| succ => rfl
|
||||
|
||||
theorem sub_ne_zero_of_lt : {a b : Nat} → a < b → b - a ≠ 0
|
||||
| 0, 0, h => absurd h (Nat.lt_irrefl 0)
|
||||
| 0, succ b, _ => by simp
|
||||
@@ -632,7 +591,7 @@ protected theorem add_sub_add_right (n k m : Nat) : (n + k) - (m + k) = n - m :=
|
||||
protected theorem add_sub_add_left (k n m : Nat) : (k + n) - (k + m) = n - m := by
|
||||
rw [Nat.add_comm k n, Nat.add_comm k m, Nat.add_sub_add_right]
|
||||
|
||||
@[simp] protected theorem add_sub_cancel (n m : Nat) : n + m - m = n :=
|
||||
protected theorem add_sub_cancel (n m : Nat) : n + m - m = n :=
|
||||
suffices n + m - (0 + m) = n by rw [Nat.zero_add] at this; assumption
|
||||
by rw [Nat.add_sub_add_right, Nat.sub_zero]
|
||||
|
||||
@@ -721,6 +680,12 @@ theorem lt_sub_of_add_lt {a b c : Nat} (h : a + b < c) : a < c - b :=
|
||||
have : a.succ + b ≤ c := by simp [Nat.succ_add]; exact h
|
||||
le_sub_of_add_le this
|
||||
|
||||
@[simp] protected theorem pred_zero : pred 0 = 0 :=
|
||||
rfl
|
||||
|
||||
@[simp] protected theorem pred_succ (n : Nat) : pred n.succ = n :=
|
||||
rfl
|
||||
|
||||
theorem sub.elim {motive : Nat → Prop}
|
||||
(x y : Nat)
|
||||
(h₁ : y ≤ x → (k : Nat) → x = y + k → motive k)
|
||||
@@ -730,75 +695,18 @@ theorem sub.elim {motive : Nat → Prop}
|
||||
| inl hlt => rw [Nat.sub_eq_zero_of_le (Nat.le_of_lt hlt)]; exact h₂ hlt
|
||||
| inr hle => exact h₁ hle (x - y) (Nat.add_sub_of_le hle).symm
|
||||
|
||||
theorem succ_sub {m n : Nat} (h : n ≤ m) : succ m - n = succ (m - n) := by
|
||||
let ⟨k, hk⟩ := Nat.le.dest h
|
||||
rw [← hk, Nat.add_sub_cancel_left, ← add_succ, Nat.add_sub_cancel_left]
|
||||
|
||||
protected theorem sub_pos_of_lt (h : m < n) : 0 < n - m :=
|
||||
Nat.pos_iff_ne_zero.2 (Nat.sub_ne_zero_of_lt h)
|
||||
|
||||
protected theorem sub_sub (n m k : Nat) : n - m - k = n - (m + k) := by
|
||||
induction k with
|
||||
| zero => simp
|
||||
| succ k ih => rw [Nat.add_succ, Nat.sub_succ, Nat.sub_succ, ih]
|
||||
|
||||
protected theorem sub_le_sub_left (h : n ≤ m) (k : Nat) : k - m ≤ k - n :=
|
||||
match m, le.dest h with
|
||||
| _, ⟨a, rfl⟩ => by rw [← Nat.sub_sub]; apply sub_le
|
||||
|
||||
protected theorem sub_le_sub_right {n m : Nat} (h : n ≤ m) : ∀ k, n - k ≤ m - k
|
||||
| 0 => h
|
||||
| z+1 => pred_le_pred (Nat.sub_le_sub_right h z)
|
||||
|
||||
protected theorem lt_of_sub_ne_zero (h : n - m ≠ 0) : m < n :=
|
||||
Nat.not_le.1 (mt Nat.sub_eq_zero_of_le h)
|
||||
|
||||
protected theorem sub_ne_zero_iff_lt : n - m ≠ 0 ↔ m < n :=
|
||||
⟨Nat.lt_of_sub_ne_zero, Nat.sub_ne_zero_of_lt⟩
|
||||
|
||||
protected theorem lt_of_sub_pos (h : 0 < n - m) : m < n :=
|
||||
Nat.lt_of_sub_ne_zero (Nat.pos_iff_ne_zero.1 h)
|
||||
|
||||
protected theorem lt_of_sub_eq_succ (h : m - n = succ l) : n < m :=
|
||||
Nat.lt_of_sub_pos (h ▸ Nat.zero_lt_succ _)
|
||||
|
||||
protected theorem sub_lt_left_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < n + m) : k - n < m := by
|
||||
have := Nat.sub_le_sub_right (succ_le_of_lt h) n
|
||||
rwa [Nat.add_sub_cancel_left, Nat.succ_sub H] at this
|
||||
|
||||
protected theorem sub_lt_right_of_lt_add {n k m : Nat} (H : n ≤ k) (h : k < m + n) : k - n < m :=
|
||||
Nat.sub_lt_left_of_lt_add H (Nat.add_comm .. ▸ h)
|
||||
|
||||
protected theorem le_of_sub_eq_zero : ∀ {n m}, n - m = 0 → n ≤ m
|
||||
| 0, _, _ => Nat.zero_le ..
|
||||
| _+1, _+1, h => Nat.succ_le_succ <| Nat.le_of_sub_eq_zero (Nat.succ_sub_succ .. ▸ h)
|
||||
|
||||
protected theorem le_of_sub_le_sub_right : ∀ {n m k : Nat}, k ≤ m → n - k ≤ m - k → n ≤ m
|
||||
| 0, _, _, _, _ => Nat.zero_le ..
|
||||
| _+1, _, 0, _, h₁ => h₁
|
||||
| _+1, _+1, _+1, h₀, h₁ => by
|
||||
simp only [Nat.succ_sub_succ] at h₁
|
||||
exact succ_le_succ <| Nat.le_of_sub_le_sub_right (le_of_succ_le_succ h₀) h₁
|
||||
|
||||
protected theorem sub_le_sub_iff_right {n : Nat} (h : k ≤ m) : n - k ≤ m - k ↔ n ≤ m :=
|
||||
⟨Nat.le_of_sub_le_sub_right h, fun h => Nat.sub_le_sub_right h _⟩
|
||||
|
||||
protected theorem sub_eq_iff_eq_add {c : Nat} (h : b ≤ a) : a - b = c ↔ a = c + b :=
|
||||
⟨fun | rfl => by rw [Nat.sub_add_cancel h], fun heq => by rw [heq, Nat.add_sub_cancel]⟩
|
||||
|
||||
protected theorem sub_eq_iff_eq_add' {c : Nat} (h : b ≤ a) : a - b = c ↔ a = b + c := by
|
||||
rw [Nat.add_comm, Nat.sub_eq_iff_eq_add h]
|
||||
|
||||
theorem mul_pred_left (n m : Nat) : pred n * m = n * m - m := by
|
||||
cases n with
|
||||
| zero => simp
|
||||
| succ n => rw [Nat.pred_succ, succ_mul, Nat.add_sub_cancel]
|
||||
|
||||
/-! ## Mul sub distrib -/
|
||||
|
||||
theorem mul_pred_right (n m : Nat) : n * pred m = n * m - n := by
|
||||
rw [Nat.mul_comm, mul_pred_left, Nat.mul_comm]
|
||||
|
||||
protected theorem sub_sub (n m k : Nat) : n - m - k = n - (m + k) := by
|
||||
induction k with
|
||||
| zero => simp
|
||||
| succ k ih => rw [Nat.add_succ, Nat.sub_succ, Nat.sub_succ, ih]
|
||||
|
||||
protected theorem mul_sub_right_distrib (n m k : Nat) : (n - m) * k = n * k - m * k := by
|
||||
induction m with
|
||||
@@ -811,12 +719,14 @@ protected theorem mul_sub_left_distrib (n m k : Nat) : n * (m - k) = n * m - n *
|
||||
/-! # Helper normalization theorems -/
|
||||
|
||||
theorem not_le_eq (a b : Nat) : (¬ (a ≤ b)) = (b + 1 ≤ a) :=
|
||||
Eq.propIntro Nat.gt_of_not_le Nat.not_le_of_gt
|
||||
propext <| Iff.intro (fun h => Nat.gt_of_not_le h) (fun h => Nat.not_le_of_gt h)
|
||||
|
||||
theorem not_ge_eq (a b : Nat) : (¬ (a ≥ b)) = (a + 1 ≤ b) :=
|
||||
not_le_eq b a
|
||||
|
||||
theorem not_lt_eq (a b : Nat) : (¬ (a < b)) = (b ≤ a) :=
|
||||
Eq.propIntro Nat.le_of_not_lt Nat.not_lt_of_le
|
||||
propext <| Iff.intro (fun h => have h := Nat.succ_le_of_lt (Nat.gt_of_not_le h); Nat.le_of_succ_le_succ h) (fun h => Nat.not_le_of_gt (Nat.succ_le_succ h))
|
||||
|
||||
theorem not_gt_eq (a b : Nat) : (¬ (a > b)) = (a ≤ b) :=
|
||||
not_lt_eq b a
|
||||
|
||||
|
||||
@@ -7,7 +7,6 @@ prelude
|
||||
import Init.WF
|
||||
import Init.WFTactics
|
||||
import Init.Data.Nat.Basic
|
||||
|
||||
namespace Nat
|
||||
|
||||
theorem div_rec_lemma {x y : Nat} : 0 < y ∧ y ≤ x → x - y < x :=
|
||||
@@ -175,136 +174,4 @@ theorem div_add_mod (m n : Nat) : n * (m / n) + m % n = m := by
|
||||
rw [Nat.left_distrib, Nat.mul_one, Nat.add_assoc, Nat.add_left_comm, ih, Nat.add_comm, Nat.sub_add_cancel h.2]
|
||||
decreasing_by apply div_rec_lemma; assumption
|
||||
|
||||
theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b ≤ a) : a / b = (a - b) / b + 1 := by
|
||||
rw [div_eq a, if_pos]; constructor <;> assumption
|
||||
|
||||
|
||||
theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by
|
||||
induction m, k using mod.inductionOn with rw [div_eq, mod_eq]
|
||||
| base x y h => simp [h]
|
||||
| ind x y h IH => simp [h]; rw [Nat.mul_succ, ← Nat.add_assoc, IH, Nat.sub_add_cancel h.2]
|
||||
|
||||
@[simp] protected theorem div_one (n : Nat) : n / 1 = n := by
|
||||
have := mod_add_div n 1
|
||||
rwa [mod_one, Nat.zero_add, Nat.one_mul] at this
|
||||
|
||||
@[simp] protected theorem div_zero (n : Nat) : n / 0 = 0 := by
|
||||
rw [div_eq]; simp [Nat.lt_irrefl]
|
||||
|
||||
@[simp] protected theorem zero_div (b : Nat) : 0 / b = 0 :=
|
||||
(div_eq 0 b).trans <| if_neg <| And.rec Nat.not_le_of_gt
|
||||
|
||||
theorem le_div_iff_mul_le (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y := by
|
||||
induction y, k using mod.inductionOn generalizing x with
|
||||
(rw [div_eq]; simp [h]; cases x with | zero => simp [zero_le] | succ x => ?_)
|
||||
| base y k h =>
|
||||
simp [not_succ_le_zero x, succ_mul, Nat.add_comm]
|
||||
refine Nat.lt_of_lt_of_le ?_ (Nat.le_add_right ..)
|
||||
exact Nat.not_le.1 fun h' => h ⟨k0, h'⟩
|
||||
| ind y k h IH =>
|
||||
rw [← add_one, Nat.add_le_add_iff_right, IH k0, succ_mul,
|
||||
← Nat.add_sub_cancel (x*k) k, Nat.sub_le_sub_iff_right h.2, Nat.add_sub_cancel]
|
||||
|
||||
theorem div_mul_le_self : ∀ (m n : Nat), m / n * n ≤ m
|
||||
| m, 0 => by simp
|
||||
| m, n+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _)
|
||||
|
||||
theorem div_lt_iff_lt_mul (Hk : 0 < k) : x / k < y ↔ x < y * k := by
|
||||
rw [← Nat.not_le, ← Nat.not_le]; exact not_congr (le_div_iff_mul_le Hk)
|
||||
|
||||
@[simp] theorem add_div_right (x : Nat) {z : Nat} (H : 0 < z) : (x + z) / z = succ (x / z) := by
|
||||
rw [div_eq_sub_div H (Nat.le_add_left _ _), Nat.add_sub_cancel]
|
||||
|
||||
@[simp] theorem add_div_left (x : Nat) {z : Nat} (H : 0 < z) : (z + x) / z = succ (x / z) := by
|
||||
rw [Nat.add_comm, add_div_right x H]
|
||||
|
||||
theorem add_mul_div_left (x z : Nat) {y : Nat} (H : 0 < y) : (x + y * z) / y = x / y + z := by
|
||||
induction z with
|
||||
| zero => rw [Nat.mul_zero, Nat.add_zero, Nat.add_zero]
|
||||
| succ z ih => rw [mul_succ, ← Nat.add_assoc, add_div_right _ H, ih]; rfl
|
||||
|
||||
theorem add_mul_div_right (x y : Nat) {z : Nat} (H : 0 < z) : (x + y * z) / z = x / z + y := by
|
||||
rw [Nat.mul_comm, add_mul_div_left _ _ H]
|
||||
|
||||
@[simp] theorem add_mod_right (x z : Nat) : (x + z) % z = x % z := by
|
||||
rw [mod_eq_sub_mod (Nat.le_add_left ..), Nat.add_sub_cancel]
|
||||
|
||||
@[simp] theorem add_mod_left (x z : Nat) : (x + z) % x = z % x := by
|
||||
rw [Nat.add_comm, add_mod_right]
|
||||
|
||||
@[simp] theorem add_mul_mod_self_left (x y z : Nat) : (x + y * z) % y = x % y := by
|
||||
match z with
|
||||
| 0 => rw [Nat.mul_zero, Nat.add_zero]
|
||||
| succ z => rw [mul_succ, ← Nat.add_assoc, add_mod_right, add_mul_mod_self_left (z := z)]
|
||||
|
||||
@[simp] theorem add_mul_mod_self_right (x y z : Nat) : (x + y * z) % z = x % z := by
|
||||
rw [Nat.mul_comm, add_mul_mod_self_left]
|
||||
|
||||
@[simp] theorem mul_mod_right (m n : Nat) : (m * n) % m = 0 := by
|
||||
rw [← Nat.zero_add (m * n), add_mul_mod_self_left, zero_mod]
|
||||
|
||||
@[simp] theorem mul_mod_left (m n : Nat) : (m * n) % n = 0 := by
|
||||
rw [Nat.mul_comm, mul_mod_right]
|
||||
|
||||
protected theorem div_eq_of_lt_le (lo : k * n ≤ m) (hi : m < succ k * n) : m / n = k :=
|
||||
have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun hn => by
|
||||
rw [hn, Nat.mul_zero] at hi lo; exact absurd lo (Nat.not_le_of_gt hi)
|
||||
Nat.le_antisymm
|
||||
(le_of_lt_succ ((Nat.div_lt_iff_lt_mul npos).2 hi))
|
||||
((Nat.le_div_iff_mul_le npos).2 lo)
|
||||
|
||||
theorem sub_mul_div (x n p : Nat) (h₁ : n*p ≤ x) : (x - n*p) / n = x / n - p := by
|
||||
match eq_zero_or_pos n with
|
||||
| .inl h₀ => rw [h₀, Nat.div_zero, Nat.div_zero, Nat.zero_sub]
|
||||
| .inr h₀ => induction p with
|
||||
| zero => rw [Nat.mul_zero, Nat.sub_zero, Nat.sub_zero]
|
||||
| succ p IH =>
|
||||
have h₂ : n * p ≤ x := Nat.le_trans (Nat.mul_le_mul_left _ (le_succ _)) h₁
|
||||
have h₃ : x - n * p ≥ n := by
|
||||
apply Nat.le_of_add_le_add_right
|
||||
rw [Nat.sub_add_cancel h₂, Nat.add_comm]
|
||||
rw [mul_succ] at h₁
|
||||
exact h₁
|
||||
rw [sub_succ, ← IH h₂, div_eq_sub_div h₀ h₃]
|
||||
simp [add_one, Nat.pred_succ, mul_succ, Nat.sub_sub]
|
||||
|
||||
theorem mul_sub_div (x n p : Nat) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) := by
|
||||
have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun n0 => by
|
||||
rw [n0, Nat.zero_mul] at h₁; exact not_lt_zero _ h₁
|
||||
apply Nat.div_eq_of_lt_le
|
||||
focus
|
||||
rw [Nat.mul_sub_right_distrib, Nat.mul_comm]
|
||||
exact Nat.sub_le_sub_left ((div_lt_iff_lt_mul npos).1 (lt_succ_self _)) _
|
||||
focus
|
||||
show succ (pred (n * p - x)) ≤ (succ (pred (p - x / n))) * n
|
||||
rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁),
|
||||
fun h => succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)] -- TODO: why is the function needed?
|
||||
focus
|
||||
rw [Nat.mul_sub_right_distrib, Nat.mul_comm]
|
||||
exact Nat.sub_le_sub_left (div_mul_le_self ..) _
|
||||
focus
|
||||
rwa [div_lt_iff_lt_mul npos, Nat.mul_comm]
|
||||
|
||||
theorem mul_mod_mul_left (z x y : Nat) : (z * x) % (z * y) = z * (x % y) :=
|
||||
if y0 : y = 0 then by
|
||||
rw [y0, Nat.mul_zero, mod_zero, mod_zero]
|
||||
else if z0 : z = 0 then by
|
||||
rw [z0, Nat.zero_mul, Nat.zero_mul, Nat.zero_mul, mod_zero]
|
||||
else by
|
||||
induction x using Nat.strongInductionOn with
|
||||
| _ n IH =>
|
||||
have y0 : y > 0 := Nat.pos_of_ne_zero y0
|
||||
have z0 : z > 0 := Nat.pos_of_ne_zero z0
|
||||
cases Nat.lt_or_ge n y with
|
||||
| inl yn => rw [mod_eq_of_lt yn, mod_eq_of_lt (Nat.mul_lt_mul_of_pos_left yn z0)]
|
||||
| inr yn =>
|
||||
rw [mod_eq_sub_mod yn, mod_eq_sub_mod (Nat.mul_le_mul_left z yn),
|
||||
← Nat.mul_sub_left_distrib]
|
||||
exact IH _ (sub_lt (Nat.lt_of_lt_of_le y0 yn) y0)
|
||||
|
||||
theorem div_eq_of_lt (h₀ : a < b) : a / b = 0 := by
|
||||
rw [div_eq a, if_neg]
|
||||
intro h₁
|
||||
apply Nat.not_le_of_gt h₀ h₁.right
|
||||
|
||||
end Nat
|
||||
|
||||
@@ -1,96 +0,0 @@
|
||||
prelude
|
||||
import Init.Data.Nat.Div
|
||||
|
||||
namespace Nat
|
||||
|
||||
/--
|
||||
Divisibility of natural numbers. `a ∣ b` (typed as `\|`) says that
|
||||
there is some `c` such that `b = a * c`.
|
||||
-/
|
||||
instance : Dvd Nat where
|
||||
dvd a b := Exists (fun c => b = a * c)
|
||||
|
||||
protected theorem dvd_refl (a : Nat) : a ∣ a := ⟨1, by simp⟩
|
||||
|
||||
protected theorem dvd_zero (a : Nat) : a ∣ 0 := ⟨0, by simp⟩
|
||||
|
||||
protected theorem dvd_mul_left (a b : Nat) : a ∣ b * a := ⟨b, Nat.mul_comm b a⟩
|
||||
protected theorem dvd_mul_right (a b : Nat) : a ∣ a * b := ⟨b, rfl⟩
|
||||
|
||||
protected theorem dvd_trans {a b c : Nat} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c :=
|
||||
match h₁, h₂ with
|
||||
| ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ =>
|
||||
⟨d * e, show c = a * (d * e) by simp[h₃,h₄, Nat.mul_assoc]⟩
|
||||
|
||||
protected theorem eq_zero_of_zero_dvd {a : Nat} (h : 0 ∣ a) : a = 0 :=
|
||||
let ⟨c, H'⟩ := h; H'.trans c.zero_mul
|
||||
|
||||
@[simp] protected theorem zero_dvd {n : Nat} : 0 ∣ n ↔ n = 0 :=
|
||||
⟨Nat.eq_zero_of_zero_dvd, fun h => h.symm ▸ Nat.dvd_zero 0⟩
|
||||
|
||||
protected theorem dvd_add {a b c : Nat} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c :=
|
||||
let ⟨d, hd⟩ := h₁; let ⟨e, he⟩ := h₂; ⟨d + e, by simp [Nat.left_distrib, hd, he]⟩
|
||||
|
||||
protected theorem dvd_add_iff_right {k m n : Nat} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n :=
|
||||
⟨Nat.dvd_add h,
|
||||
match m, h with
|
||||
| _, ⟨d, rfl⟩ => fun ⟨e, he⟩ =>
|
||||
⟨e - d, by rw [Nat.mul_sub_left_distrib, ← he, Nat.add_sub_cancel_left]⟩⟩
|
||||
|
||||
protected theorem dvd_add_iff_left {k m n : Nat} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n := by
|
||||
rw [Nat.add_comm]; exact Nat.dvd_add_iff_right h
|
||||
|
||||
theorem dvd_mod_iff {k m n : Nat} (h: k ∣ n) : k ∣ m % n ↔ k ∣ m :=
|
||||
have := Nat.dvd_add_iff_left <| Nat.dvd_trans h <| Nat.dvd_mul_right n (m / n)
|
||||
by rwa [mod_add_div] at this
|
||||
|
||||
theorem le_of_dvd {m n : Nat} (h : 0 < n) : m ∣ n → m ≤ n
|
||||
| ⟨k, e⟩ => by
|
||||
revert h
|
||||
rw [e]
|
||||
match k with
|
||||
| 0 => intro hn; simp at hn
|
||||
| pk+1 =>
|
||||
intro
|
||||
have := Nat.mul_le_mul_left m (succ_pos pk)
|
||||
rwa [Nat.mul_one] at this
|
||||
|
||||
protected theorem dvd_antisymm : ∀ {m n : Nat}, m ∣ n → n ∣ m → m = n
|
||||
| _, 0, _, h₂ => Nat.eq_zero_of_zero_dvd h₂
|
||||
| 0, _, h₁, _ => (Nat.eq_zero_of_zero_dvd h₁).symm
|
||||
| _+1, _+1, h₁, h₂ => Nat.le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂)
|
||||
|
||||
theorem pos_of_dvd_of_pos {m n : Nat} (H1 : m ∣ n) (H2 : 0 < n) : 0 < m :=
|
||||
Nat.pos_of_ne_zero fun m0 => Nat.ne_of_gt H2 <| Nat.eq_zero_of_zero_dvd (m0 ▸ H1)
|
||||
|
||||
@[simp] protected theorem one_dvd (n : Nat) : 1 ∣ n := ⟨n, n.one_mul.symm⟩
|
||||
|
||||
theorem eq_one_of_dvd_one {n : Nat} (H : n ∣ 1) : n = 1 := Nat.dvd_antisymm H n.one_dvd
|
||||
|
||||
theorem mod_eq_zero_of_dvd {m n : Nat} (H : m ∣ n) : n % m = 0 := by
|
||||
let ⟨z, H⟩ := H; rw [H, mul_mod_right]
|
||||
|
||||
theorem dvd_of_mod_eq_zero {m n : Nat} (H : n % m = 0) : m ∣ n := by
|
||||
exists n / m
|
||||
have := (mod_add_div n m).symm
|
||||
rwa [H, Nat.zero_add] at this
|
||||
|
||||
theorem dvd_iff_mod_eq_zero (m n : Nat) : m ∣ n ↔ n % m = 0 :=
|
||||
⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩
|
||||
|
||||
instance decidable_dvd : @DecidableRel Nat (·∣·) :=
|
||||
fun _ _ => decidable_of_decidable_of_iff (dvd_iff_mod_eq_zero _ _).symm
|
||||
|
||||
theorem emod_pos_of_not_dvd {a b : Nat} (h : ¬ a ∣ b) : 0 < b % a := by
|
||||
rw [dvd_iff_mod_eq_zero] at h
|
||||
exact Nat.pos_of_ne_zero h
|
||||
|
||||
|
||||
protected theorem mul_div_cancel' {n m : Nat} (H : n ∣ m) : n * (m / n) = m := by
|
||||
have := mod_add_div m n
|
||||
rwa [mod_eq_zero_of_dvd H, Nat.zero_add] at this
|
||||
|
||||
protected theorem div_mul_cancel {n m : Nat} (H : n ∣ m) : m / n * n = m := by
|
||||
rw [Nat.mul_comm, Nat.mul_div_cancel' H]
|
||||
|
||||
end Nat
|
||||
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Nat.Dvd
|
||||
import Init.Data.Nat.Div
|
||||
|
||||
namespace Nat
|
||||
|
||||
@@ -38,35 +38,4 @@ theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) :=
|
||||
@[simp] theorem gcd_self (n : Nat) : gcd n n = n := by
|
||||
cases n <;> simp [gcd_succ]
|
||||
|
||||
theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m :=
|
||||
match m with
|
||||
| 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right]
|
||||
| _ + 1 => by simp [gcd_succ]
|
||||
|
||||
@[elab_as_elim] theorem gcd.induction {P : Nat → Nat → Prop} (m n : Nat)
|
||||
(H0 : ∀n, P 0 n) (H1 : ∀ m n, 0 < m → P (n % m) m → P m n) : P m n :=
|
||||
Nat.strongInductionOn (motive := fun m => ∀ n, P m n) m
|
||||
(fun
|
||||
| 0, _ => H0
|
||||
| _+1, IH => fun _ => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) )
|
||||
n
|
||||
|
||||
theorem gcd_dvd (m n : Nat) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := by
|
||||
induction m, n using gcd.induction with
|
||||
| H0 n => rw [gcd_zero_left]; exact ⟨Nat.dvd_zero n, Nat.dvd_refl n⟩
|
||||
| H1 m n _ IH => rw [← gcd_rec] at IH; exact ⟨IH.2, (dvd_mod_iff IH.2).1 IH.1⟩
|
||||
|
||||
theorem gcd_dvd_left (m n : Nat) : gcd m n ∣ m := (gcd_dvd m n).left
|
||||
|
||||
theorem gcd_dvd_right (m n : Nat) : gcd m n ∣ n := (gcd_dvd m n).right
|
||||
|
||||
theorem gcd_le_left (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h <| gcd_dvd_left m n
|
||||
|
||||
theorem gcd_le_right (n) (h : 0 < n) : gcd m n ≤ n := le_of_dvd h <| gcd_dvd_right m n
|
||||
|
||||
theorem dvd_gcd : k ∣ m → k ∣ n → k ∣ gcd m n := by
|
||||
induction m, n using gcd.induction with intro km kn
|
||||
| H0 n => rw [gcd_zero_left]; exact kn
|
||||
| H1 n m _ IH => rw [gcd_rec]; exact IH ((dvd_mod_iff km).2 kn) km
|
||||
|
||||
end Nat
|
||||
|
||||
@@ -5,7 +5,8 @@ Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Coe
|
||||
import Init.ByCases
|
||||
import Init.Classical
|
||||
import Init.SimpLemmas
|
||||
import Init.Data.Nat.Basic
|
||||
import Init.Data.List.Basic
|
||||
import Init.Data.Prod
|
||||
@@ -538,13 +539,13 @@ theorem Expr.eq_of_toNormPoly (ctx : Context) (a b : Expr) (h : a.toNormPoly = b
|
||||
theorem Expr.of_cancel_eq (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.toNormPoly b.toNormPoly = (c.toPoly, d.toPoly)) : (a.denote ctx = b.denote ctx) = (c.denote ctx = d.denote ctx) := by
|
||||
have := Poly.denote_eq_cancel_eq ctx a.toNormPoly b.toNormPoly
|
||||
rw [h] at this
|
||||
simp [toNormPoly, Poly.norm, Poly.denote_eq, -eq_iff_iff] at this
|
||||
simp [toNormPoly, Poly.norm, Poly.denote_eq] at this
|
||||
exact this.symm
|
||||
|
||||
theorem Expr.of_cancel_le (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.toNormPoly b.toNormPoly = (c.toPoly, d.toPoly)) : (a.denote ctx ≤ b.denote ctx) = (c.denote ctx ≤ d.denote ctx) := by
|
||||
have := Poly.denote_le_cancel_eq ctx a.toNormPoly b.toNormPoly
|
||||
rw [h] at this
|
||||
simp [toNormPoly, Poly.norm,Poly.denote_le, -eq_iff_iff] at this
|
||||
simp [toNormPoly, Poly.norm,Poly.denote_le] at this
|
||||
exact this.symm
|
||||
|
||||
theorem Expr.of_cancel_lt (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.inc.toNormPoly b.toNormPoly = (c.inc.toPoly, d.toPoly)) : (a.denote ctx < b.denote ctx) = (c.denote ctx < d.denote ctx) :=
|
||||
@@ -589,7 +590,7 @@ theorem PolyCnstr.denote_mul (ctx : Context) (k : Nat) (c : PolyCnstr) : (c.mul
|
||||
have : (1 == (0 : Nat)) = false := rfl
|
||||
have : (1 == (1 : Nat)) = true := rfl
|
||||
by_cases he : eq = true <;> simp [he, PolyCnstr.mul, PolyCnstr.denote, Poly.denote_le, Poly.denote_eq]
|
||||
<;> by_cases hk : k == 0 <;> (try simp [eq_of_beq hk]) <;> simp [*] <;> apply Iff.intro <;> intro h
|
||||
<;> by_cases hk : k == 0 <;> (try simp [eq_of_beq hk]) <;> simp [*] <;> apply propext <;> apply Iff.intro <;> intro h
|
||||
· exact Nat.eq_of_mul_eq_mul_left (Nat.zero_lt_succ _) h
|
||||
· rw [h]
|
||||
· exact Nat.le_of_mul_le_mul_left h (Nat.zero_lt_succ _)
|
||||
@@ -636,18 +637,20 @@ theorem Poly.of_isNonZero (ctx : Context) {p : Poly} (h : isNonZero p = true) :
|
||||
theorem PolyCnstr.eq_false_of_isUnsat (ctx : Context) {c : PolyCnstr} : c.isUnsat → c.denote ctx = False := by
|
||||
cases c; rename_i eq lhs rhs
|
||||
simp [isUnsat]
|
||||
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le, -and_imp]
|
||||
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le]
|
||||
· intro
|
||||
| Or.inl ⟨h₁, h₂⟩ => simp [Poly.of_isZero, h₁]; have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₂); simp [this.symm]
|
||||
| Or.inr ⟨h₁, h₂⟩ => simp [Poly.of_isZero, h₂]; have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₁); simp [this]
|
||||
· intro ⟨h₁, h₂⟩
|
||||
simp [Poly.of_isZero, h₂]
|
||||
exact Poly.of_isNonZero ctx h₁
|
||||
have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₁)
|
||||
simp [this]
|
||||
done
|
||||
|
||||
theorem PolyCnstr.eq_true_of_isValid (ctx : Context) {c : PolyCnstr} : c.isValid → c.denote ctx = True := by
|
||||
cases c; rename_i eq lhs rhs
|
||||
simp [isValid]
|
||||
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le, -and_imp]
|
||||
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le]
|
||||
· intro ⟨h₁, h₂⟩
|
||||
simp [Poly.of_isZero, h₁, h₂]
|
||||
· intro h
|
||||
@@ -655,12 +658,12 @@ theorem PolyCnstr.eq_true_of_isValid (ctx : Context) {c : PolyCnstr} : c.isValid
|
||||
|
||||
theorem ExprCnstr.eq_false_of_isUnsat (ctx : Context) (c : ExprCnstr) (h : c.toNormPoly.isUnsat) : c.denote ctx = False := by
|
||||
have := PolyCnstr.eq_false_of_isUnsat ctx h
|
||||
simp [-eq_iff_iff] at this
|
||||
simp at this
|
||||
assumption
|
||||
|
||||
theorem ExprCnstr.eq_true_of_isValid (ctx : Context) (c : ExprCnstr) (h : c.toNormPoly.isValid) : c.denote ctx = True := by
|
||||
have := PolyCnstr.eq_true_of_isValid ctx h
|
||||
simp [-eq_iff_iff] at this
|
||||
simp at this
|
||||
assumption
|
||||
|
||||
theorem Certificate.of_combineHyps (ctx : Context) (c : PolyCnstr) (cs : Certificate) (h : (combineHyps c cs).denote ctx → False) : c.denote ctx → cs.denote ctx := by
|
||||
@@ -709,7 +712,7 @@ theorem Poly.denote_toExpr (ctx : Context) (p : Poly) : p.toExpr.denote ctx = p.
|
||||
|
||||
theorem ExprCnstr.eq_of_toNormPoly_eq (ctx : Context) (c d : ExprCnstr) (h : c.toNormPoly == d.toPoly) : c.denote ctx = d.denote ctx := by
|
||||
have h := congrArg (PolyCnstr.denote ctx) (eq_of_beq h)
|
||||
simp [-eq_iff_iff] at h
|
||||
simp at h
|
||||
assumption
|
||||
|
||||
theorem Expr.eq_of_toNormPoly_eq (ctx : Context) (e e' : Expr) (h : e.toNormPoly == e'.toPoly) : e.denote ctx = e'.denote ctx := by
|
||||
|
||||
@@ -1,51 +0,0 @@
|
||||
prelude
|
||||
import Init.ByCases
|
||||
|
||||
namespace Nat
|
||||
|
||||
/-! # min lemmas -/
|
||||
|
||||
protected theorem min_eq_min (a : Nat) : Nat.min a b = min a b := rfl
|
||||
|
||||
protected theorem min_comm (a b : Nat) : min a b = min b a := by
|
||||
match Nat.lt_trichotomy a b with
|
||||
| .inl h => simp [Nat.min_def, h, Nat.le_of_lt, Nat.not_le_of_lt]
|
||||
| .inr (.inl h) => simp [Nat.min_def, h]
|
||||
| .inr (.inr h) => simp [Nat.min_def, h, Nat.le_of_lt, Nat.not_le_of_lt]
|
||||
|
||||
protected theorem min_le_right (a b : Nat) : min a b ≤ b := by
|
||||
by_cases (a <= b) <;> simp [Nat.min_def, *]
|
||||
protected theorem min_le_left (a b : Nat) : min a b ≤ a :=
|
||||
Nat.min_comm .. ▸ Nat.min_le_right ..
|
||||
|
||||
protected theorem min_eq_left {a b : Nat} (h : a ≤ b) : min a b = a := if_pos h
|
||||
protected theorem min_eq_right {a b : Nat} (h : b ≤ a) : min a b = b :=
|
||||
Nat.min_comm .. ▸ Nat.min_eq_left h
|
||||
|
||||
protected theorem le_min_of_le_of_le {a b c : Nat} : a ≤ b → a ≤ c → a ≤ min b c := by
|
||||
intros; cases Nat.le_total b c with
|
||||
| inl h => rw [Nat.min_eq_left h]; assumption
|
||||
| inr h => rw [Nat.min_eq_right h]; assumption
|
||||
|
||||
protected theorem le_min {a b c : Nat} : a ≤ min b c ↔ a ≤ b ∧ a ≤ c :=
|
||||
⟨fun h => ⟨Nat.le_trans h (Nat.min_le_left ..), Nat.le_trans h (Nat.min_le_right ..)⟩,
|
||||
fun ⟨h₁, h₂⟩ => Nat.le_min_of_le_of_le h₁ h₂⟩
|
||||
|
||||
protected theorem lt_min {a b c : Nat} : a < min b c ↔ a < b ∧ a < c := Nat.le_min
|
||||
|
||||
/-! # max lemmas -/
|
||||
|
||||
protected theorem max_eq_max (a : Nat) : Nat.max a b = max a b := rfl
|
||||
|
||||
protected theorem max_comm (a b : Nat) : max a b = max b a := by
|
||||
simp only [Nat.max_def]
|
||||
by_cases h₁ : a ≤ b <;> by_cases h₂ : b ≤ a <;> simp [h₁, h₂]
|
||||
· exact Nat.le_antisymm h₂ h₁
|
||||
· cases not_or_intro h₁ h₂ <| Nat.le_total ..
|
||||
|
||||
protected theorem le_max_left ( a b : Nat) : a ≤ max a b := by
|
||||
by_cases (a <= b) <;> simp [Nat.max_def, *]
|
||||
protected theorem le_max_right (a b : Nat) : b ≤ max a b :=
|
||||
Nat.max_comm .. ▸ Nat.le_max_left ..
|
||||
|
||||
end Nat
|
||||
@@ -8,8 +8,6 @@ import Init.Data.Nat.Linear
|
||||
|
||||
namespace Nat
|
||||
|
||||
protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide)
|
||||
|
||||
theorem nextPowerOfTwo_dec {n power : Nat} (h₁ : power > 0) (h₂ : power < n) : n - power * 2 < n - power := by
|
||||
have : power * 2 = power + power := by simp_arith
|
||||
rw [this, Nat.sub_add_eq]
|
||||
|
||||
@@ -7,4 +7,3 @@ prelude
|
||||
import Init.Data.Option.Basic
|
||||
import Init.Data.Option.BasicAux
|
||||
import Init.Data.Option.Instances
|
||||
import Init.Data.Option.Lemmas
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
/-
|
||||
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura, Mario Carneiro
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
prelude
|
||||
import Init.Core
|
||||
@@ -10,9 +10,6 @@ import Init.Coe
|
||||
|
||||
namespace Option
|
||||
|
||||
deriving instance DecidableEq for Option
|
||||
deriving instance BEq for Option
|
||||
|
||||
def toMonad [Monad m] [Alternative m] : Option α → m α
|
||||
| none => failure
|
||||
| some a => pure a
|
||||
@@ -84,132 +81,11 @@ def merge (fn : α → α → α) : Option α → Option α → Option α
|
||||
| none , some y => some y
|
||||
| some x, some y => some <| fn x y
|
||||
|
||||
@[simp] theorem getD_none : getD none a = a := rfl
|
||||
@[simp] theorem getD_some : getD (some a) b = a := rfl
|
||||
|
||||
@[simp] theorem map_none' (f : α → β) : none.map f = none := rfl
|
||||
@[simp] theorem map_some' (a) (f : α → β) : (some a).map f = some (f a) := rfl
|
||||
|
||||
@[simp] theorem none_bind (f : α → Option β) : none.bind f = none := rfl
|
||||
@[simp] theorem some_bind (a) (f : α → Option β) : (some a).bind f = f a := rfl
|
||||
|
||||
|
||||
/-- An elimination principle for `Option`. It is a nondependent version of `Option.recOn`. -/
|
||||
@[simp, inline] protected def elim : Option α → β → (α → β) → β
|
||||
| some x, _, f => f x
|
||||
| none, y, _ => y
|
||||
|
||||
/-- Extracts the value `a` from an option that is known to be `some a` for some `a`. -/
|
||||
@[inline] def get {α : Type u} : (o : Option α) → isSome o → α
|
||||
| some x, _ => x
|
||||
|
||||
/-- `guard p a` returns `some a` if `p a` holds, otherwise `none`. -/
|
||||
@[inline] def guard (p : α → Prop) [DecidablePred p] (a : α) : Option α :=
|
||||
if p a then some a else none
|
||||
|
||||
/--
|
||||
Cast of `Option` to `List`. Returns `[a]` if the input is `some a`, and `[]` if it is `none`.
|
||||
-/
|
||||
@[inline] def toList : Option α → List α
|
||||
| none => .nil
|
||||
| some a => .cons a .nil
|
||||
|
||||
/--
|
||||
Cast of `Option` to `Array`. Returns `#[a]` if the input is `some a`, and `#[]` if it is `none`.
|
||||
-/
|
||||
@[inline] def toArray : Option α → Array α
|
||||
| none => List.toArray .nil
|
||||
| some a => List.toArray (.cons a .nil)
|
||||
|
||||
/--
|
||||
Two arguments failsafe function. Returns `f a b` if the inputs are `some a` and `some b`, and
|
||||
"does nothing" otherwise.
|
||||
-/
|
||||
def liftOrGet (f : α → α → α) : Option α → Option α → Option α
|
||||
| none, none => none
|
||||
| some a, none => some a
|
||||
| none, some b => some b
|
||||
| some a, some b => some (f a b)
|
||||
|
||||
/-- Lifts a relation `α → β → Prop` to a relation `Option α → Option β → Prop` by just adding
|
||||
`none ~ none`. -/
|
||||
inductive Rel (r : α → β → Prop) : Option α → Option β → Prop
|
||||
/-- If `a ~ b`, then `some a ~ some b` -/
|
||||
| some {a b} : r a b → Rel r (some a) (some b)
|
||||
/-- `none ~ none` -/
|
||||
| none : Rel r none none
|
||||
|
||||
/-- Flatten an `Option` of `Option`, a specialization of `joinM`. -/
|
||||
@[simp, inline] def join (x : Option (Option α)) : Option α := x.bind id
|
||||
|
||||
/-- Like `Option.mapM` but for applicative functors. -/
|
||||
@[inline] protected def mapA [Applicative m] {α β} (f : α → m β) : Option α → m (Option β)
|
||||
| none => pure none
|
||||
| some x => some <$> f x
|
||||
|
||||
/--
|
||||
If you maybe have a monadic computation in a `[Monad m]` which produces a term of type `α`, then
|
||||
there is a naturally associated way to always perform a computation in `m` which maybe produces a
|
||||
result.
|
||||
-/
|
||||
@[inline] def sequence [Monad m] {α : Type u} : Option (m α) → m (Option α)
|
||||
| none => pure none
|
||||
| some fn => some <$> fn
|
||||
|
||||
/-- A monadic analogue of `Option.elim`. -/
|
||||
@[inline] def elimM [Monad m] (x : m (Option α)) (y : m β) (z : α → m β) : m β :=
|
||||
do (← x).elim y z
|
||||
|
||||
/-- A monadic analogue of `Option.getD`. -/
|
||||
@[inline] def getDM [Monad m] (x : Option α) (y : m α) : m α :=
|
||||
match x with
|
||||
| some a => pure a
|
||||
| none => y
|
||||
|
||||
instance (α) [BEq α] [LawfulBEq α] : LawfulBEq (Option α) where
|
||||
rfl {x} :=
|
||||
match x with
|
||||
| some x => LawfulBEq.rfl (α := α)
|
||||
| none => rfl
|
||||
eq_of_beq {x y h} := by
|
||||
match x, y with
|
||||
| some x, some y => rw [LawfulBEq.eq_of_beq (α := α) h]
|
||||
| none, none => rfl
|
||||
|
||||
@[simp] theorem all_none : Option.all p none = true := rfl
|
||||
@[simp] theorem all_some : Option.all p (some x) = p x := rfl
|
||||
|
||||
/-- The minimum of two optional values. -/
|
||||
protected def min [Min α] : Option α → Option α → Option α
|
||||
| some x, some y => some (Min.min x y)
|
||||
| some x, none => some x
|
||||
| none, some y => some y
|
||||
| none, none => none
|
||||
|
||||
instance [Min α] : Min (Option α) where min := Option.min
|
||||
|
||||
@[simp] theorem min_some_some [Min α] {a b : α} : min (some a) (some b) = some (min a b) := rfl
|
||||
@[simp] theorem min_some_none [Min α] {a : α} : min (some a) none = some a := rfl
|
||||
@[simp] theorem min_none_some [Min α] {b : α} : min none (some b) = some b := rfl
|
||||
@[simp] theorem min_none_none [Min α] : min (none : Option α) none = none := rfl
|
||||
|
||||
/-- The maximum of two optional values. -/
|
||||
protected def max [Max α] : Option α → Option α → Option α
|
||||
| some x, some y => some (Max.max x y)
|
||||
| some x, none => some x
|
||||
| none, some y => some y
|
||||
| none, none => none
|
||||
|
||||
instance [Max α] : Max (Option α) where max := Option.max
|
||||
|
||||
@[simp] theorem max_some_some [Max α] {a b : α} : max (some a) (some b) = some (max a b) := rfl
|
||||
@[simp] theorem max_some_none [Max α] {a : α} : max (some a) none = some a := rfl
|
||||
@[simp] theorem max_none_some [Max α] {b : α} : max none (some b) = some b := rfl
|
||||
@[simp] theorem max_none_none [Max α] : max (none : Option α) none = none := rfl
|
||||
|
||||
|
||||
end Option
|
||||
|
||||
deriving instance DecidableEq for Option
|
||||
deriving instance BEq for Option
|
||||
|
||||
instance [LT α] : LT (Option α) where
|
||||
lt := Option.lt (· < ·)
|
||||
|
||||
|
||||
@@ -8,82 +8,11 @@ import Init.Data.Option.Basic
|
||||
|
||||
universe u v
|
||||
|
||||
namespace Option
|
||||
|
||||
theorem eq_of_eq_some {α : Type u} : ∀ {x y : Option α}, (∀z, x = some z ↔ y = some z) → x = y
|
||||
theorem Option.eq_of_eq_some {α : Type u} : ∀ {x y : Option α}, (∀z, x = some z ↔ y = some z) → x = y
|
||||
| none, none, _ => rfl
|
||||
| none, some z, h => Option.noConfusion ((h z).2 rfl)
|
||||
| some z, none, h => Option.noConfusion ((h z).1 rfl)
|
||||
| some _, some w, h => Option.noConfusion ((h w).2 rfl) (congrArg some)
|
||||
|
||||
theorem eq_none_of_isNone {α : Type u} : ∀ {o : Option α}, o.isNone → o = none
|
||||
theorem Option.eq_none_of_isNone {α : Type u} : ∀ {o : Option α}, o.isNone → o = none
|
||||
| none, _ => rfl
|
||||
|
||||
instance : Membership α (Option α) := ⟨fun a b => b = some a⟩
|
||||
|
||||
@[simp] theorem mem_def {a : α} {b : Option α} : a ∈ b ↔ b = some a := .rfl
|
||||
|
||||
instance [DecidableEq α] (j : α) (o : Option α) : Decidable (j ∈ o) :=
|
||||
inferInstanceAs <| Decidable (o = some j)
|
||||
|
||||
theorem isNone_iff_eq_none {o : Option α} : o.isNone ↔ o = none :=
|
||||
⟨Option.eq_none_of_isNone, fun e => e.symm ▸ rfl⟩
|
||||
|
||||
theorem some_inj {a b : α} : some a = some b ↔ a = b := by simp; rfl
|
||||
|
||||
/--
|
||||
`o = none` is decidable even if the wrapped type does not have decidable equality.
|
||||
This is not an instance because it is not definitionally equal to `instance : DecidableEq Option`.
|
||||
Try to use `o.isNone` or `o.isSome` instead.
|
||||
-/
|
||||
@[inline] def decidable_eq_none {o : Option α} : Decidable (o = none) :=
|
||||
decidable_of_decidable_of_iff isNone_iff_eq_none
|
||||
|
||||
instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (∀ a, a ∈ o → p a)
|
||||
| none => isTrue nofun
|
||||
| some a =>
|
||||
if h : p a then isTrue fun _ e => some_inj.1 e ▸ h
|
||||
else isFalse <| mt (· _ rfl) h
|
||||
|
||||
instance {p : α → Prop} [DecidablePred p] : ∀ o : Option α, Decidable (Exists fun a => a ∈ o ∧ p a)
|
||||
| none => isFalse nofun
|
||||
| some a => if h : p a then isTrue ⟨_, rfl, h⟩ else isFalse fun ⟨_, ⟨rfl, hn⟩⟩ => h hn
|
||||
|
||||
/--
|
||||
Partial bind. If for some `x : Option α`, `f : Π (a : α), a ∈ x → Option β` is a
|
||||
partial function defined on `a : α` giving an `Option β`, where `some a = x`,
|
||||
then `pbind x f h` is essentially the same as `bind x f`
|
||||
but is defined only when all `x = some a`, using the proof to apply `f`.
|
||||
-/
|
||||
@[simp, inline]
|
||||
def pbind : ∀ x : Option α, (∀ a : α, a ∈ x → Option β) → Option β
|
||||
| none, _ => none
|
||||
| some a, f => f a rfl
|
||||
|
||||
/--
|
||||
Partial map. If `f : Π a, p a → β` is a partial function defined on `a : α` satisfying `p`,
|
||||
then `pmap f x h` is essentially the same as `map f x` but is defined only when all members of `x`
|
||||
satisfy `p`, using the proof to apply `f`.
|
||||
-/
|
||||
@[simp, inline] def pmap {p : α → Prop} (f : ∀ a : α, p a → β) :
|
||||
∀ x : Option α, (∀ a, a ∈ x → p a) → Option β
|
||||
| none, _ => none
|
||||
| some a, H => f a (H a rfl)
|
||||
|
||||
/-- Map a monadic function which returns `Unit` over an `Option`. -/
|
||||
@[inline] protected def forM [Pure m] : Option α → (α → m PUnit) → m PUnit
|
||||
| none , _ => pure ()
|
||||
| some a, f => f a
|
||||
|
||||
instance : ForM m (Option α) α :=
|
||||
⟨Option.forM⟩
|
||||
|
||||
instance : ForIn' m (Option α) α inferInstance where
|
||||
forIn' x init f := do
|
||||
match x with
|
||||
| none => return init
|
||||
| some a =>
|
||||
match ← f a rfl init with
|
||||
| .done r | .yield r => return r
|
||||
|
||||
end Option
|
||||
|
||||
@@ -1,238 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2017 Mario Carneiro. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.Data.Option.Instances
|
||||
import Init.Classical
|
||||
import Init.Ext
|
||||
|
||||
namespace Option
|
||||
|
||||
theorem mem_iff {a : α} {b : Option α} : a ∈ b ↔ b = a := .rfl
|
||||
|
||||
theorem some_ne_none (x : α) : some x ≠ none := nofun
|
||||
|
||||
protected theorem «forall» {p : Option α → Prop} : (∀ x, p x) ↔ p none ∧ ∀ x, p (some x) :=
|
||||
⟨fun h => ⟨h _, fun _ => h _⟩, fun h x => Option.casesOn x h.1 h.2⟩
|
||||
|
||||
protected theorem «exists» {p : Option α → Prop} :
|
||||
(∃ x, p x) ↔ p none ∨ ∃ x, p (some x) :=
|
||||
⟨fun | ⟨none, hx⟩ => .inl hx | ⟨some x, hx⟩ => .inr ⟨x, hx⟩,
|
||||
fun | .inl h => ⟨_, h⟩ | .inr ⟨_, hx⟩ => ⟨_, hx⟩⟩
|
||||
|
||||
theorem get_mem : ∀ {o : Option α} (h : isSome o), o.get h ∈ o
|
||||
| some _, _ => rfl
|
||||
|
||||
theorem get_of_mem : ∀ {o : Option α} (h : isSome o), a ∈ o → o.get h = a
|
||||
| _, _, rfl => rfl
|
||||
|
||||
theorem not_mem_none (a : α) : a ∉ (none : Option α) := nofun
|
||||
|
||||
@[simp] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x
|
||||
| some _, _ => rfl
|
||||
|
||||
@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl
|
||||
|
||||
theorem getD_of_ne_none {x : Option α} (hx : x ≠ none) (y : α) : some (x.getD y) = x := by
|
||||
cases x; {contradiction}; rw [getD_some]
|
||||
|
||||
theorem getD_eq_iff {o : Option α} {a b} : o.getD a = b ↔ (o = some b ∨ o = none ∧ a = b) := by
|
||||
cases o <;> simp
|
||||
|
||||
theorem mem_unique {o : Option α} {a b : α} (ha : a ∈ o) (hb : b ∈ o) : a = b :=
|
||||
some.inj <| ha ▸ hb
|
||||
|
||||
@[ext] theorem ext : ∀ {o₁ o₂ : Option α}, (∀ a, a ∈ o₁ ↔ a ∈ o₂) → o₁ = o₂
|
||||
| none, none, _ => rfl
|
||||
| some _, _, H => ((H _).1 rfl).symm
|
||||
| _, some _, H => (H _).2 rfl
|
||||
|
||||
theorem eq_none_iff_forall_not_mem : o = none ↔ ∀ a, a ∉ o :=
|
||||
⟨fun e a h => by rw [e] at h; (cases h), fun h => ext <| by simp; exact h⟩
|
||||
|
||||
@[simp] theorem isSome_none : @isSome α none = false := rfl
|
||||
|
||||
@[simp] theorem isSome_some : isSome (some a) = true := rfl
|
||||
|
||||
theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> simp [isSome]
|
||||
|
||||
@[simp] theorem isNone_none : @isNone α none = true := rfl
|
||||
|
||||
@[simp] theorem isNone_some : isNone (some a) = false := rfl
|
||||
|
||||
@[simp] theorem not_isSome : isSome a = false ↔ a.isNone = true := by
|
||||
cases a <;> simp
|
||||
|
||||
theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by
|
||||
cases o <;> simp; nofun
|
||||
|
||||
theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h)
|
||||
| some _, _ => rfl
|
||||
|
||||
theorem not_isSome_iff_eq_none : ¬o.isSome ↔ o = none := by
|
||||
cases o <;> simp
|
||||
|
||||
theorem ne_none_iff_isSome : o ≠ none ↔ o.isSome := by cases o <;> simp
|
||||
|
||||
theorem ne_none_iff_exists : o ≠ none ↔ ∃ x, some x = o := by cases o <;> simp
|
||||
|
||||
theorem ne_none_iff_exists' : o ≠ none ↔ ∃ x, o = some x :=
|
||||
ne_none_iff_exists.trans <| exists_congr fun _ => eq_comm
|
||||
|
||||
theorem bex_ne_none {p : Option α → Prop} : (∃ x, ∃ (_ : x ≠ none), p x) ↔ ∃ x, p (some x) :=
|
||||
⟨fun ⟨x, hx, hp⟩ => ⟨x.get <| ne_none_iff_isSome.1 hx, by rwa [some_get]⟩,
|
||||
fun ⟨x, hx⟩ => ⟨some x, some_ne_none x, hx⟩⟩
|
||||
|
||||
theorem ball_ne_none {p : Option α → Prop} : (∀ x (_ : x ≠ none), p x) ↔ ∀ x, p (some x) :=
|
||||
⟨fun h x => h (some x) (some_ne_none x),
|
||||
fun h x hx => by
|
||||
have := h <| x.get <| ne_none_iff_isSome.1 hx
|
||||
simp [some_get] at this ⊢
|
||||
exact this⟩
|
||||
|
||||
@[simp] theorem pure_def : pure = @some α := rfl
|
||||
|
||||
@[simp] theorem bind_eq_bind : bind = @Option.bind α β := rfl
|
||||
|
||||
@[simp] theorem bind_some (x : Option α) : x.bind some = x := by cases x <;> rfl
|
||||
|
||||
@[simp] theorem bind_none (x : Option α) : x.bind (fun _ => none (α := β)) = none := by
|
||||
cases x <;> rfl
|
||||
|
||||
@[simp] theorem bind_eq_some : x.bind f = some b ↔ ∃ a, x = some a ∧ f a = some b := by
|
||||
cases x <;> simp
|
||||
|
||||
@[simp] theorem bind_eq_none {o : Option α} {f : α → Option β} :
|
||||
o.bind f = none ↔ ∀ a, o = some a → f a = none := by cases o <;> simp
|
||||
|
||||
theorem bind_eq_none' {o : Option α} {f : α → Option β} :
|
||||
o.bind f = none ↔ ∀ b a, a ∈ o → b ∉ f a := by
|
||||
simp only [eq_none_iff_forall_not_mem, not_exists, not_and, mem_def, bind_eq_some]
|
||||
|
||||
theorem bind_comm {f : α → β → Option γ} (a : Option α) (b : Option β) :
|
||||
(a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by
|
||||
cases a <;> cases b <;> rfl
|
||||
|
||||
theorem bind_assoc (x : Option α) (f : α → Option β) (g : β → Option γ) :
|
||||
(x.bind f).bind g = x.bind fun y => (f y).bind g := by cases x <;> rfl
|
||||
|
||||
theorem join_eq_some : x.join = some a ↔ x = some (some a) := by
|
||||
simp
|
||||
|
||||
theorem join_ne_none : x.join ≠ none ↔ ∃ z, x = some (some z) := by
|
||||
simp only [ne_none_iff_exists', join_eq_some, iff_self]
|
||||
|
||||
theorem join_ne_none' : ¬x.join = none ↔ ∃ z, x = some (some z) :=
|
||||
join_ne_none
|
||||
|
||||
theorem join_eq_none : o.join = none ↔ o = none ∨ o = some none :=
|
||||
match o with | none | some none | some (some _) => by simp
|
||||
|
||||
theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl
|
||||
|
||||
@[simp] theorem map_eq_map : Functor.map f = Option.map f := rfl
|
||||
|
||||
theorem map_none : f <$> none = none := rfl
|
||||
|
||||
theorem map_some : f <$> some a = some (f a) := rfl
|
||||
|
||||
@[simp] theorem map_eq_some' : x.map f = some b ↔ ∃ a, x = some a ∧ f a = b := by cases x <;> simp
|
||||
|
||||
theorem map_eq_some : f <$> x = some b ↔ ∃ a, x = some a ∧ f a = b := map_eq_some'
|
||||
|
||||
@[simp] theorem map_eq_none' : x.map f = none ↔ x = none := by
|
||||
cases x <;> simp only [map_none', map_some', eq_self_iff_true]
|
||||
|
||||
theorem map_eq_none : f <$> x = none ↔ x = none := map_eq_none'
|
||||
|
||||
theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by
|
||||
cases x <;> simp [Option.bind]
|
||||
|
||||
theorem map_congr {x : Option α} (h : ∀ a, a ∈ x → f a = g a) : x.map f = x.map g := by
|
||||
cases x <;> simp only [map_none', map_some', h, mem_def]
|
||||
|
||||
@[simp] theorem map_id' : Option.map (@id α) = id := map_id
|
||||
@[simp] theorem map_id'' {x : Option α} : (x.map fun a => a) = x := congrFun map_id x
|
||||
|
||||
@[simp] theorem map_map (h : β → γ) (g : α → β) (x : Option α) :
|
||||
(x.map g).map h = x.map (h ∘ g) := by
|
||||
cases x <;> simp only [map_none', map_some', ·∘·]
|
||||
|
||||
theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘ g) = (x.map g).map h :=
|
||||
(map_map ..).symm
|
||||
|
||||
@[simp] theorem map_comp_map (f : α → β) (g : β → γ) :
|
||||
Option.map g ∘ Option.map f = Option.map (g ∘ f) := by funext x; simp
|
||||
|
||||
theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' ..
|
||||
|
||||
theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} :
|
||||
x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp
|
||||
|
||||
theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} :
|
||||
(x.map (Option.map f)).join = x.join.map f := by cases x <;> simp
|
||||
|
||||
theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by
|
||||
cases x <;> simp
|
||||
|
||||
theorem mem_of_mem_join {a : α} {x : Option (Option α)} (h : a ∈ x.join) : some a ∈ x :=
|
||||
h.symm ▸ join_eq_some.1 h
|
||||
|
||||
@[simp] theorem some_orElse (a : α) (x : Option α) : (some a <|> x) = some a := rfl
|
||||
|
||||
@[simp] theorem none_orElse (x : Option α) : (none <|> x) = x := rfl
|
||||
|
||||
@[simp] theorem orElse_none (x : Option α) : (x <|> none) = x := by cases x <;> rfl
|
||||
|
||||
theorem map_orElse {x y : Option α} : (x <|> y).map f = (x.map f <|> y.map f) := by
|
||||
cases x <;> simp
|
||||
|
||||
@[simp] theorem guard_eq_some [DecidablePred p] : guard p a = some b ↔ a = b ∧ p a :=
|
||||
if h : p a then by simp [Option.guard, h] else by simp [Option.guard, h]
|
||||
|
||||
theorem liftOrGet_eq_or_eq {f : α → α → α} (h : ∀ a b, f a b = a ∨ f a b = b) :
|
||||
∀ o₁ o₂, liftOrGet f o₁ o₂ = o₁ ∨ liftOrGet f o₁ o₂ = o₂
|
||||
| none, none => .inl rfl
|
||||
| some a, none => .inl rfl
|
||||
| none, some b => .inr rfl
|
||||
| some a, some b => by have := h a b; simp [liftOrGet] at this ⊢; exact this
|
||||
|
||||
@[simp] theorem liftOrGet_none_left {f} {b : Option α} : liftOrGet f none b = b := by
|
||||
cases b <;> rfl
|
||||
|
||||
@[simp] theorem liftOrGet_none_right {f} {a : Option α} : liftOrGet f a none = a := by
|
||||
cases a <;> rfl
|
||||
|
||||
@[simp] theorem liftOrGet_some_some {f} {a b : α} :
|
||||
liftOrGet f (some a) (some b) = f a b := rfl
|
||||
|
||||
theorem elim_none (x : β) (f : α → β) : none.elim x f = x := rfl
|
||||
|
||||
theorem elim_some (x : β) (f : α → β) (a : α) : (some a).elim x f = f a := rfl
|
||||
|
||||
@[simp] theorem getD_map (f : α → β) (x : α) (o : Option α) :
|
||||
(o.map f).getD (f x) = f (getD o x) := by cases o <;> rfl
|
||||
|
||||
section
|
||||
|
||||
attribute [local instance] Classical.propDecidable
|
||||
|
||||
/-- An arbitrary `some a` with `a : α` if `α` is nonempty, and otherwise `none`. -/
|
||||
noncomputable def choice (α : Type _) : Option α :=
|
||||
if h : Nonempty α then some (Classical.choice h) else none
|
||||
|
||||
theorem choice_eq {α : Type _} [Subsingleton α] (a : α) : choice α = some a := by
|
||||
simp [choice]
|
||||
rw [dif_pos (⟨a⟩ : Nonempty α)]
|
||||
simp; apply Subsingleton.elim
|
||||
|
||||
theorem choice_isSome_iff_nonempty {α : Type _} : (choice α).isSome ↔ Nonempty α :=
|
||||
⟨fun h => ⟨(choice α).get h⟩, fun h => by simp only [choice, dif_pos h, isSome_some]⟩
|
||||
|
||||
end
|
||||
|
||||
@[simp] theorem toList_some (a : α) : (a : Option α).toList = [a] := rfl
|
||||
|
||||
@[simp] theorem toList_none (α : Type _) : (none : Option α).toList = [] := rfl
|
||||
@@ -12,105 +12,16 @@ inductive Ordering where
|
||||
| lt | eq | gt
|
||||
deriving Inhabited, BEq
|
||||
|
||||
namespace Ordering
|
||||
|
||||
deriving instance DecidableEq for Ordering
|
||||
|
||||
/-- Swaps less and greater ordering results -/
|
||||
def swap : Ordering → Ordering
|
||||
| .lt => .gt
|
||||
| .eq => .eq
|
||||
| .gt => .lt
|
||||
|
||||
/--
|
||||
If `o₁` and `o₂` are `Ordering`, then `o₁.then o₂` returns `o₁` unless it is `.eq`,
|
||||
in which case it returns `o₂`. Additionally, it has "short-circuiting" semantics similar to
|
||||
boolean `x && y`: if `o₁` is not `.eq` then the expression for `o₂` is not evaluated.
|
||||
This is a useful primitive for constructing lexicographic comparator functions:
|
||||
```
|
||||
structure Person where
|
||||
name : String
|
||||
age : Nat
|
||||
|
||||
instance : Ord Person where
|
||||
compare a b := (compare a.name b.name).then (compare b.age a.age)
|
||||
```
|
||||
This example will sort people first by name (in ascending order) and will sort people with
|
||||
the same name by age (in descending order). (If all fields are sorted ascending and in the same
|
||||
order as they are listed in the structure, you can also use `deriving Ord` on the structure
|
||||
definition for the same effect.)
|
||||
-/
|
||||
@[macro_inline] def «then» : Ordering → Ordering → Ordering
|
||||
| .eq, f => f
|
||||
| o, _ => o
|
||||
|
||||
/--
|
||||
Check whether the ordering is 'equal'.
|
||||
-/
|
||||
def isEq : Ordering → Bool
|
||||
| eq => true
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Check whether the ordering is 'not equal'.
|
||||
-/
|
||||
def isNe : Ordering → Bool
|
||||
| eq => false
|
||||
| _ => true
|
||||
|
||||
/--
|
||||
Check whether the ordering is 'less than or equal to'.
|
||||
-/
|
||||
def isLE : Ordering → Bool
|
||||
| gt => false
|
||||
| _ => true
|
||||
|
||||
/--
|
||||
Check whether the ordering is 'less than'.
|
||||
-/
|
||||
def isLT : Ordering → Bool
|
||||
| lt => true
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Check whether the ordering is 'greater than'.
|
||||
-/
|
||||
def isGT : Ordering → Bool
|
||||
| gt => true
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Check whether the ordering is 'greater than or equal'.
|
||||
-/
|
||||
def isGE : Ordering → Bool
|
||||
| lt => false
|
||||
| _ => true
|
||||
|
||||
end Ordering
|
||||
|
||||
@[inline] def compareOfLessAndEq {α} (x y : α) [LT α] [Decidable (x < y)] [DecidableEq α] : Ordering :=
|
||||
if x < y then Ordering.lt
|
||||
else if x = y then Ordering.eq
|
||||
else Ordering.gt
|
||||
|
||||
/--
|
||||
Compare `a` and `b` lexicographically by `cmp₁` and `cmp₂`. `a` and `b` are
|
||||
first compared by `cmp₁`. If this returns 'equal', `a` and `b` are compared
|
||||
by `cmp₂` to break the tie.
|
||||
-/
|
||||
@[inline] def compareLex (cmp₁ cmp₂ : α → β → Ordering) (a : α) (b : β) : Ordering :=
|
||||
(cmp₁ a b).then (cmp₂ a b)
|
||||
|
||||
class Ord (α : Type u) where
|
||||
compare : α → α → Ordering
|
||||
|
||||
export Ord (compare)
|
||||
|
||||
/--
|
||||
Compare `x` and `y` by comparing `f x` and `f y`.
|
||||
-/
|
||||
@[inline] def compareOn [ord : Ord β] (f : α → β) (x y : α) : Ordering :=
|
||||
compare (f x) (f y)
|
||||
@[inline] def compareOfLessAndEq {α} (x y : α) [LT α] [Decidable (x < y)] [DecidableEq α] : Ordering :=
|
||||
if x < y then Ordering.lt
|
||||
else if x = y then Ordering.eq
|
||||
else Ordering.gt
|
||||
|
||||
instance : Ord Nat where
|
||||
compare x y := compareOfLessAndEq x y
|
||||
@@ -160,55 +71,13 @@ def ltOfOrd [Ord α] : LT α where
|
||||
instance [Ord α] : DecidableRel (@LT.lt α ltOfOrd) :=
|
||||
inferInstanceAs (DecidableRel (fun a b => compare a b == Ordering.lt))
|
||||
|
||||
def Ordering.isLE : Ordering → Bool
|
||||
| Ordering.lt => true
|
||||
| Ordering.eq => true
|
||||
| Ordering.gt => false
|
||||
|
||||
def leOfOrd [Ord α] : LE α where
|
||||
le a b := (compare a b).isLE
|
||||
|
||||
instance [Ord α] : DecidableRel (@LE.le α leOfOrd) :=
|
||||
inferInstanceAs (DecidableRel (fun a b => (compare a b).isLE))
|
||||
|
||||
namespace Ord
|
||||
|
||||
/--
|
||||
Derive a `BEq` instance from an `Ord` instance.
|
||||
-/
|
||||
protected def toBEq (ord : Ord α) : BEq α where
|
||||
beq x y := ord.compare x y == .eq
|
||||
|
||||
/--
|
||||
Derive an `LT` instance from an `Ord` instance.
|
||||
-/
|
||||
protected def toLT (_ : Ord α) : LT α :=
|
||||
ltOfOrd
|
||||
|
||||
/--
|
||||
Derive an `LE` instance from an `Ord` instance.
|
||||
-/
|
||||
protected def toLE (_ : Ord α) : LE α :=
|
||||
leOfOrd
|
||||
|
||||
/--
|
||||
Invert the order of an `Ord` instance.
|
||||
-/
|
||||
protected def opposite (ord : Ord α) : Ord α where
|
||||
compare x y := ord.compare y x
|
||||
|
||||
/--
|
||||
`ord.on f` compares `x` and `y` by comparing `f x` and `f y` according to `ord`.
|
||||
-/
|
||||
protected def on (ord : Ord β) (f : α → β) : Ord α where
|
||||
compare := compareOn f
|
||||
|
||||
/--
|
||||
Derive the lexicographic order on products `α × β` from orders for `α` and `β`.
|
||||
-/
|
||||
protected def lex (_ : Ord α) (_ : Ord β) : Ord (α × β) :=
|
||||
lexOrd
|
||||
|
||||
/--
|
||||
Create an order which compares elements first by `ord₁` and then, if this
|
||||
returns 'equal', by `ord₂`.
|
||||
-/
|
||||
protected def lex' (ord₁ ord₂ : Ord α) : Ord α where
|
||||
compare := compareLex ord₁.compare ord₂.compare
|
||||
|
||||
end Ord
|
||||
|
||||
@@ -42,15 +42,17 @@ instance : Repr StdGen where
|
||||
|
||||
def stdNext : StdGen → Nat × StdGen
|
||||
| ⟨s1, s2⟩ =>
|
||||
let k : Int := Int.ofNat (s1 / 53668)
|
||||
let s1' : Int := 40014 * (Int.ofNat s1 - k * 53668) - k * 12211
|
||||
let s1'' : Nat := if s1' < 0 then (s1' + 2147483563).toNat else s1'.toNat
|
||||
let k' : Int := Int.ofNat (s2 / 52774)
|
||||
let s2' : Int := 40692 * (Int.ofNat s2 - k' * 52774) - k' * 3791
|
||||
let s2'' : Nat := if s2' < 0 then (s2' + 2147483399).toNat else s2'.toNat
|
||||
let z : Int := Int.ofNat s1'' - Int.ofNat s2''
|
||||
let z' : Nat := if z < 1 then (z + 2147483562).toNat else z.toNat % 2147483562
|
||||
(z', ⟨s1'', s2''⟩)
|
||||
let s1 : Int := s1
|
||||
let s2 : Int := s2
|
||||
let k : Int := s1 / 53668
|
||||
let s1' : Int := 40014 * ((s1 : Int) - k * 53668) - k * 12211
|
||||
let s1'' : Int := if s1' < 0 then s1' + 2147483563 else s1'
|
||||
let k' : Int := s2 / 52774
|
||||
let s2' : Int := 40692 * ((s2 : Int) - k' * 52774) - k' * 3791
|
||||
let s2'' : Int := if s2' < 0 then s2' + 2147483399 else s2'
|
||||
let z : Int := s1'' - s2''
|
||||
let z' : Int := if z < 1 then z + 2147483562 else z % 2147483562
|
||||
(z'.toNat, ⟨s1''.toNat, s2''.toNat⟩)
|
||||
|
||||
def stdSplit : StdGen → StdGen × StdGen
|
||||
| g@⟨s1, s2⟩ =>
|
||||
|
||||
@@ -1,113 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Mario Carneiro
|
||||
-/
|
||||
prelude
|
||||
import Init.TacticsExtra
|
||||
import Init.RCases
|
||||
|
||||
namespace Lean
|
||||
namespace Parser.Attr
|
||||
/-- Registers an extensionality theorem.
|
||||
|
||||
* When `@[ext]` is applied to a structure, it generates `.ext` and `.ext_iff` theorems and registers
|
||||
them for the `ext` tactic.
|
||||
|
||||
* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic.
|
||||
|
||||
* An optional natural number argument, e.g. `@[ext 9000]`, specifies a priority for the lemma. Higher-priority lemmas are chosen first, and the default is `1000`.
|
||||
|
||||
* The flag `@[ext (flat := false)]` causes generated structure extensionality theorems to show inherited fields based on their representation,
|
||||
rather than flattening the parents' fields into the lemma's equality hypotheses.
|
||||
structures in the generated extensionality theorems. -/
|
||||
syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr
|
||||
end Parser.Attr
|
||||
|
||||
-- TODO: rename this namespace?
|
||||
-- Remark: `ext` has scoped syntax, Mathlib may depend on the actual namespace name.
|
||||
namespace Elab.Tactic.Ext
|
||||
/--
|
||||
Creates the type of the extensionality theorem for the given structure,
|
||||
elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example.
|
||||
-/
|
||||
scoped syntax (name := extType) "ext_type% " term:max ppSpace ident : term
|
||||
|
||||
/--
|
||||
Creates the type of the iff-variant of the extensionality theorem for the given structure,
|
||||
elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example.
|
||||
-/
|
||||
scoped syntax (name := extIffType) "ext_iff_type% " term:max ppSpace ident : term
|
||||
|
||||
/--
|
||||
`declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`.
|
||||
|
||||
These theorems state that two expressions with the structure type are equal if their fields are equal.
|
||||
-/
|
||||
syntax (name := declareExtTheoremFor) "declare_ext_theorems_for " ("(" &"flat" " := " term ") ")? ident (ppSpace prio)? : command
|
||||
|
||||
macro_rules | `(declare_ext_theorems_for $[(flat := $f)]? $struct:ident $(prio)?) => do
|
||||
let flat := f.getD (mkIdent `true)
|
||||
let names ← Macro.resolveGlobalName struct.getId.eraseMacroScopes
|
||||
let name ← match names.filter (·.2.isEmpty) with
|
||||
| [] => Macro.throwError s!"unknown constant {struct.getId}"
|
||||
| [(name, _)] => pure name
|
||||
| _ => Macro.throwError s!"ambiguous name {struct.getId}"
|
||||
let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext"
|
||||
let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff"
|
||||
`(@[ext $(prio)?] protected theorem $extName:ident : ext_type% $flat $struct:ident :=
|
||||
fun {..} {..} => by intros; subst_eqs; rfl
|
||||
protected theorem $extIffName:ident : ext_iff_type% $flat $struct:ident :=
|
||||
fun {..} {..} =>
|
||||
⟨fun h => by cases h; and_intros <;> rfl,
|
||||
fun _ => by (repeat cases ‹_ ∧ _›); subst_eqs; rfl⟩)
|
||||
|
||||
/--
|
||||
Applies extensionality lemmas that are registered with the `@[ext]` attribute.
|
||||
* `ext pat*` applies extensionality theorems as much as possible,
|
||||
using the patterns `pat*` to introduce the variables in extensionality theorems using `rintro`.
|
||||
For example, the patterns are used to name the variables introduced by lemmas such as `funext`.
|
||||
* Without patterns,`ext` applies extensionality lemmas as much
|
||||
as possible but introduces anonymous hypotheses whenever needed.
|
||||
* `ext pat* : n` applies ext theorems only up to depth `n`.
|
||||
|
||||
The `ext1 pat*` tactic is like `ext pat*` except that it only applies a single extensionality theorem.
|
||||
|
||||
Unused patterns will generate warning.
|
||||
Patterns that don't match the variables will typically result in the introduction of anonymous hypotheses.
|
||||
-/
|
||||
syntax (name := ext) "ext" (colGt ppSpace rintroPat)* (" : " num)? : tactic
|
||||
|
||||
/-- Apply a single extensionality theorem to the current goal. -/
|
||||
syntax (name := applyExtTheorem) "apply_ext_theorem" : tactic
|
||||
|
||||
/--
|
||||
`ext1 pat*` is like `ext pat*` except that it only applies a single extensionality theorem rather
|
||||
than recursively applying as many extensionality theorems as possible.
|
||||
|
||||
The `pat*` patterns are processed using the `rintro` tactic.
|
||||
If no patterns are supplied, then variables are introduced anonymously using the `intros` tactic.
|
||||
-/
|
||||
macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic =>
|
||||
if xs.isEmpty then `(tactic| apply_ext_theorem <;> intros)
|
||||
else `(tactic| apply_ext_theorem <;> rintro $xs*)
|
||||
|
||||
end Elab.Tactic.Ext
|
||||
end Lean
|
||||
|
||||
attribute [ext] funext propext Subtype.eq
|
||||
|
||||
@[ext] theorem Prod.ext : {x y : Prod α β} → x.fst = y.fst → x.snd = y.snd → x = y
|
||||
| ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl
|
||||
|
||||
@[ext] theorem PProd.ext : {x y : PProd α β} → x.fst = y.fst → x.snd = y.snd → x = y
|
||||
| ⟨_,_⟩, ⟨_,_⟩, rfl, rfl => rfl
|
||||
|
||||
@[ext] theorem Sigma.ext : {x y : Sigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y
|
||||
| ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl
|
||||
|
||||
@[ext] theorem PSigma.ext : {x y : PSigma β} → x.fst = y.fst → HEq x.snd y.snd → x = y
|
||||
| ⟨_,_⟩, ⟨_,_⟩, rfl, .rfl => rfl
|
||||
|
||||
@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl
|
||||
protected theorem Unit.ext (x y : Unit) : x = y := rfl
|
||||
@@ -587,9 +587,6 @@ def mkLit (kind : SyntaxNodeKind) (val : String) (info := SourceInfo.none) : TSy
|
||||
let atom : Syntax := Syntax.atom info val
|
||||
mkNode kind #[atom]
|
||||
|
||||
def mkCharLit (val : Char) (info := SourceInfo.none) : CharLit :=
|
||||
mkLit charLitKind (Char.quote val) info
|
||||
|
||||
def mkStrLit (val : String) (info := SourceInfo.none) : StrLit :=
|
||||
mkLit strLitKind (String.quote val) info
|
||||
|
||||
@@ -1007,7 +1004,6 @@ instance [Quote α k] [CoeHTCT (TSyntax k) (TSyntax [k'])] : Quote α k' := ⟨f
|
||||
|
||||
instance : Quote Term := ⟨id⟩
|
||||
instance : Quote Bool := ⟨fun | true => mkCIdent ``Bool.true | false => mkCIdent ``Bool.false⟩
|
||||
instance : Quote Char charLitKind := ⟨Syntax.mkCharLit⟩
|
||||
instance : Quote String strLitKind := ⟨Syntax.mkStrLit⟩
|
||||
instance : Quote Nat numLitKind := ⟨fun n => Syntax.mkNumLit <| toString n⟩
|
||||
instance : Quote Substring := ⟨fun s => Syntax.mkCApp ``String.toSubstring' #[quote s.toString]⟩
|
||||
|
||||
@@ -464,14 +464,6 @@ macro "without_expected_type " x:term : term => `(let aux := $x; aux)
|
||||
|
||||
namespace Lean
|
||||
|
||||
/--
|
||||
* The `by_elab doSeq` expression runs the `doSeq` as a `TermElabM Expr` to
|
||||
synthesize the expression.
|
||||
* `by_elab fun expectedType? => do doSeq` receives the expected type (an `Option Expr`)
|
||||
as well.
|
||||
-/
|
||||
syntax (name := byElab) "by_elab " doSeq : term
|
||||
|
||||
/--
|
||||
Category for carrying raw syntax trees between macros; any content is printed as is by the pretty printer.
|
||||
The only accepted parser for this category is an antiquotation.
|
||||
@@ -506,26 +498,3 @@ a string literal with the contents of the file at `"parent_dir" / "path" / "to"
|
||||
file cannot be read, elaboration fails.
|
||||
-/
|
||||
syntax (name := includeStr) "include_str " term : term
|
||||
|
||||
/--
|
||||
The `run_cmd doSeq` command executes code in `CommandElabM Unit`.
|
||||
This is almost the same as `#eval show CommandElabM Unit from do doSeq`,
|
||||
except that it doesn't print an empty diagnostic.
|
||||
-/
|
||||
syntax (name := runCmd) "run_cmd " doSeq : command
|
||||
|
||||
/--
|
||||
The `run_elab doSeq` command executes code in `TermElabM Unit`.
|
||||
This is almost the same as `#eval show TermElabM Unit from do doSeq`,
|
||||
except that it doesn't print an empty diagnostic.
|
||||
-/
|
||||
syntax (name := runElab) "run_elab " doSeq : command
|
||||
|
||||
/--
|
||||
The `run_meta doSeq` command executes code in `MetaM Unit`.
|
||||
This is almost the same as `#eval show MetaM Unit from do doSeq`,
|
||||
except that it doesn't print an empty diagnostic.
|
||||
|
||||
(This is effectively a synonym for `run_elab`.)
|
||||
-/
|
||||
syntax (name := runMeta) "run_meta " doSeq : command
|
||||
|
||||
@@ -173,15 +173,16 @@ syntax (name := calcTactic) "calc" calcSteps : tactic
|
||||
/--
|
||||
Denotes a term that was omitted by the pretty printer.
|
||||
This is only used for pretty printing, and it cannot be elaborated.
|
||||
The presence of `⋯` is controlled by the `pp.deepTerms` and `pp.proofs` options.
|
||||
The presence of `⋯` is controlled by the `pp.deepTerms` and `pp.deepTerms.threshold`
|
||||
options.
|
||||
-/
|
||||
syntax "⋯" : term
|
||||
|
||||
macro_rules | `(⋯) => Macro.throwError "\
|
||||
Error: The '⋯' token is used by the pretty printer to indicate omitted terms, \
|
||||
and it cannot be elaborated.\
|
||||
\n\nIts presence in pretty printing output is controlled by the 'pp.deepTerms' and `pp.proofs` options. \
|
||||
These options can be further adjusted using `pp.deepTerms.threshold` and `pp.proofs.threshold`."
|
||||
and it cannot be elaborated. \
|
||||
Its presence in pretty printing output is controlled by the 'pp.deepTerms' and \
|
||||
`pp.deepTerms.threshold` options."
|
||||
|
||||
@[app_unexpander Unit.unit] def unexpandUnit : Lean.PrettyPrinter.Unexpander
|
||||
| `($(_)) => `(())
|
||||
@@ -390,23 +391,6 @@ macro_rules
|
||||
`($mods:declModifiers class $id $params* extends $parents,* $[: $ty]?
|
||||
attribute [instance] $ctor)
|
||||
|
||||
macro_rules
|
||||
| `(haveI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) =>
|
||||
`(haveI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body)
|
||||
| `(haveI _ $bs* := $val; $body) => `(haveI x $bs* : _ := $val; $body)
|
||||
| `(haveI _ $bs* : $ty := $val; $body) => `(haveI x $bs* : $ty := $val; $body)
|
||||
| `(haveI $x:ident $bs* := $val; $body) => `(haveI $x $bs* : _ := $val; $body)
|
||||
| `(haveI $_:ident $_* : $_ := $_; $_) => Lean.Macro.throwUnsupported -- handled by elab
|
||||
|
||||
macro_rules
|
||||
| `(letI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) =>
|
||||
`(letI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body)
|
||||
| `(letI _ $bs* := $val; $body) => `(letI x $bs* : _ := $val; $body)
|
||||
| `(letI _ $bs* : $ty := $val; $body) => `(letI x $bs* : $ty := $val; $body)
|
||||
| `(letI $x:ident $bs* := $val; $body) => `(letI $x $bs* : _ := $val; $body)
|
||||
| `(letI $_:ident $_* : $_ := $_; $_) => Lean.Macro.throwUnsupported -- handled by elab
|
||||
|
||||
|
||||
syntax cdotTk := patternIgnore("· " <|> ". ")
|
||||
/-- `· tac` focuses on the main goal and tries to solve it using `tac`, or else fails. -/
|
||||
syntax (name := cdot) cdotTk tacticSeqIndentGt : tactic
|
||||
|
||||
@@ -548,11 +548,6 @@ theorem Or.elim {c : Prop} (h : Or a b) (left : a → c) (right : b → c) : c :
|
||||
| Or.inl h => left h
|
||||
| Or.inr h => right h
|
||||
|
||||
theorem Or.resolve_left (h: Or a b) (na : Not a) : b := h.elim (absurd · na) id
|
||||
theorem Or.resolve_right (h: Or a b) (nb : Not b) : a := h.elim id (absurd · nb)
|
||||
theorem Or.neg_resolve_left (h : Or (Not a) b) (ha : a) : b := h.elim (absurd ha) id
|
||||
theorem Or.neg_resolve_right (h : Or a (Not b)) (nb : b) : a := h.elim id (absurd nb)
|
||||
|
||||
/--
|
||||
`Bool` is the type of boolean values, `true` and `false`. Classically,
|
||||
this is equivalent to `Prop` (the type of propositions), but the distinction
|
||||
|
||||
@@ -1,437 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Lean FRO. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro
|
||||
|
||||
This provides additional lemmas about propositional types beyond what is
|
||||
needed for Core and SimpLemmas.
|
||||
-/
|
||||
prelude
|
||||
import Init.Core
|
||||
import Init.NotationExtra
|
||||
set_option linter.missingDocs true -- keep it documented
|
||||
|
||||
/-! ## not -/
|
||||
|
||||
theorem not_not_em (a : Prop) : ¬¬(a ∨ ¬a) := fun h => h (.inr (h ∘ .inl))
|
||||
|
||||
/-! ## and -/
|
||||
|
||||
theorem and_self_iff : a ∧ a ↔ a := Iff.of_eq (and_self a)
|
||||
theorem and_not_self_iff (a : Prop) : a ∧ ¬a ↔ False := iff_false_intro and_not_self
|
||||
theorem not_and_self_iff (a : Prop) : ¬a ∧ a ↔ False := iff_false_intro not_and_self
|
||||
|
||||
theorem And.imp (f : a → c) (g : b → d) (h : a ∧ b) : c ∧ d := And.intro (f h.left) (g h.right)
|
||||
theorem And.imp_left (h : a → b) : a ∧ c → b ∧ c := .imp h id
|
||||
theorem And.imp_right (h : a → b) : c ∧ a → c ∧ b := .imp id h
|
||||
|
||||
theorem and_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : a ∧ b ↔ c ∧ d :=
|
||||
Iff.intro (And.imp h₁.mp h₂.mp) (And.imp h₁.mpr h₂.mpr)
|
||||
theorem and_congr_left' (h : a ↔ b) : a ∧ c ↔ b ∧ c := and_congr h .rfl
|
||||
theorem and_congr_right' (h : b ↔ c) : a ∧ b ↔ a ∧ c := and_congr .rfl h
|
||||
|
||||
theorem not_and_of_not_left (b : Prop) : ¬a → ¬(a ∧ b) := mt And.left
|
||||
theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b → ¬(a ∧ b) := mt And.right
|
||||
|
||||
theorem and_congr_right_eq (h : a → b = c) : (a ∧ b) = (a ∧ c) :=
|
||||
propext (and_congr_right (Iff.of_eq ∘ h))
|
||||
theorem and_congr_left_eq (h : c → a = b) : (a ∧ c) = (b ∧ c) :=
|
||||
propext (and_congr_left (Iff.of_eq ∘ h))
|
||||
|
||||
theorem and_left_comm : a ∧ b ∧ c ↔ b ∧ a ∧ c :=
|
||||
Iff.intro (fun ⟨ha, hb, hc⟩ => ⟨hb, ha, hc⟩)
|
||||
(fun ⟨hb, ha, hc⟩ => ⟨ha, hb, hc⟩)
|
||||
|
||||
theorem and_right_comm : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b :=
|
||||
Iff.intro (fun ⟨⟨ha, hb⟩, hc⟩ => ⟨⟨ha, hc⟩, hb⟩)
|
||||
(fun ⟨⟨ha, hc⟩, hb⟩ => ⟨⟨ha, hb⟩, hc⟩)
|
||||
|
||||
theorem and_rotate : a ∧ b ∧ c ↔ b ∧ c ∧ a := by rw [and_left_comm, @and_comm a c]
|
||||
theorem and_and_and_comm : (a ∧ b) ∧ c ∧ d ↔ (a ∧ c) ∧ b ∧ d := by rw [← and_assoc, @and_right_comm a, and_assoc]
|
||||
theorem and_and_left : a ∧ (b ∧ c) ↔ (a ∧ b) ∧ a ∧ c := by rw [and_and_and_comm, and_self]
|
||||
theorem and_and_right : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b ∧ c := by rw [and_and_and_comm, and_self]
|
||||
|
||||
theorem and_iff_left (hb : b) : a ∧ b ↔ a := Iff.intro And.left (And.intro · hb)
|
||||
theorem and_iff_right (ha : a) : a ∧ b ↔ b := Iff.intro And.right (And.intro ha ·)
|
||||
|
||||
/-! ## or -/
|
||||
|
||||
theorem or_self_iff : a ∨ a ↔ a := or_self _ ▸ .rfl
|
||||
theorem not_or_intro {a b : Prop} (ha : ¬a) (hb : ¬b) : ¬(a ∨ b) := (·.elim ha hb)
|
||||
|
||||
theorem or_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ∨ b) ↔ (c ∨ d) := ⟨.imp h₁.mp h₂.mp, .imp h₁.mpr h₂.mpr⟩
|
||||
theorem or_congr_left (h : a ↔ b) : a ∨ c ↔ b ∨ c := or_congr h .rfl
|
||||
theorem or_congr_right (h : b ↔ c) : a ∨ b ↔ a ∨ c := or_congr .rfl h
|
||||
|
||||
theorem or_left_comm : a ∨ (b ∨ c) ↔ b ∨ (a ∨ c) := by rw [← or_assoc, ← or_assoc, @or_comm a b]
|
||||
theorem or_right_comm : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b := by rw [or_assoc, or_assoc, @or_comm b]
|
||||
|
||||
theorem or_or_or_comm : (a ∨ b) ∨ c ∨ d ↔ (a ∨ c) ∨ b ∨ d := by rw [← or_assoc, @or_right_comm a, or_assoc]
|
||||
|
||||
theorem or_or_distrib_left : a ∨ b ∨ c ↔ (a ∨ b) ∨ a ∨ c := by rw [or_or_or_comm, or_self]
|
||||
theorem or_or_distrib_right : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b ∨ c := by rw [or_or_or_comm, or_self]
|
||||
|
||||
theorem or_rotate : a ∨ b ∨ c ↔ b ∨ c ∨ a := by simp only [or_left_comm, Or.comm]
|
||||
|
||||
theorem or_iff_left (hb : ¬b) : a ∨ b ↔ a := or_iff_left_iff_imp.mpr hb.elim
|
||||
theorem or_iff_right (ha : ¬a) : a ∨ b ↔ b := or_iff_right_iff_imp.mpr ha.elim
|
||||
|
||||
/-! ## distributivity -/
|
||||
|
||||
theorem not_imp_of_and_not : a ∧ ¬b → ¬(a → b)
|
||||
| ⟨ha, hb⟩, h => hb <| h ha
|
||||
|
||||
theorem imp_and {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) :=
|
||||
⟨fun h => ⟨fun ha => (h ha).1, fun ha => (h ha).2⟩, fun h ha => ⟨h.1 ha, h.2 ha⟩⟩
|
||||
|
||||
theorem not_and' : ¬(a ∧ b) ↔ b → ¬a := Iff.trans not_and imp_not_comm
|
||||
|
||||
/-- `∧` distributes over `∨` (on the left). -/
|
||||
theorem and_or_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) :=
|
||||
Iff.intro (fun ⟨ha, hbc⟩ => hbc.imp (.intro ha) (.intro ha))
|
||||
(Or.rec (.imp_right .inl) (.imp_right .inr))
|
||||
|
||||
/-- `∧` distributes over `∨` (on the right). -/
|
||||
theorem or_and_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) := by rw [@and_comm (a ∨ b), and_or_left, @and_comm c, @and_comm c]
|
||||
|
||||
/-- `∨` distributes over `∧` (on the left). -/
|
||||
theorem or_and_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) :=
|
||||
Iff.intro (Or.rec (fun ha => ⟨.inl ha, .inl ha⟩) (.imp .inr .inr))
|
||||
(And.rec <| .rec (fun _ => .inl ·) (.imp_right ∘ .intro))
|
||||
|
||||
/-- `∨` distributes over `∧` (on the right). -/
|
||||
theorem and_or_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) := by rw [@or_comm (a ∧ b), or_and_left, @or_comm c, @or_comm c]
|
||||
|
||||
theorem or_imp : (a ∨ b → c) ↔ (a → c) ∧ (b → c) :=
|
||||
Iff.intro (fun h => ⟨h ∘ .inl, h ∘ .inr⟩) (fun ⟨ha, hb⟩ => Or.rec ha hb)
|
||||
theorem not_or : ¬(p ∨ q) ↔ ¬p ∧ ¬q := or_imp
|
||||
|
||||
theorem not_and_of_not_or_not (h : ¬a ∨ ¬b) : ¬(a ∧ b) := h.elim (mt (·.1)) (mt (·.2))
|
||||
|
||||
/-! ## exists and forall -/
|
||||
|
||||
section quantifiers
|
||||
variable {p q : α → Prop} {b : Prop}
|
||||
|
||||
theorem forall_imp (h : ∀ a, p a → q a) : (∀ a, p a) → ∀ a, q a := fun h' a => h a (h' a)
|
||||
|
||||
/--
|
||||
As `simp` does not index foralls, this `@[simp]` lemma is tried on every `forall` expression.
|
||||
This is not ideal, and likely a performance issue, but it is difficult to remove this attribute at this time.
|
||||
-/
|
||||
@[simp] theorem forall_exists_index {q : (∃ x, p x) → Prop} :
|
||||
(∀ h, q h) ↔ ∀ x (h : p x), q ⟨x, h⟩ :=
|
||||
⟨fun h x hpx => h ⟨x, hpx⟩, fun h ⟨x, hpx⟩ => h x hpx⟩
|
||||
|
||||
theorem Exists.imp (h : ∀ a, p a → q a) : (∃ a, p a) → ∃ a, q a
|
||||
| ⟨a, hp⟩ => ⟨a, h a hp⟩
|
||||
|
||||
theorem Exists.imp' {β} {q : β → Prop} (f : α → β) (hpq : ∀ a, p a → q (f a)) :
|
||||
(∃ a, p a) → ∃ b, q b
|
||||
| ⟨_, hp⟩ => ⟨_, hpq _ hp⟩
|
||||
|
||||
theorem exists_imp : ((∃ x, p x) → b) ↔ ∀ x, p x → b := forall_exists_index
|
||||
|
||||
@[simp] theorem exists_const (α) [i : Nonempty α] : (∃ _ : α, b) ↔ b :=
|
||||
⟨fun ⟨_, h⟩ => h, i.elim Exists.intro⟩
|
||||
|
||||
section forall_congr
|
||||
|
||||
theorem forall_congr' (h : ∀ a, p a ↔ q a) : (∀ a, p a) ↔ ∀ a, q a :=
|
||||
⟨fun H a => (h a).1 (H a), fun H a => (h a).2 (H a)⟩
|
||||
|
||||
theorem exists_congr (h : ∀ a, p a ↔ q a) : (∃ a, p a) ↔ ∃ a, q a :=
|
||||
⟨Exists.imp fun x => (h x).1, Exists.imp fun x => (h x).2⟩
|
||||
|
||||
variable {β : α → Sort _}
|
||||
|
||||
theorem forall₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) :
|
||||
(∀ a b, p a b) ↔ ∀ a b, q a b :=
|
||||
forall_congr' fun a => forall_congr' <| h a
|
||||
|
||||
theorem exists₂_congr {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) :
|
||||
(∃ a b, p a b) ↔ ∃ a b, q a b :=
|
||||
exists_congr fun a => exists_congr <| h a
|
||||
|
||||
variable {γ : ∀ a, β a → Sort _}
|
||||
theorem forall₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) :
|
||||
(∀ a b c, p a b c) ↔ ∀ a b c, q a b c :=
|
||||
forall_congr' fun a => forall₂_congr <| h a
|
||||
|
||||
theorem exists₃_congr {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) :
|
||||
(∃ a b c, p a b c) ↔ ∃ a b c, q a b c :=
|
||||
exists_congr fun a => exists₂_congr <| h a
|
||||
|
||||
variable {δ : ∀ a b, γ a b → Sort _}
|
||||
theorem forall₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) :
|
||||
(∀ a b c d, p a b c d) ↔ ∀ a b c d, q a b c d :=
|
||||
forall_congr' fun a => forall₃_congr <| h a
|
||||
|
||||
theorem exists₄_congr {p q : ∀ a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) :
|
||||
(∃ a b c d, p a b c d) ↔ ∃ a b c d, q a b c d :=
|
||||
exists_congr fun a => exists₃_congr <| h a
|
||||
|
||||
variable {ε : ∀ a b c, δ a b c → Sort _}
|
||||
theorem forall₅_congr {p q : ∀ a b c d, ε a b c d → Prop}
|
||||
(h : ∀ a b c d e, p a b c d e ↔ q a b c d e) :
|
||||
(∀ a b c d e, p a b c d e) ↔ ∀ a b c d e, q a b c d e :=
|
||||
forall_congr' fun a => forall₄_congr <| h a
|
||||
|
||||
theorem exists₅_congr {p q : ∀ a b c d, ε a b c d → Prop}
|
||||
(h : ∀ a b c d e, p a b c d e ↔ q a b c d e) :
|
||||
(∃ a b c d e, p a b c d e) ↔ ∃ a b c d e, q a b c d e :=
|
||||
exists_congr fun a => exists₄_congr <| h a
|
||||
|
||||
end forall_congr
|
||||
|
||||
@[simp] theorem not_exists : (¬∃ x, p x) ↔ ∀ x, ¬p x := exists_imp
|
||||
|
||||
theorem forall_and : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
|
||||
⟨fun h => ⟨fun x => (h x).1, fun x => (h x).2⟩, fun ⟨h₁, h₂⟩ x => ⟨h₁ x, h₂ x⟩⟩
|
||||
|
||||
theorem exists_or : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ ∃ x, q x :=
|
||||
⟨fun | ⟨x, .inl h⟩ => .inl ⟨x, h⟩ | ⟨x, .inr h⟩ => .inr ⟨x, h⟩,
|
||||
fun | .inl ⟨x, h⟩ => ⟨x, .inl h⟩ | .inr ⟨x, h⟩ => ⟨x, .inr h⟩⟩
|
||||
|
||||
@[simp] theorem exists_false : ¬(∃ _a : α, False) := fun ⟨_, h⟩ => h
|
||||
|
||||
@[simp] theorem forall_const (α : Sort _) [i : Nonempty α] : (α → b) ↔ b :=
|
||||
⟨i.elim, fun hb _ => hb⟩
|
||||
|
||||
theorem Exists.nonempty : (∃ x, p x) → Nonempty α | ⟨x, _⟩ => ⟨x⟩
|
||||
|
||||
theorem not_forall_of_exists_not {p : α → Prop} : (∃ x, ¬p x) → ¬∀ x, p x
|
||||
| ⟨x, hn⟩, h => hn (h x)
|
||||
|
||||
@[simp] theorem forall_eq {p : α → Prop} {a' : α} : (∀ a, a = a' → p a) ↔ p a' :=
|
||||
⟨fun h => h a' rfl, fun h _ e => e.symm ▸ h⟩
|
||||
|
||||
@[simp] theorem forall_eq' {a' : α} : (∀ a, a' = a → p a) ↔ p a' := by simp [@eq_comm _ a']
|
||||
|
||||
@[simp] theorem exists_eq : ∃ a, a = a' := ⟨_, rfl⟩
|
||||
|
||||
@[simp] theorem exists_eq' : ∃ a, a' = a := ⟨_, rfl⟩
|
||||
|
||||
@[simp] theorem exists_eq_left : (∃ a, a = a' ∧ p a) ↔ p a' :=
|
||||
⟨fun ⟨_, e, h⟩ => e ▸ h, fun h => ⟨_, rfl, h⟩⟩
|
||||
|
||||
@[simp] theorem exists_eq_right : (∃ a, p a ∧ a = a') ↔ p a' :=
|
||||
(exists_congr <| by exact fun a => And.comm).trans exists_eq_left
|
||||
|
||||
@[simp] theorem exists_and_left : (∃ x, b ∧ p x) ↔ b ∧ (∃ x, p x) :=
|
||||
⟨fun ⟨x, h, hp⟩ => ⟨h, x, hp⟩, fun ⟨h, x, hp⟩ => ⟨x, h, hp⟩⟩
|
||||
|
||||
@[simp] theorem exists_and_right : (∃ x, p x ∧ b) ↔ (∃ x, p x) ∧ b := by simp [And.comm]
|
||||
|
||||
@[simp] theorem exists_eq_left' : (∃ a, a' = a ∧ p a) ↔ p a' := by simp [@eq_comm _ a']
|
||||
|
||||
@[simp] theorem forall_eq_or_imp : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a := by
|
||||
simp only [or_imp, forall_and, forall_eq]
|
||||
|
||||
@[simp] theorem exists_eq_or_imp : (∃ a, (a = a' ∨ q a) ∧ p a) ↔ p a' ∨ ∃ a, q a ∧ p a := by
|
||||
simp only [or_and_right, exists_or, exists_eq_left]
|
||||
|
||||
@[simp] theorem exists_eq_right_right : (∃ (a : α), p a ∧ q a ∧ a = a') ↔ p a' ∧ q a' := by
|
||||
simp [← and_assoc]
|
||||
|
||||
@[simp] theorem exists_eq_right_right' : (∃ (a : α), p a ∧ q a ∧ a' = a) ↔ p a' ∧ q a' := by
|
||||
simp [@eq_comm _ a']
|
||||
|
||||
@[simp] theorem exists_prop : (∃ _h : a, b) ↔ a ∧ b :=
|
||||
⟨fun ⟨hp, hq⟩ => ⟨hp, hq⟩, fun ⟨hp, hq⟩ => ⟨hp, hq⟩⟩
|
||||
|
||||
@[simp] theorem exists_apply_eq_apply (f : α → β) (a' : α) : ∃ a, f a = f a' := ⟨a', rfl⟩
|
||||
|
||||
theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h :=
|
||||
@forall_const (q h) p ⟨h⟩
|
||||
|
||||
theorem forall_comm {p : α → β → Prop} : (∀ a b, p a b) ↔ (∀ b a, p a b) :=
|
||||
⟨fun h b a => h a b, fun h a b => h b a⟩
|
||||
|
||||
theorem exists_comm {p : α → β → Prop} : (∃ a b, p a b) ↔ (∃ b a, p a b) :=
|
||||
⟨fun ⟨a, b, h⟩ => ⟨b, a, h⟩, fun ⟨b, a, h⟩ => ⟨a, b, h⟩⟩
|
||||
|
||||
@[simp] theorem forall_apply_eq_imp_iff {f : α → β} {p : β → Prop} :
|
||||
(∀ b a, f a = b → p b) ↔ ∀ a, p (f a) := by simp [forall_comm]
|
||||
|
||||
@[simp] theorem forall_eq_apply_imp_iff {f : α → β} {p : β → Prop} :
|
||||
(∀ b a, b = f a → p b) ↔ ∀ a, p (f a) := by simp [forall_comm]
|
||||
|
||||
@[simp] theorem forall_apply_eq_imp_iff₂ {f : α → β} {p : α → Prop} {q : β → Prop} :
|
||||
(∀ b a, p a → f a = b → q b) ↔ ∀ a, p a → q (f a) :=
|
||||
⟨fun h a ha => h (f a) a ha rfl, fun h _ a ha hb => hb ▸ h a ha⟩
|
||||
|
||||
theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬p) : (∀ h' : p, q h') ↔ True :=
|
||||
iff_true_intro fun h => hn.elim h
|
||||
|
||||
end quantifiers
|
||||
|
||||
/-! ## decidable -/
|
||||
|
||||
theorem Decidable.not_not [Decidable p] : ¬¬p ↔ p := ⟨of_not_not, not_not_intro⟩
|
||||
|
||||
theorem Decidable.by_contra [Decidable p] : (¬p → False) → p := of_not_not
|
||||
|
||||
/-- Construct a non-Prop by cases on an `Or`, when the left conjunct is decidable. -/
|
||||
protected def Or.by_cases [Decidable p] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α :=
|
||||
if hp : p then h₁ hp else h₂ (h.resolve_left hp)
|
||||
|
||||
/-- Construct a non-Prop by cases on an `Or`, when the right conjunct is decidable. -/
|
||||
protected def Or.by_cases' [Decidable q] {α : Sort u} (h : p ∨ q) (h₁ : p → α) (h₂ : q → α) : α :=
|
||||
if hq : q then h₂ hq else h₁ (h.resolve_right hq)
|
||||
|
||||
instance exists_prop_decidable {p} (P : p → Prop)
|
||||
[Decidable p] [∀ h, Decidable (P h)] : Decidable (∃ h, P h) :=
|
||||
if h : p then
|
||||
decidable_of_decidable_of_iff ⟨fun h2 => ⟨h, h2⟩, fun ⟨_, h2⟩ => h2⟩
|
||||
else isFalse fun ⟨h', _⟩ => h h'
|
||||
|
||||
instance forall_prop_decidable {p} (P : p → Prop)
|
||||
[Decidable p] [∀ h, Decidable (P h)] : Decidable (∀ h, P h) :=
|
||||
if h : p then
|
||||
decidable_of_decidable_of_iff ⟨fun h2 _ => h2, fun al => al h⟩
|
||||
else isTrue fun h2 => absurd h2 h
|
||||
|
||||
theorem decide_eq_true_iff (p : Prop) [Decidable p] : (decide p = true) ↔ p := by simp
|
||||
|
||||
@[simp] theorem decide_eq_false_iff_not (p : Prop) {_ : Decidable p} : (decide p = false) ↔ ¬p :=
|
||||
⟨of_decide_eq_false, decide_eq_false⟩
|
||||
|
||||
@[simp] theorem decide_eq_decide {p q : Prop} {_ : Decidable p} {_ : Decidable q} :
|
||||
decide p = decide q ↔ (p ↔ q) :=
|
||||
⟨fun h => by rw [← decide_eq_true_iff p, h, decide_eq_true_iff], fun h => by simp [h]⟩
|
||||
|
||||
theorem Decidable.of_not_imp [Decidable a] (h : ¬(a → b)) : a :=
|
||||
byContradiction (not_not_of_not_imp h)
|
||||
|
||||
theorem Decidable.not_imp_symm [Decidable a] (h : ¬a → b) (hb : ¬b) : a :=
|
||||
byContradiction <| hb ∘ h
|
||||
|
||||
theorem Decidable.not_imp_comm [Decidable a] [Decidable b] : (¬a → b) ↔ (¬b → a) :=
|
||||
⟨not_imp_symm, not_imp_symm⟩
|
||||
|
||||
theorem Decidable.not_imp_self [Decidable a] : (¬a → a) ↔ a := by
|
||||
have := @imp_not_self (¬a); rwa [not_not] at this
|
||||
|
||||
theorem Decidable.or_iff_not_imp_left [Decidable a] : a ∨ b ↔ (¬a → b) :=
|
||||
⟨Or.resolve_left, fun h => dite _ .inl (.inr ∘ h)⟩
|
||||
|
||||
theorem Decidable.or_iff_not_imp_right [Decidable b] : a ∨ b ↔ (¬b → a) :=
|
||||
or_comm.trans or_iff_not_imp_left
|
||||
|
||||
theorem Decidable.not_imp_not [Decidable a] : (¬a → ¬b) ↔ (b → a) :=
|
||||
⟨fun h hb => byContradiction (h · hb), mt⟩
|
||||
|
||||
theorem Decidable.not_or_of_imp [Decidable a] (h : a → b) : ¬a ∨ b :=
|
||||
if ha : a then .inr (h ha) else .inl ha
|
||||
|
||||
theorem Decidable.imp_iff_not_or [Decidable a] : (a → b) ↔ (¬a ∨ b) :=
|
||||
⟨not_or_of_imp, Or.neg_resolve_left⟩
|
||||
|
||||
theorem Decidable.imp_iff_or_not [Decidable b] : b → a ↔ a ∨ ¬b :=
|
||||
Decidable.imp_iff_not_or.trans or_comm
|
||||
|
||||
theorem Decidable.imp_or [h : Decidable a] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
|
||||
if h : a then by
|
||||
rw [imp_iff_right h, imp_iff_right h, imp_iff_right h]
|
||||
else by
|
||||
rw [iff_false_intro h, false_imp_iff, false_imp_iff, true_or]
|
||||
|
||||
theorem Decidable.imp_or' [Decidable b] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
|
||||
if h : b then by simp [h] else by
|
||||
rw [eq_false h, false_or]; exact (or_iff_right_of_imp fun hx x => (hx x).elim).symm
|
||||
|
||||
theorem Decidable.not_imp_iff_and_not [Decidable a] : ¬(a → b) ↔ a ∧ ¬b :=
|
||||
⟨fun h => ⟨of_not_imp h, not_of_not_imp h⟩, not_imp_of_and_not⟩
|
||||
|
||||
theorem Decidable.peirce (a b : Prop) [Decidable a] : ((a → b) → a) → a :=
|
||||
if ha : a then fun _ => ha else fun h => h ha.elim
|
||||
|
||||
theorem peirce' {a : Prop} (H : ∀ b : Prop, (a → b) → a) : a := H _ id
|
||||
|
||||
theorem Decidable.not_iff_not [Decidable a] [Decidable b] : (¬a ↔ ¬b) ↔ (a ↔ b) := by
|
||||
rw [@iff_def (¬a), @iff_def' a]; exact and_congr not_imp_not not_imp_not
|
||||
|
||||
theorem Decidable.not_iff_comm [Decidable a] [Decidable b] : (¬a ↔ b) ↔ (¬b ↔ a) := by
|
||||
rw [@iff_def (¬a), @iff_def (¬b)]; exact and_congr not_imp_comm imp_not_comm
|
||||
|
||||
theorem Decidable.not_iff [Decidable b] : ¬(a ↔ b) ↔ (¬a ↔ b) :=
|
||||
if h : b then by
|
||||
rw [iff_true_right h, iff_true_right h]
|
||||
else by
|
||||
rw [iff_false_right h, iff_false_right h]
|
||||
|
||||
theorem Decidable.iff_not_comm [Decidable a] [Decidable b] : (a ↔ ¬b) ↔ (b ↔ ¬a) := by
|
||||
rw [@iff_def a, @iff_def b]; exact and_congr imp_not_comm not_imp_comm
|
||||
|
||||
theorem Decidable.iff_iff_and_or_not_and_not {a b : Prop} [Decidable b] :
|
||||
(a ↔ b) ↔ (a ∧ b) ∨ (¬a ∧ ¬b) :=
|
||||
⟨fun e => if h : b then .inl ⟨e.2 h, h⟩ else .inr ⟨mt e.1 h, h⟩,
|
||||
Or.rec (And.rec iff_of_true) (And.rec iff_of_false)⟩
|
||||
|
||||
theorem Decidable.iff_iff_not_or_and_or_not [Decidable a] [Decidable b] :
|
||||
(a ↔ b) ↔ (¬a ∨ b) ∧ (a ∨ ¬b) := by
|
||||
rw [iff_iff_implies_and_implies a b]; simp only [imp_iff_not_or, Or.comm]
|
||||
|
||||
theorem Decidable.not_and_not_right [Decidable b] : ¬(a ∧ ¬b) ↔ (a → b) :=
|
||||
⟨fun h ha => not_imp_symm (And.intro ha) h, fun h ⟨ha, hb⟩ => hb <| h ha⟩
|
||||
|
||||
theorem Decidable.not_and_iff_or_not_not [Decidable a] : ¬(a ∧ b) ↔ ¬a ∨ ¬b :=
|
||||
⟨fun h => if ha : a then .inr (h ⟨ha, ·⟩) else .inl ha, not_and_of_not_or_not⟩
|
||||
|
||||
theorem Decidable.not_and_iff_or_not_not' [Decidable b] : ¬(a ∧ b) ↔ ¬a ∨ ¬b :=
|
||||
⟨fun h => if hb : b then .inl (h ⟨·, hb⟩) else .inr hb, not_and_of_not_or_not⟩
|
||||
|
||||
theorem Decidable.or_iff_not_and_not [Decidable a] [Decidable b] : a ∨ b ↔ ¬(¬a ∧ ¬b) := by
|
||||
rw [← not_or, not_not]
|
||||
|
||||
theorem Decidable.and_iff_not_or_not [Decidable a] [Decidable b] : a ∧ b ↔ ¬(¬a ∨ ¬b) := by
|
||||
rw [← not_and_iff_or_not_not, not_not]
|
||||
|
||||
theorem Decidable.imp_iff_right_iff [Decidable a] : (a → b ↔ b) ↔ a ∨ b :=
|
||||
⟨fun H => (Decidable.em a).imp_right fun ha' => H.1 fun ha => (ha' ha).elim,
|
||||
fun H => H.elim imp_iff_right fun hb => iff_of_true (fun _ => hb) hb⟩
|
||||
|
||||
theorem Decidable.and_or_imp [Decidable a] : a ∧ b ∨ (a → c) ↔ a → b ∨ c :=
|
||||
if ha : a then by simp only [ha, true_and, true_imp_iff]
|
||||
else by simp only [ha, false_or, false_and, false_imp_iff]
|
||||
|
||||
theorem Decidable.or_congr_left' [Decidable c] (h : ¬c → (a ↔ b)) : a ∨ c ↔ b ∨ c := by
|
||||
rw [or_iff_not_imp_right, or_iff_not_imp_right]; exact imp_congr_right h
|
||||
|
||||
theorem Decidable.or_congr_right' [Decidable a] (h : ¬a → (b ↔ c)) : a ∨ b ↔ a ∨ c := by
|
||||
rw [or_iff_not_imp_left, or_iff_not_imp_left]; exact imp_congr_right h
|
||||
|
||||
/-- Transfer decidability of `a` to decidability of `b`, if the propositions are equivalent.
|
||||
**Important**: this function should be used instead of `rw` on `Decidable b`, because the
|
||||
kernel will get stuck reducing the usage of `propext` otherwise,
|
||||
and `decide` will not work. -/
|
||||
@[inline] def decidable_of_iff (a : Prop) (h : a ↔ b) [Decidable a] : Decidable b :=
|
||||
decidable_of_decidable_of_iff h
|
||||
|
||||
/-- Transfer decidability of `b` to decidability of `a`, if the propositions are equivalent.
|
||||
This is the same as `decidable_of_iff` but the iff is flipped. -/
|
||||
@[inline] def decidable_of_iff' (b : Prop) (h : a ↔ b) [Decidable b] : Decidable a :=
|
||||
decidable_of_decidable_of_iff h.symm
|
||||
|
||||
instance Decidable.predToBool (p : α → Prop) [DecidablePred p] :
|
||||
CoeDep (α → Prop) p (α → Bool) := ⟨fun b => decide <| p b⟩
|
||||
|
||||
/-- Prove that `a` is decidable by constructing a boolean `b` and a proof that `b ↔ a`.
|
||||
(This is sometimes taken as an alternate definition of decidability.) -/
|
||||
def decidable_of_bool : ∀ (b : Bool), (b ↔ a) → Decidable a
|
||||
| true, h => isTrue (h.1 rfl)
|
||||
| false, h => isFalse (mt h.2 Bool.noConfusion)
|
||||
|
||||
protected theorem Decidable.not_forall {p : α → Prop} [Decidable (∃ x, ¬p x)]
|
||||
[∀ x, Decidable (p x)] : (¬∀ x, p x) ↔ ∃ x, ¬p x :=
|
||||
⟨Decidable.not_imp_symm fun nx x => Decidable.not_imp_symm (fun h => ⟨x, h⟩) nx,
|
||||
not_forall_of_exists_not⟩
|
||||
|
||||
protected theorem Decidable.not_forall_not {p : α → Prop} [Decidable (∃ x, p x)] :
|
||||
(¬∀ x, ¬p x) ↔ ∃ x, p x :=
|
||||
(@Decidable.not_iff_comm _ _ _ (decidable_of_iff (¬∃ x, p x) not_exists)).1 not_exists
|
||||
|
||||
protected theorem Decidable.not_exists_not {p : α → Prop} [∀ x, Decidable (p x)] :
|
||||
(¬∃ x, ¬p x) ↔ ∀ x, p x := by
|
||||
simp only [not_exists, Decidable.not_not]
|
||||
@@ -31,9 +31,6 @@ theorem eq_false_of_decide {p : Prop} {_ : Decidable p} (h : decide p = false) :
|
||||
theorem implies_congr {p₁ p₂ : Sort u} {q₁ q₂ : Sort v} (h₁ : p₁ = p₂) (h₂ : q₁ = q₂) : (p₁ → q₁) = (p₂ → q₂) :=
|
||||
h₁ ▸ h₂ ▸ rfl
|
||||
|
||||
theorem iff_congr {p₁ p₂ q₁ q₂ : Prop} (h₁ : p₁ ↔ p₂) (h₂ : q₁ ↔ q₂) : (p₁ ↔ q₁) ↔ (p₂ ↔ q₂) :=
|
||||
Iff.of_eq (propext h₁ ▸ propext h₂ ▸ rfl)
|
||||
|
||||
theorem implies_dep_congr_ctx {p₁ p₂ q₁ : Prop} (h₁ : p₁ = p₂) {q₂ : p₂ → Prop} (h₂ : (h : p₂) → q₁ = q₂ h) : (p₁ → q₁) = ((h : p₂) → q₂ h) :=
|
||||
propext ⟨
|
||||
fun hl hp₂ => (h₂ hp₂).mp (hl (h₁.mpr hp₂)),
|
||||
@@ -96,16 +93,11 @@ theorem dite_cond_eq_true {α : Sort u} {c : Prop} {_ : Decidable c} {t : c →
|
||||
theorem dite_cond_eq_false {α : Sort u} {c : Prop} {_ : Decidable c} {t : c → α} {e : ¬ c → α} (h : c = False) : (dite c t e) = e (of_eq_false h) := by simp [h]
|
||||
end SimprocHelperLemmas
|
||||
@[simp] theorem ite_self {α : Sort u} {c : Prop} {d : Decidable c} (a : α) : ite c a a = a := by cases d <;> rfl
|
||||
|
||||
@[simp] theorem and_self (p : Prop) : (p ∧ p) = p := propext ⟨(·.1), fun h => ⟨h, h⟩⟩
|
||||
@[simp] theorem and_true (p : Prop) : (p ∧ True) = p := propext ⟨(·.1), (⟨·, trivial⟩)⟩
|
||||
@[simp] theorem true_and (p : Prop) : (True ∧ p) = p := propext ⟨(·.2), (⟨trivial, ·⟩)⟩
|
||||
@[simp] theorem and_false (p : Prop) : (p ∧ False) = False := eq_false (·.2)
|
||||
@[simp] theorem false_and (p : Prop) : (False ∧ p) = False := eq_false (·.1)
|
||||
@[simp] theorem and_self (p : Prop) : (p ∧ p) = p := propext ⟨(·.left), fun h => ⟨h, h⟩⟩
|
||||
@[simp] theorem and_not_self : ¬(a ∧ ¬a) | ⟨ha, hn⟩ => absurd ha hn
|
||||
@[simp] theorem not_and_self : ¬(¬a ∧ a) := and_not_self ∘ And.symm
|
||||
@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) := ⟨fun h ha hb => h ⟨ha, hb⟩, fun h ⟨ha, hb⟩ => h ha hb⟩
|
||||
@[simp] theorem not_and : ¬(a ∧ b) ↔ (a → ¬b) := and_imp
|
||||
@[simp] theorem or_self (p : Prop) : (p ∨ p) = p := propext ⟨fun | .inl h | .inr h => h, .inl⟩
|
||||
@[simp] theorem or_true (p : Prop) : (p ∨ True) = True := eq_true (.inr trivial)
|
||||
@[simp] theorem true_or (p : Prop) : (True ∨ p) = True := eq_true (.inl trivial)
|
||||
@@ -122,58 +114,6 @@ end SimprocHelperLemmas
|
||||
@[simp] theorem not_false_eq_true : (¬ False) = True := eq_true False.elim
|
||||
@[simp] theorem not_true_eq_false : (¬ True) = False := by decide
|
||||
|
||||
@[simp] theorem not_iff_self : ¬(¬a ↔ a) | H => iff_not_self H.symm
|
||||
|
||||
/-! ## and -/
|
||||
|
||||
theorem and_congr_right (h : a → (b ↔ c)) : a ∧ b ↔ a ∧ c :=
|
||||
Iff.intro (fun ⟨ha, hb⟩ => And.intro ha ((h ha).mp hb))
|
||||
(fun ⟨ha, hb⟩ => And.intro ha ((h ha).mpr hb))
|
||||
theorem and_congr_left (h : c → (a ↔ b)) : a ∧ c ↔ b ∧ c :=
|
||||
Iff.trans and_comm (Iff.trans (and_congr_right h) and_comm)
|
||||
|
||||
theorem and_assoc : (a ∧ b) ∧ c ↔ a ∧ (b ∧ c) :=
|
||||
Iff.intro (fun ⟨⟨ha, hb⟩, hc⟩ => ⟨ha, hb, hc⟩)
|
||||
(fun ⟨ha, hb, hc⟩ => ⟨⟨ha, hb⟩, hc⟩)
|
||||
|
||||
@[simp] theorem and_self_left : a ∧ (a ∧ b) ↔ a ∧ b := by rw [←propext and_assoc, and_self]
|
||||
@[simp] theorem and_self_right : (a ∧ b) ∧ b ↔ a ∧ b := by rw [ propext and_assoc, and_self]
|
||||
|
||||
@[simp] theorem and_congr_right_iff : (a ∧ b ↔ a ∧ c) ↔ (a → (b ↔ c)) :=
|
||||
Iff.intro (fun h ha => by simp [ha] at h; exact h) and_congr_right
|
||||
@[simp] theorem and_congr_left_iff : (a ∧ c ↔ b ∧ c) ↔ c → (a ↔ b) := by
|
||||
rw [@and_comm _ c, @and_comm _ c, ← and_congr_right_iff]
|
||||
|
||||
theorem and_iff_left_of_imp (h : a → b) : (a ∧ b) ↔ a := Iff.intro And.left (fun ha => And.intro ha (h ha))
|
||||
theorem and_iff_right_of_imp (h : b → a) : (a ∧ b) ↔ b := Iff.trans And.comm (and_iff_left_of_imp h)
|
||||
|
||||
@[simp] theorem and_iff_left_iff_imp : ((a ∧ b) ↔ a) ↔ (a → b) := Iff.intro (And.right ∘ ·.mpr) and_iff_left_of_imp
|
||||
@[simp] theorem and_iff_right_iff_imp : ((a ∧ b) ↔ b) ↔ (b → a) := Iff.intro (And.left ∘ ·.mpr) and_iff_right_of_imp
|
||||
|
||||
@[simp] theorem iff_self_and : (p ↔ p ∧ q) ↔ (p → q) := by rw [@Iff.comm p, and_iff_left_iff_imp]
|
||||
@[simp] theorem iff_and_self : (p ↔ q ∧ p) ↔ (p → q) := by rw [and_comm, iff_self_and]
|
||||
|
||||
/-! ## or -/
|
||||
|
||||
theorem Or.imp (f : a → c) (g : b → d) (h : a ∨ b) : c ∨ d := h.elim (inl ∘ f) (inr ∘ g)
|
||||
theorem Or.imp_left (f : a → b) : a ∨ c → b ∨ c := .imp f id
|
||||
theorem Or.imp_right (f : b → c) : a ∨ b → a ∨ c := .imp id f
|
||||
|
||||
theorem or_assoc : (a ∨ b) ∨ c ↔ a ∨ (b ∨ c) :=
|
||||
Iff.intro (.rec (.imp_right .inl) (.inr ∘ .inr))
|
||||
(.rec (.inl ∘ .inl) (.imp_left .inr))
|
||||
|
||||
@[simp] theorem or_self_left : a ∨ (a ∨ b) ↔ a ∨ b := by rw [←propext or_assoc, or_self]
|
||||
@[simp] theorem or_self_right : (a ∨ b) ∨ b ↔ a ∨ b := by rw [ propext or_assoc, or_self]
|
||||
|
||||
theorem or_iff_right_of_imp (ha : a → b) : (a ∨ b) ↔ b := Iff.intro (Or.rec ha id) .inr
|
||||
theorem or_iff_left_of_imp (hb : b → a) : (a ∨ b) ↔ a := Iff.intro (Or.rec id hb) .inl
|
||||
|
||||
@[simp] theorem or_iff_left_iff_imp : (a ∨ b ↔ a) ↔ (b → a) := Iff.intro (·.mp ∘ Or.inr) or_iff_left_of_imp
|
||||
@[simp] theorem or_iff_right_iff_imp : (a ∨ b ↔ b) ↔ (a → b) := by rw [or_comm, or_iff_left_iff_imp]
|
||||
|
||||
/-# Bool -/
|
||||
|
||||
@[simp] theorem Bool.or_false (b : Bool) : (b || false) = b := by cases b <;> rfl
|
||||
@[simp] theorem Bool.or_true (b : Bool) : (b || true) = true := by cases b <;> rfl
|
||||
@[simp] theorem Bool.false_or (b : Bool) : (false || b) = b := by cases b <;> rfl
|
||||
@@ -226,13 +166,11 @@ theorem Bool.or_assoc (a b c : Bool) : (a || b || c) = (a || (b || c)) := by
|
||||
@[simp] theorem bne_self_eq_false [BEq α] [LawfulBEq α] (a : α) : (a != a) = false := by simp [bne]
|
||||
@[simp] theorem bne_self_eq_false' [DecidableEq α] (a : α) : (a != a) = false := by simp [bne]
|
||||
|
||||
@[simp] theorem Nat.le_zero_eq (a : Nat) : (a ≤ 0) = (a = 0) :=
|
||||
propext ⟨fun h => Nat.le_antisymm h (Nat.zero_le ..), fun h => by rw [h]; decide⟩
|
||||
|
||||
@[simp] theorem decide_False : decide False = false := rfl
|
||||
@[simp] theorem decide_True : decide True = true := rfl
|
||||
|
||||
@[simp] theorem bne_iff_ne [BEq α] [LawfulBEq α] (a b : α) : a != b ↔ a ≠ b := by
|
||||
simp [bne]; rw [← beq_iff_eq a b]; simp [-beq_iff_eq]
|
||||
|
||||
/-# Nat -/
|
||||
|
||||
@[simp] theorem Nat.le_zero_eq (a : Nat) : (a ≤ 0) = (a = 0) :=
|
||||
propext ⟨fun h => Nat.le_antisymm h (Nat.zero_le ..), fun h => by rw [h]; decide⟩
|
||||
|
||||
@@ -172,19 +172,6 @@ example (x : Nat) (h : x ≠ x) : p := by contradiction
|
||||
-/
|
||||
syntax (name := contradiction) "contradiction" : tactic
|
||||
|
||||
/--
|
||||
Changes the goal to `False`, retaining as much information as possible:
|
||||
|
||||
* If the goal is `False`, do nothing.
|
||||
* If the goal is an implication or a function type, introduce the argument and restart.
|
||||
(In particular, if the goal is `x ≠ y`, introduce `x = y`.)
|
||||
* Otherwise, for a propositional goal `P`, replace it with `¬ ¬ P`
|
||||
(attempting to find a `Decidable` instance, but otherwise falling back to working classically)
|
||||
and introduce `¬ P`.
|
||||
* For a non-propositional goal use `False.elim`.
|
||||
-/
|
||||
syntax (name := falseOrByContra) "false_or_by_contra" : tactic
|
||||
|
||||
/--
|
||||
`apply e` tries to match the current goal against the conclusion of `e`'s type.
|
||||
If it succeeds, then the tactic returns as many subgoals as the number of premises that
|
||||
@@ -214,9 +201,6 @@ and implicit parameters are also converted into new goals.
|
||||
-/
|
||||
syntax (name := refine') "refine' " term : tactic
|
||||
|
||||
/-- `exfalso` converts a goal `⊢ tgt` into `⊢ False` by applying `False.elim`. -/
|
||||
macro "exfalso" : tactic => `(tactic| refine False.elim ?_)
|
||||
|
||||
/--
|
||||
If the main goal's target type is an inductive type, `constructor` solves it with
|
||||
the first matching constructor, or else fails.
|
||||
@@ -957,21 +941,6 @@ syntax (name := repeat1') "repeat1' " tacticSeq : tactic
|
||||
syntax "and_intros" : tactic
|
||||
macro_rules | `(tactic| and_intros) => `(tactic| repeat' refine And.intro ?_ ?_)
|
||||
|
||||
/--
|
||||
`subst_eq` repeatedly substitutes according to the equality proof hypotheses in the context,
|
||||
replacing the left side of the equality with the right, until no more progress can be made.
|
||||
-/
|
||||
syntax (name := substEqs) "subst_eqs" : tactic
|
||||
|
||||
/-- The `run_tac doSeq` tactic executes code in `TacticM Unit`. -/
|
||||
syntax (name := runTac) "run_tac " doSeq : tactic
|
||||
|
||||
/-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/
|
||||
macro "haveI" d:haveDecl : tactic => `(tactic| refine_lift haveI $d:haveDecl; ?_)
|
||||
|
||||
/-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/
|
||||
macro "letI" d:haveDecl : tactic => `(tactic| refine_lift letI $d:haveDecl; ?_)
|
||||
|
||||
end Tactic
|
||||
|
||||
namespace Attr
|
||||
|
||||
@@ -206,39 +206,12 @@ protected inductive Lex : α × β → α × β → Prop where
|
||||
| left {a₁} (b₁) {a₂} (b₂) (h : ra a₁ a₂) : Prod.Lex (a₁, b₁) (a₂, b₂)
|
||||
| right (a) {b₁ b₂} (h : rb b₁ b₂) : Prod.Lex (a, b₁) (a, b₂)
|
||||
|
||||
theorem lex_def (r : α → α → Prop) (s : β → β → Prop) {p q : α × β} :
|
||||
Prod.Lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 :=
|
||||
⟨fun h => by cases h <;> simp [*], fun h =>
|
||||
match p, q, h with
|
||||
| (a, b), (c, d), Or.inl h => Lex.left _ _ h
|
||||
| (a, b), (c, d), Or.inr ⟨e, h⟩ => by subst e; exact Lex.right _ h⟩
|
||||
|
||||
namespace Lex
|
||||
|
||||
instance [αeqDec : DecidableEq α] {r : α → α → Prop} [rDec : DecidableRel r]
|
||||
{s : β → β → Prop} [sDec : DecidableRel s] : DecidableRel (Prod.Lex r s)
|
||||
| (a, b), (a', b') =>
|
||||
match rDec a a' with
|
||||
| isTrue raa' => isTrue $ left b b' raa'
|
||||
| isFalse nraa' =>
|
||||
match αeqDec a a' with
|
||||
| isTrue eq => by
|
||||
subst eq
|
||||
cases sDec b b' with
|
||||
| isTrue sbb' => exact isTrue $ right a sbb'
|
||||
| isFalse nsbb' =>
|
||||
apply isFalse; intro contra; cases contra <;> contradiction
|
||||
| isFalse neqaa' => by
|
||||
apply isFalse; intro contra; cases contra <;> contradiction
|
||||
|
||||
-- TODO: generalize
|
||||
def right' {a₁ : Nat} {b₁ : β} (h₁ : a₁ ≤ a₂) (h₂ : rb b₁ b₂) : Prod.Lex Nat.lt rb (a₁, b₁) (a₂, b₂) :=
|
||||
def Lex.right' {a₁ : Nat} {b₁ : β} (h₁ : a₁ ≤ a₂) (h₂ : rb b₁ b₂) : Prod.Lex Nat.lt rb (a₁, b₁) (a₂, b₂) :=
|
||||
match Nat.eq_or_lt_of_le h₁ with
|
||||
| Or.inl h => h ▸ Prod.Lex.right a₁ h₂
|
||||
| Or.inr h => Prod.Lex.left b₁ _ h
|
||||
|
||||
end Lex
|
||||
|
||||
-- relational product based on ra and rb
|
||||
inductive RProd : α × β → α × β → Prop where
|
||||
| intro {a₁ b₁ a₂ b₂} (h₁ : ra a₁ a₂) (h₂ : rb b₁ b₂) : RProd (a₁, b₁) (a₂, b₂)
|
||||
|
||||
@@ -90,11 +90,6 @@ def toCInitName (n : Name) : M String := do
|
||||
def emitCInitName (n : Name) : M Unit :=
|
||||
toCInitName n >>= emit
|
||||
|
||||
def shouldExport (n : Name) : Bool :=
|
||||
-- HACK: exclude symbols very unlikely to be used by the interpreter or other consumers of
|
||||
-- libleanshared to avoid Windows symbol limit
|
||||
!(`Lean.Compiler.LCNF).isPrefixOf n
|
||||
|
||||
def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M Unit := do
|
||||
let ps := decl.params
|
||||
let env ← getEnv
|
||||
@@ -103,7 +98,7 @@ def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M U
|
||||
else if isExternal then emit "extern "
|
||||
else emit "LEAN_EXPORT "
|
||||
else
|
||||
if !isExternal && shouldExport decl.name then emit "LEAN_EXPORT "
|
||||
if !isExternal then emit "LEAN_EXPORT "
|
||||
emit (toCType decl.resultType ++ " " ++ cppBaseName)
|
||||
unless ps.isEmpty do
|
||||
emit "("
|
||||
@@ -645,7 +640,7 @@ def emitDeclAux (d : Decl) : M Unit := do
|
||||
let baseName ← toCName f;
|
||||
if xs.size == 0 then
|
||||
emit "static "
|
||||
else if shouldExport f then
|
||||
else
|
||||
emit "LEAN_EXPORT " -- make symbol visible to the interpreter
|
||||
emit (toCType t); emit " ";
|
||||
if xs.size > 0 then
|
||||
|
||||
@@ -194,11 +194,3 @@ def insertMany [ForIn Id ρ α] (s : HashSet α) (as : ρ) : HashSet α := Id.ru
|
||||
for a in as do
|
||||
s := s.insert a
|
||||
return s
|
||||
|
||||
/--
|
||||
`O(|t|)` amortized. Merge two `HashSet`s.
|
||||
-/
|
||||
@[inline]
|
||||
def merge {α : Type u} [BEq α] [Hashable α] (s t : HashSet α) : HashSet α :=
|
||||
t.fold (init := s) fun s a => s.insert a
|
||||
-- We don't use `insertMany` here because it gives weird universes.
|
||||
|
||||
@@ -98,7 +98,7 @@ protected def toString : JsonNumber → String
|
||||
-- grow exponentially in the value of exponent.
|
||||
let exp : Int := 9 + countDigits m - (e : Int)
|
||||
let exp := if exp < 0 then exp else 0
|
||||
let e' := 10 ^ (e - exp.natAbs)
|
||||
let e' := (10 : Int) ^ (e - exp.natAbs)
|
||||
let left := (m / e').repr
|
||||
if m % e' = 0 && exp = 0 then
|
||||
s!"{sign}{left}"
|
||||
|
||||
@@ -24,7 +24,7 @@ instance : Repr Rat where
|
||||
|
||||
@[inline] def Rat.normalize (a : Rat) : Rat :=
|
||||
let n := Nat.gcd a.num.natAbs a.den
|
||||
if n == 1 then a else { num := a.num.div n, den := a.den / n }
|
||||
if n == 1 then a else { num := a.num / n, den := a.den / n }
|
||||
|
||||
def mkRat (num : Int) (den : Nat) : Rat :=
|
||||
if den == 0 then { num := 0 } else Rat.normalize { num, den }
|
||||
@@ -48,7 +48,7 @@ protected def lt (a b : Rat) : Bool :=
|
||||
protected def mul (a b : Rat) : Rat :=
|
||||
let g1 := Nat.gcd a.den b.num.natAbs
|
||||
let g2 := Nat.gcd a.num.natAbs b.den
|
||||
{ num := (a.num.div g2)*(b.num.div g1)
|
||||
{ num := (a.num / g2)*(b.num / g1)
|
||||
den := (b.den / g2)*(a.den / g1) }
|
||||
|
||||
protected def inv (a : Rat) : Rat :=
|
||||
@@ -68,12 +68,12 @@ protected def add (a b : Rat) : Rat :=
|
||||
{ num := a.num * b.den + b.num * a.den, den := a.den * b.den }
|
||||
else
|
||||
let den := (a.den / g) * b.den
|
||||
let num := Int.ofNat (b.den / g) * a.num + Int.ofNat (a.den / g) * b.num
|
||||
let num := (b.den / g) * a.num + (a.den / g) * b.num
|
||||
let g1 := Nat.gcd num.natAbs g
|
||||
if g1 == 1 then
|
||||
{ num, den }
|
||||
else
|
||||
{ num := num.div g1, den := den / g1 }
|
||||
{ num := num / g1, den := den / g1 }
|
||||
|
||||
protected def sub (a b : Rat) : Rat :=
|
||||
let g := Nat.gcd a.den b.den
|
||||
@@ -86,7 +86,7 @@ protected def sub (a b : Rat) : Rat :=
|
||||
if g1 == 1 then
|
||||
{ num, den }
|
||||
else
|
||||
{ num := num.div g1, den := den / g1 }
|
||||
{ num := num / g1, den := den / g1 }
|
||||
|
||||
protected def neg (a : Rat) : Rat :=
|
||||
{ a with num := - a.num }
|
||||
@@ -95,14 +95,14 @@ protected def floor (a : Rat) : Int :=
|
||||
if a.den == 1 then
|
||||
a.num
|
||||
else
|
||||
let r := a.num.mod a.den
|
||||
let r := a.num / a.den
|
||||
if a.num < 0 then r - 1 else r
|
||||
|
||||
protected def ceil (a : Rat) : Int :=
|
||||
if a.den == 1 then
|
||||
a.num
|
||||
else
|
||||
let r := a.num.mod a.den
|
||||
let r := a.num / a.den
|
||||
if a.num > 0 then r + 1 else r
|
||||
|
||||
instance : LT Rat where
|
||||
|
||||
@@ -10,7 +10,6 @@ import Lean.Elab.Command
|
||||
import Lean.Elab.Term
|
||||
import Lean.Elab.App
|
||||
import Lean.Elab.Binders
|
||||
import Lean.Elab.BinderPredicates
|
||||
import Lean.Elab.LetRec
|
||||
import Lean.Elab.Frontend
|
||||
import Lean.Elab.BuiltinNotation
|
||||
|
||||
@@ -1,41 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner
|
||||
-/
|
||||
import Lean.Parser.Syntax
|
||||
import Lean.Elab.MacroArgUtil
|
||||
import Lean.Linter.MissingDocs
|
||||
|
||||
namespace Lean.Elab.Command
|
||||
|
||||
@[builtin_command_elab binderPredicate] def elabBinderPred : CommandElab := fun stx => do
|
||||
match stx with
|
||||
| `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind binder_predicate%$tk
|
||||
$[(name := $name?)]? $[(priority := $prio?)]? $x $args:macroArg* => $rhs) => do
|
||||
let prio ← liftMacroM do evalOptPrio prio?
|
||||
let (stxParts, patArgs) := (← args.mapM expandMacroArg).unzip
|
||||
let name ← match name? with
|
||||
| some name => pure name.getId
|
||||
| none => liftMacroM do mkNameFromParserSyntax `binderTerm (mkNullNode stxParts)
|
||||
let nameTk := name?.getD (mkIdentFrom tk name)
|
||||
/- The command `syntax [<kind>] ...` adds the current namespace to the syntax node kind.
|
||||
So, we must include current namespace when we create a pattern for the following
|
||||
`macro_rules` commands. -/
|
||||
let pat : TSyntax `binderPred := ⟨(mkNode ((← getCurrNamespace) ++ name) patArgs).1⟩
|
||||
elabCommand <|<-
|
||||
`($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind syntax%$tk
|
||||
(name := $nameTk) (priority := $(quote prio)) $[$stxParts]* : binderPred
|
||||
$[$doc?:docComment]? macro_rules%$tk
|
||||
| `(satisfies_binder_pred% $$($x):term $pat:binderPred) => $rhs)
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
open Linter.MissingDocs Parser Term in
|
||||
/-- Missing docs handler for `binder_predicate` -/
|
||||
@[builtin_missing_docs_handler Lean.Parser.Command.binderPredicate]
|
||||
def checkBinderPredicate : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» then
|
||||
if stx[4].isNone then lint stx[3] "binder predicate"
|
||||
else lintNamed stx[4][0][3] "binder predicate"
|
||||
|
||||
end Lean.Elab.Command
|
||||
@@ -704,39 +704,6 @@ unsafe def elabEvalUnsafe : CommandElab
|
||||
@[builtin_command_elab «eval», implemented_by elabEvalUnsafe]
|
||||
opaque elabEval : CommandElab
|
||||
|
||||
private def checkImportsForRunCmds : CommandElabM Unit := do
|
||||
unless (← getEnv).contains ``CommandElabM do
|
||||
throwError "to use this command, include `import Lean.Elab.Command`"
|
||||
|
||||
@[builtin_command_elab runCmd]
|
||||
def elabRunCmd : CommandElab
|
||||
| `(run_cmd $elems:doSeq) => do
|
||||
checkImportsForRunCmds
|
||||
(← liftTermElabM <| Term.withDeclName `_run_cmd <|
|
||||
unsafe Term.evalTerm (CommandElabM Unit)
|
||||
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
|
||||
(← `(discard do $elems)))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab runElab]
|
||||
def elabRunElab : CommandElab
|
||||
| `(run_elab $elems:doSeq) => do
|
||||
checkImportsForRunCmds
|
||||
(← liftTermElabM <| Term.withDeclName `_run_elab <|
|
||||
unsafe Term.evalTerm (CommandElabM Unit)
|
||||
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
|
||||
(← `(Command.liftTermElabM <| discard do $elems)))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab runMeta]
|
||||
def elabRunMeta : CommandElab := fun stx =>
|
||||
match stx with
|
||||
| `(run_meta $elems:doSeq) => do
|
||||
checkImportsForRunCmds
|
||||
let stxNew ← `(command| run_elab (show Lean.Meta.MetaM Unit from do $elems))
|
||||
withMacroExpansion stx stxNew do elabCommand stxNew
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_command_elab «synth»] def elabSynth : CommandElab := fun stx => do
|
||||
let term := stx[1]
|
||||
withoutModifyingEnv <| runTermElabM fun _ => Term.withDeclName `_synth_cmd do
|
||||
|
||||
@@ -7,10 +7,8 @@ import Lean.Compiler.BorrowedAnnotation
|
||||
import Lean.Meta.KAbstract
|
||||
import Lean.Meta.Closure
|
||||
import Lean.Meta.MatchUtil
|
||||
import Lean.Compiler.ImplementedByAttr
|
||||
import Lean.Elab.SyntheticMVars
|
||||
import Lean.Elab.Eval
|
||||
import Lean.Elab.Binders
|
||||
import Lean.Compiler.ImplementedByAttr
|
||||
|
||||
namespace Lean.Elab.Term
|
||||
open Meta
|
||||
@@ -429,6 +427,12 @@ private def withLocalIdentFor (stx : Term) (e : Expr) (k : Term → TermElabM Ex
|
||||
let e ← elabTerm stx[1] expectedType?
|
||||
return DiscrTree.mkNoindexAnnotation e
|
||||
|
||||
-- TODO: investigate whether we need this function
|
||||
private def mkAuxNameForElabUnsafe (hint : Name) : TermElabM Name :=
|
||||
withFreshMacroScope do
|
||||
let name := (← getDeclName?).getD Name.anonymous ++ hint
|
||||
return addMacroScope (← getMainModule) name (← getCurrMacroScope)
|
||||
|
||||
@[builtin_term_elab «unsafe»]
|
||||
def elabUnsafe : TermElab := fun stx expectedType? =>
|
||||
match stx with
|
||||
@@ -439,7 +443,7 @@ def elabUnsafe : TermElab := fun stx expectedType? =>
|
||||
let t ← mkAuxDefinitionFor (← mkAuxName `unsafe) t
|
||||
let .const unsafeFn unsafeLvls .. := t.getAppFn | unreachable!
|
||||
let .defnInfo unsafeDefn ← getConstInfo unsafeFn | unreachable!
|
||||
let implName ← mkAuxName `unsafe_impl
|
||||
let implName ← mkAuxNameForElabUnsafe `impl
|
||||
addDecl <| Declaration.defnDecl {
|
||||
name := implName
|
||||
type := unsafeDefn.type
|
||||
@@ -452,44 +456,4 @@ def elabUnsafe : TermElab := fun stx expectedType? =>
|
||||
return mkAppN (Lean.mkConst implName unsafeLvls) t.getAppArgs
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
/-- Elaborator for `by_elab`. -/
|
||||
@[builtin_term_elab byElab] def elabRunElab : TermElab := fun stx expectedType? =>
|
||||
match stx with
|
||||
| `(by_elab $cmds:doSeq) => do
|
||||
if let `(Lean.Parser.Term.doSeq| $e:term) := cmds then
|
||||
if e matches `(Lean.Parser.Term.doSeq| fun $[$_args]* => $_) then
|
||||
let tac ← unsafe evalTerm
|
||||
(Option Expr → TermElabM Expr)
|
||||
(Lean.mkForall `x .default
|
||||
(mkApp (Lean.mkConst ``Option) (Lean.mkConst ``Expr))
|
||||
(mkApp (Lean.mkConst ``TermElabM) (Lean.mkConst ``Expr))) e
|
||||
return ← tac expectedType?
|
||||
(← unsafe evalTerm (TermElabM Expr) (mkApp (Lean.mkConst ``TermElabM) (Lean.mkConst ``Expr))
|
||||
(← `(do $cmds)))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_term_elab Lean.Parser.Term.haveI] def elabHaveI : TermElab := fun stx expectedType? => do
|
||||
match stx with
|
||||
| `(haveI $x:ident $bs* : $ty := $val; $body) =>
|
||||
withExpectedType expectedType? fun expectedType => do
|
||||
let (ty, val) ← elabBinders bs fun bs => do
|
||||
let ty ← elabType ty
|
||||
let val ← elabTermEnsuringType val ty
|
||||
pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val)
|
||||
withLocalDeclD x.getId ty fun x => do
|
||||
return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val]
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_term_elab Lean.Parser.Term.letI] def elabLetI : TermElab := fun stx expectedType? => do
|
||||
match stx with
|
||||
| `(letI $x:ident $bs* : $ty := $val; $body) =>
|
||||
withExpectedType expectedType? fun expectedType => do
|
||||
let (ty, val) ← elabBinders bs fun bs => do
|
||||
let ty ← elabType ty
|
||||
let val ← elabTermEnsuringType val ty
|
||||
pure (← mkForallFVars bs ty, ← mkLambdaFVars bs val)
|
||||
withLetDecl x.getId ty val fun x => do
|
||||
return (← (← elabTerm body expectedType).abstractM #[x]).instantiate #[val]
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Term
|
||||
|
||||
@@ -11,6 +11,12 @@ open Lean.Syntax
|
||||
open Lean.Parser.Term hiding macroArg
|
||||
open Lean.Parser.Command
|
||||
|
||||
def withExpectedType (expectedType? : Option Expr) (x : Expr → TermElabM Expr) : TermElabM Expr := do
|
||||
Term.tryPostponeIfNoneOrMVar expectedType?
|
||||
let some expectedType ← pure expectedType?
|
||||
| throwError "expected type must be known"
|
||||
x expectedType
|
||||
|
||||
def elabElabRulesAux (doc? : Option (TSyntax ``docComment))
|
||||
(attrs? : Option (TSepArray ``attrInstance ",")) (attrKind : TSyntax ``attrKind)
|
||||
(k : SyntaxNodeKind) (cat? expty? : Option (Ident)) (alts : Array (TSyntax ``matchAlt)) :
|
||||
@@ -48,7 +54,7 @@ def elabElabRulesAux (doc? : Option (TSyntax ``docComment))
|
||||
if catName == `term then
|
||||
`($[$doc?:docComment]? @[$(← mkAttrs `term_elab),*]
|
||||
aux_def elabRules $(mkIdent k) : Lean.Elab.Term.TermElab :=
|
||||
fun stx expectedType? => Lean.Elab.Term.withExpectedType expectedType? fun $expId => match stx with
|
||||
fun stx expectedType? => Lean.Elab.Command.withExpectedType expectedType? fun $expId => match stx with
|
||||
$alts:matchAlt* | _ => no_error_if_unused% throwUnsupportedSyntax)
|
||||
else
|
||||
throwErrorAt expId "syntax category '{catName}' does not support expected type specification"
|
||||
|
||||
@@ -9,7 +9,7 @@ import Lean.Elab.SyntheticMVars
|
||||
namespace Lean.Elab.Term
|
||||
open Meta
|
||||
|
||||
unsafe def evalTerm (α) (type : Expr) (value : Syntax) (safety := DefinitionSafety.safe) : TermElabM α := withoutModifyingEnv do
|
||||
unsafe def evalTerm (α) (type : Expr) (value : Syntax) (safety := DefinitionSafety.safe) : TermElabM α := do
|
||||
let v ← elabTermEnsuringType value type
|
||||
synthesizeSyntheticMVarsNoPostponing
|
||||
let v ← instantiateMVars v
|
||||
|
||||
@@ -756,9 +756,8 @@ private def mkInductiveDecl (vars : Array Expr) (views : Array InductiveView) :
|
||||
for i in [:views.size] do
|
||||
let indFVar := indFVars[i]!
|
||||
Term.addLocalVarInfo views[i]!.declId indFVar
|
||||
let r := rs[i]!
|
||||
let type := r.type |>.abstract r.params |>.instantiateRev params
|
||||
let type ← mkForallFVars params type
|
||||
let r := rs[i]!
|
||||
let type ← mkForallFVars params r.type
|
||||
let ctors ← withExplicitToImplicit params (elabCtors indFVars indFVar params r)
|
||||
indTypesArray := indTypesArray.push { name := r.view.declName, type, ctors }
|
||||
Term.synthesizeSyntheticMVarsNoPostponing
|
||||
|
||||
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Util.HasConstCache
|
||||
import Lean.Meta.CasesOn
|
||||
import Lean.Meta.Match.Match
|
||||
import Lean.Elab.RecAppSyntax
|
||||
import Lean.Elab.PreDefinition.Basic
|
||||
@@ -82,6 +83,20 @@ private partial def toBelow (below : Expr) (numIndParams : Nat) (recArg : Expr)
|
||||
withBelowDict below numIndParams fun C belowDict =>
|
||||
toBelowAux C belowDict recArg below
|
||||
|
||||
/--
|
||||
This method is used after `matcherApp.addArg arg` to check whether the new type of `arg` has been "refined/modified"
|
||||
in at least one alternative.
|
||||
-/
|
||||
def refinedArgType (matcherApp : MatcherApp) (arg : Expr) : MetaM Bool := do
|
||||
let argType ← inferType arg
|
||||
(Array.zip matcherApp.alts matcherApp.altNumParams).anyM fun (alt, numParams) =>
|
||||
lambdaTelescope alt fun xs _ => do
|
||||
if xs.size >= numParams then
|
||||
let refinedArg := xs[numParams - 1]!
|
||||
return !(← isDefEq (← inferType refinedArg) argType)
|
||||
else
|
||||
return false
|
||||
|
||||
private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo) (below : Expr) (e : Expr) : M Expr :=
|
||||
let containsRecFn (e : Expr) : StateRefT (HasConstCache recFnName) M Bool :=
|
||||
modifyGet (·.contains e)
|
||||
@@ -128,7 +143,7 @@ private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo)
|
||||
return mkAppN f fArgs
|
||||
else
|
||||
return mkAppN (← loop below f) (← args.mapM (loop below))
|
||||
match (← matchMatcherApp? (alsoCasesOn := true) e) with
|
||||
match (← matchMatcherApp? e) with
|
||||
| some matcherApp =>
|
||||
if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
|
||||
processApp e
|
||||
@@ -150,7 +165,10 @@ private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo)
|
||||
If this is too annoying in practice, we may replace `ys` with the matching term, but
|
||||
this may generate weird error messages, when it doesn't work. -/
|
||||
trace[Elab.definition.structural] "below before matcherApp.addArg: {below} : {← inferType below}"
|
||||
if let some matcherApp ← matcherApp.addArg? below then
|
||||
let matcherApp ← mapError (matcherApp.addArg below) (fun msg => "failed to add `below` argument to 'matcher' application" ++ indentD msg)
|
||||
if !(← refinedArgType matcherApp below) then
|
||||
processApp e
|
||||
else
|
||||
let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
|
||||
lambdaTelescope alt fun xs altBody => do
|
||||
trace[Elab.definition.structural] "altNumParams: {numParams}, xs: {xs}"
|
||||
@@ -159,8 +177,21 @@ private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo)
|
||||
let belowForAlt := xs[numParams - 1]!
|
||||
mkLambdaFVars xs (← loop belowForAlt altBody)
|
||||
pure { matcherApp with alts := altsNew }.toExpr
|
||||
else
|
||||
processApp e
|
||||
| none =>
|
||||
match (← toCasesOnApp? e) with
|
||||
| some casesOnApp =>
|
||||
if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
|
||||
processApp e
|
||||
else if let some casesOnApp ← casesOnApp.addArg? below (checkIfRefined := true) then
|
||||
let altsNew ← (Array.zip casesOnApp.alts casesOnApp.altNumParams).mapM fun (alt, numParams) =>
|
||||
lambdaTelescope alt fun xs altBody => do
|
||||
unless xs.size >= numParams do
|
||||
throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
|
||||
let belowForAlt := xs[numParams]!
|
||||
mkLambdaFVars xs (← loop belowForAlt altBody)
|
||||
return { casesOnApp with alts := altsNew }.toExpr
|
||||
else
|
||||
processApp e
|
||||
| none => processApp e
|
||||
| e => ensureNoRecFn recFnName e
|
||||
loop below e |>.run' {}
|
||||
|
||||
@@ -57,7 +57,7 @@ where
|
||||
|
||||
def mkEqns (info : EqnInfo) : MetaM (Array Name) :=
|
||||
withOptions (tactic.hygienic.set · false) do
|
||||
let eqnTypes ← withNewMCtxDepth <| lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
|
||||
let eqnTypes ← withNewMCtxDepth <| lambdaTelescope info.value fun xs body => do
|
||||
let us := info.levelParams.map mkLevelParam
|
||||
let target ← mkEq (mkAppN (Lean.mkConst info.declName us) xs) body
|
||||
let goal ← mkFreshExprSyntheticOpaqueMVar target
|
||||
|
||||
@@ -107,7 +107,7 @@ private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
|
||||
def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
|
||||
withOptions (tactic.hygienic.set · false) do
|
||||
let baseName := mkPrivateName (← getEnv) declName
|
||||
let eqnTypes ← withNewMCtxDepth <| lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
|
||||
let eqnTypes ← withNewMCtxDepth <| lambdaTelescope info.value fun xs body => do
|
||||
let us := info.levelParams.map mkLevelParam
|
||||
let target ← mkEq (mkAppN (Lean.mkConst declName us) xs) body
|
||||
let goal ← mkFreshExprSyntheticOpaqueMVar target
|
||||
|
||||
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Util.HasConstCache
|
||||
import Lean.Meta.CasesOn
|
||||
import Lean.Meta.Match.Match
|
||||
import Lean.Meta.Tactic.Simp.Main
|
||||
import Lean.Meta.Tactic.Cleanup
|
||||
@@ -76,16 +77,34 @@ where
|
||||
| Expr.proj n i e => return mkProj n i (← loop F e)
|
||||
| Expr.const .. => if e.isConstOf recFnName then processRec F e else return e
|
||||
| Expr.app .. =>
|
||||
match (← matchMatcherApp? (alsoCasesOn := true) e) with
|
||||
match (← matchMatcherApp? e) with
|
||||
| some matcherApp =>
|
||||
if let some matcherApp ← matcherApp.addArg? F then
|
||||
let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
|
||||
if !(← Structural.refinedArgType matcherApp F) then
|
||||
processApp F e
|
||||
else
|
||||
let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
|
||||
lambdaTelescope alt fun xs altBody => do
|
||||
unless xs.size >= numParams do
|
||||
throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
|
||||
let FAlt := xs[numParams - 1]!
|
||||
mkLambdaFVars xs (← loop FAlt altBody)
|
||||
return { matcherApp with alts := altsNew, discrs := (← matcherApp.discrs.mapM (loop F)) }.toExpr
|
||||
else
|
||||
processApp F e
|
||||
| none =>
|
||||
match (← toCasesOnApp? e) with
|
||||
| some casesOnApp =>
|
||||
if let some casesOnApp ← casesOnApp.addArg? F (checkIfRefined := true) then
|
||||
let altsNew ← (Array.zip casesOnApp.alts casesOnApp.altNumParams).mapM fun (alt, numParams) =>
|
||||
lambdaTelescope alt fun xs altBody => do
|
||||
unless xs.size >= numParams do
|
||||
throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
|
||||
let FAlt := xs[numParams - 1]!
|
||||
throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
|
||||
let FAlt := xs[numParams]!
|
||||
mkLambdaFVars xs (← loop FAlt altBody)
|
||||
return { matcherApp with alts := altsNew, discrs := (← matcherApp.discrs.mapM (loop F)) }.toExpr
|
||||
return { casesOnApp with
|
||||
alts := altsNew
|
||||
remaining := (← casesOnApp.remaining.mapM (loop F)) }.toExpr
|
||||
else
|
||||
processApp F e
|
||||
| none => processApp F e
|
||||
|
||||
@@ -5,6 +5,7 @@ Authors: Joachim Breitner
|
||||
-/
|
||||
|
||||
import Lean.Util.HasConstCache
|
||||
import Lean.Meta.CasesOn
|
||||
import Lean.Meta.Match.Match
|
||||
import Lean.Meta.Tactic.Cleanup
|
||||
import Lean.Meta.Tactic.Refl
|
||||
@@ -175,7 +176,7 @@ where
|
||||
| Expr.proj _n _i e => loop param e
|
||||
| Expr.const .. => if e.isConstOf recFnName then processRec param e
|
||||
| Expr.app .. =>
|
||||
match (← matchMatcherApp? (alsoCasesOn := true) e) with
|
||||
match (← matchMatcherApp? e) with
|
||||
| some matcherApp =>
|
||||
if let some altParams ← matcherApp.refineThrough? param then
|
||||
matcherApp.discrs.forM (loop param)
|
||||
@@ -190,6 +191,23 @@ where
|
||||
matcherApp.remaining.forM (loop param)
|
||||
else
|
||||
processApp param e
|
||||
| none =>
|
||||
match (← toCasesOnApp? e) with
|
||||
| some casesOnApp =>
|
||||
if let some altParams ← casesOnApp.refineThrough? param then
|
||||
loop param casesOnApp.major
|
||||
(Array.zip casesOnApp.alts (Array.zip casesOnApp.altNumParams altParams)).forM
|
||||
fun (alt, altNumParam, altParam) =>
|
||||
lambdaTelescope altParam fun xs altParam => do
|
||||
-- TODO: Use boundedLambdaTelescope
|
||||
unless altNumParam = xs.size do
|
||||
throwError "unexpected `casesOn` application alternative{indentExpr alt}\nat application{indentExpr e}"
|
||||
let altBody := alt.beta xs
|
||||
loop altParam altBody
|
||||
casesOnApp.remaining.forM (loop param)
|
||||
else
|
||||
trace[Elab.definition.wf] "withRecApps: casesOnApp.refineThrough? failed"
|
||||
processApp param e
|
||||
| none => processApp param e
|
||||
| e => do
|
||||
let _ ← ensureNoRecFn recFnName e
|
||||
|
||||
@@ -293,10 +293,8 @@ mutual
|
||||
Try to synthesize a term `val` using the tactic code `tacticCode`, and then assign `mvarId := val`.
|
||||
|
||||
The `tacticCode` syntax comprises the whole `by ...` expression.
|
||||
|
||||
If `report := false`, then `runTactic` will not capture exceptions nor will report unsolved goals. Unsolved goals become exceptions.
|
||||
-/
|
||||
partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) (report := true) : TermElabM Unit := withoutAutoBoundImplicit do
|
||||
partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) : TermElabM Unit := withoutAutoBoundImplicit do
|
||||
let code := tacticCode[1]
|
||||
instantiateMVarDeclMVars mvarId
|
||||
/-
|
||||
@@ -322,12 +320,9 @@ mutual
|
||||
evalTactic code
|
||||
synthesizeSyntheticMVars (mayPostpone := false)
|
||||
unless remainingGoals.isEmpty do
|
||||
if report then
|
||||
reportUnsolvedGoals remainingGoals
|
||||
else
|
||||
throwError "unsolved goals\n{goalsToMessageData remainingGoals}"
|
||||
reportUnsolvedGoals remainingGoals
|
||||
catch ex =>
|
||||
if report && (← read).errToSorry then
|
||||
if (← read).errToSorry then
|
||||
for mvarId in (← getMVars (mkMVar mvarId)) do
|
||||
mvarId.admit
|
||||
logException ex
|
||||
|
||||
@@ -26,6 +26,4 @@ import Lean.Elab.Tactic.Congr
|
||||
import Lean.Elab.Tactic.Guard
|
||||
import Lean.Elab.Tactic.RCases
|
||||
import Lean.Elab.Tactic.Repeat
|
||||
import Lean.Elab.Tactic.Ext
|
||||
import Lean.Elab.Tactic.Change
|
||||
import Lean.Elab.Tactic.FalseOrByContra
|
||||
|
||||
@@ -9,7 +9,6 @@ import Lean.Meta.Tactic.Contradiction
|
||||
import Lean.Meta.Tactic.Refl
|
||||
import Lean.Elab.Binders
|
||||
import Lean.Elab.Open
|
||||
import Lean.Elab.Eval
|
||||
import Lean.Elab.SetOption
|
||||
import Lean.Elab.Tactic.Basic
|
||||
import Lean.Elab.Tactic.ElabTerm
|
||||
@@ -326,8 +325,11 @@ def forEachVar (hs : Array Syntax) (tac : MVarId → FVarId → MetaM MVarId) :
|
||||
@[builtin_tactic Lean.Parser.Tactic.substVars] def evalSubstVars : Tactic := fun _ =>
|
||||
liftMetaTactic fun mvarId => return [← substVars mvarId]
|
||||
|
||||
@[builtin_tactic Lean.Parser.Tactic.substEqs] def evalSubstEqs : Tactic := fun _ =>
|
||||
Elab.Tactic.liftMetaTactic1 (·.substEqs)
|
||||
/--
|
||||
`subst_eq` repeatedly substitutes according to the equality proof hypotheses in the context,
|
||||
replacing the left side of the equality with the right, until no more progress can be made.
|
||||
-/
|
||||
elab "subst_eqs" : tactic => Elab.Tactic.liftMetaTactic1 (·.substEqs)
|
||||
|
||||
/--
|
||||
Searches for a metavariable `g` s.t. `tag` is its exact name.
|
||||
@@ -494,11 +496,4 @@ where
|
||||
liftMetaTactic1 (·.tryClearMany toClear)
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@[builtin_tactic runTac] def evalRunTac : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(tactic| run_tac $e:doSeq) =>
|
||||
← unsafe Term.evalTerm (TacticM Unit) (mkApp (Lean.mkConst ``TacticM) (Lean.mkConst ``Unit))
|
||||
(← `(discard do $e))
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic
|
||||
|
||||
@@ -1,269 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Gabriel Ebner, Mario Carneiro
|
||||
-/
|
||||
import Lean.Elab.Tactic.RCases
|
||||
import Lean.Elab.Tactic.Repeat
|
||||
import Lean.Elab.Tactic.BuiltinTactic
|
||||
import Lean.Elab.Command
|
||||
import Lean.Linter.Util
|
||||
|
||||
namespace Lean.Elab.Tactic.Ext
|
||||
open Meta Term
|
||||
/-- Information about an extensionality theorem, stored in the environment extension. -/
|
||||
structure ExtTheorem where
|
||||
/-- Declaration name of the extensionality theorem. -/
|
||||
declName : Name
|
||||
/-- Priority of the extensionality theorem. -/
|
||||
priority : Nat
|
||||
/--
|
||||
Key in the discrimination tree,
|
||||
for the type in which the extensionality theorem holds.
|
||||
-/
|
||||
keys : Array DiscrTree.Key
|
||||
deriving Inhabited, Repr, BEq, Hashable
|
||||
|
||||
/-- The state of the `ext` extension environment -/
|
||||
structure ExtTheorems where
|
||||
/-- The tree of `ext` extensions. -/
|
||||
tree : DiscrTree ExtTheorem := {}
|
||||
/-- Erased `ext`s via `attribute [-ext]`. -/
|
||||
erased : PHashSet Name := {}
|
||||
deriving Inhabited
|
||||
|
||||
/-- Discrimation tree settings for the `ext` extension. -/
|
||||
def extExt.config : WhnfCoreConfig := {}
|
||||
|
||||
/-- The environment extension to track `@[ext]` theorems. -/
|
||||
builtin_initialize extExtension :
|
||||
SimpleScopedEnvExtension ExtTheorem ExtTheorems ←
|
||||
registerSimpleScopedEnvExtension {
|
||||
addEntry := fun { tree, erased } thm =>
|
||||
{ tree := tree.insertCore thm.keys thm, erased := erased.erase thm.declName }
|
||||
initial := {}
|
||||
}
|
||||
|
||||
/-- Gets the list of `@[ext]` theorems corresponding to the key `ty`,
|
||||
ordered from high priority to low. -/
|
||||
@[inline] def getExtTheorems (ty : Expr) : MetaM (Array ExtTheorem) := do
|
||||
let extTheorems := extExtension.getState (← getEnv)
|
||||
let arr ← extTheorems.tree.getMatch ty extExt.config
|
||||
let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName
|
||||
-- Using insertion sort because it is stable and the list of matches should be mostly sorted.
|
||||
-- Most ext theorems have default priority.
|
||||
return erasedArr.insertionSort (·.priority < ·.priority) |>.reverse
|
||||
|
||||
/--
|
||||
Erases a name marked `ext` by adding it to the state's `erased` field and
|
||||
removing it from the state's list of `Entry`s.
|
||||
|
||||
This is triggered by `attribute [-ext] name`.
|
||||
-/
|
||||
def ExtTheorems.eraseCore (d : ExtTheorems) (declName : Name) : ExtTheorems :=
|
||||
{ d with erased := d.erased.insert declName }
|
||||
|
||||
/--
|
||||
Erases a name marked as a `ext` attribute.
|
||||
Check that it does in fact have the `ext` attribute by making sure it names a `ExtTheorem`
|
||||
found somewhere in the state's tree, and is not erased.
|
||||
-/
|
||||
def ExtTheorems.erase [Monad m] [MonadError m] (d : ExtTheorems) (declName : Name) :
|
||||
m ExtTheorems := do
|
||||
unless d.tree.containsValueP (·.declName == declName) && !d.erased.contains declName do
|
||||
throwError "'{declName}' does not have [ext] attribute"
|
||||
return d.eraseCore declName
|
||||
|
||||
builtin_initialize registerBuiltinAttribute {
|
||||
name := `ext
|
||||
descr := "Marks a theorem as an extensionality theorem"
|
||||
add := fun declName stx kind => do
|
||||
let `(attr| ext $[(flat := $f)]? $(prio)?) := stx
|
||||
| throwError "unexpected @[ext] attribute {stx}"
|
||||
if isStructure (← getEnv) declName then
|
||||
liftCommandElabM <| Elab.Command.elabCommand <|
|
||||
← `(declare_ext_theorems_for $[(flat := $f)]? $(mkCIdentFrom stx declName) $[$prio]?)
|
||||
else MetaM.run' do
|
||||
if let some flat := f then
|
||||
throwErrorAt flat "unexpected 'flat' config on @[ext] theorem"
|
||||
let declTy := (← getConstInfo declName).type
|
||||
let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing declTy
|
||||
let failNotEq := throwError
|
||||
"@[ext] attribute only applies to structures or theorems proving x = y, got {declTy}"
|
||||
let some (ty, lhs, rhs) := declTy.eq? | failNotEq
|
||||
unless lhs.isMVar && rhs.isMVar do failNotEq
|
||||
let keys ← withReducible <| DiscrTree.mkPath ty extExt.config
|
||||
let priority ← liftCommandElabM do Elab.liftMacroM do
|
||||
evalPrio (prio.getD (← `(prio| default)))
|
||||
extExtension.add {declName, keys, priority} kind
|
||||
erase := fun declName => do
|
||||
let s := extExtension.getState (← getEnv)
|
||||
let s ← s.erase declName
|
||||
modifyEnv fun env => extExtension.modifyState env fun _ => s
|
||||
}
|
||||
|
||||
/--
|
||||
Constructs the hypotheses for the structure extensionality theorem that
|
||||
states that two structures are equal if their fields are equal.
|
||||
|
||||
Calls the continuation `k` with the list of parameters to the structure,
|
||||
two structure variables `x` and `y`, and a list of pairs `(field, ty)`
|
||||
where `ty` is `x.field = y.field` or `HEq x.field y.field`.
|
||||
|
||||
If `flat` parses to `true`, any fields inherited from parent structures
|
||||
are treated fields of the given structure type.
|
||||
If it is `false`, then the behind-the-scenes encoding of inherited fields
|
||||
is visible in the extensionality lemma.
|
||||
-/
|
||||
-- TODO: this is probably the wrong place to have this function
|
||||
def withExtHyps (struct : Name) (flat : Term)
|
||||
(k : Array Expr → (x y : Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do
|
||||
let flat ← match flat with
|
||||
| `(true) => pure true
|
||||
| `(false) => pure false
|
||||
| _ => throwErrorAt flat "expected 'true' or 'false'"
|
||||
unless isStructure (← getEnv) struct do throwError "not a structure: {struct}"
|
||||
let structC ← mkConstWithLevelParams struct
|
||||
forallTelescope (← inferType structC) fun params _ => do
|
||||
withNewBinderInfos (params.map (·.fvarId!, BinderInfo.implicit)) do
|
||||
withLocalDeclD `x (mkAppN structC params) fun x => do
|
||||
withLocalDeclD `y (mkAppN structC params) fun y => do
|
||||
let mut hyps := #[]
|
||||
let fields := if flat then
|
||||
getStructureFieldsFlattened (← getEnv) struct (includeSubobjectFields := false)
|
||||
else
|
||||
getStructureFields (← getEnv) struct
|
||||
for field in fields do
|
||||
let x_f ← mkProjection x field
|
||||
let y_f ← mkProjection y field
|
||||
if ← isProof x_f then
|
||||
pure ()
|
||||
else if ← isDefEq (← inferType x_f) (← inferType y_f) then
|
||||
hyps := hyps.push (field, ← mkEq x_f y_f)
|
||||
else
|
||||
hyps := hyps.push (field, ← mkHEq x_f y_f)
|
||||
k params x y hyps
|
||||
|
||||
/--
|
||||
Creates the type of the extensionality theorem for the given structure,
|
||||
elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example.
|
||||
-/
|
||||
@[builtin_term_elab extType] def elabExtType : TermElab := fun stx _ => do
|
||||
match stx with
|
||||
| `(ext_type% $flat:term $struct:ident) => do
|
||||
withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do
|
||||
let ty := hyps.foldr (init := ← mkEq x y) fun (f, h) ty =>
|
||||
mkForall f BinderInfo.default h ty
|
||||
mkForallFVars (params |>.push x |>.push y) ty
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
/--
|
||||
Creates the type of the iff-variant of the extensionality theorem for the given structure,
|
||||
elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example.
|
||||
-/
|
||||
@[builtin_term_elab extIffType] def elabExtIffType : TermElab := fun stx _ => do
|
||||
match stx with
|
||||
| `(ext_iff_type% $flat:term $struct:ident) => do
|
||||
withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) flat fun params x y hyps => do
|
||||
mkForallFVars (params |>.push x |>.push y) <|
|
||||
mkIff (← mkEq x y) <| mkAndN (hyps.map (·.2)).toList
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
/-- Apply a single extensionality theorem to `goal`. -/
|
||||
def applyExtTheoremAt (goal : MVarId) : MetaM (List MVarId) := goal.withContext do
|
||||
let tgt ← goal.getType'
|
||||
unless tgt.isAppOfArity ``Eq 3 do
|
||||
throwError "applyExtTheorem only applies to equations, not{indentExpr tgt}"
|
||||
let ty := tgt.getArg! 0
|
||||
let s ← saveState
|
||||
for lem in ← getExtTheorems ty do
|
||||
try
|
||||
-- Note: We have to do this extra check to ensure that we don't apply e.g.
|
||||
-- funext to a goal `(?a₁ : ?b) = ?a₂` to produce `(?a₁ x : ?b') = ?a₂ x`,
|
||||
-- since this will loop.
|
||||
-- We require that the type of the equality is not changed by the `goal.apply c` line
|
||||
-- TODO: add flag to apply tactic to toggle unification vs. matching
|
||||
withNewMCtxDepth do
|
||||
let c ← mkConstWithFreshMVarLevels lem.declName
|
||||
let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing (← inferType c)
|
||||
guard (← isDefEq tgt declTy)
|
||||
-- We use `newGoals := .all` as this is
|
||||
-- more useful in practice with dependently typed arguments of `@[ext]` theorems.
|
||||
return ← goal.apply (cfg := { newGoals := .all }) (← mkConstWithFreshMVarLevels lem.declName)
|
||||
catch _ => s.restore
|
||||
throwError "no applicable extensionality theorem found for{indentExpr ty}"
|
||||
|
||||
/-- Apply a single extensionality theorem to the current goal. -/
|
||||
@[builtin_tactic applyExtTheorem] def evalApplyExtTheorem : Tactic := fun _ => do
|
||||
liftMetaTactic applyExtTheoremAt
|
||||
|
||||
/--
|
||||
Postprocessor for `withExt` which runs `rintro` with the given patterns when the target is a
|
||||
pi type.
|
||||
-/
|
||||
def tryIntros [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat))
|
||||
(k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do
|
||||
match pats with
|
||||
| [] => k (← (g.intros : TermElabM _)).2 []
|
||||
| p::ps =>
|
||||
if (← (g.withContext g.getType' : TermElabM _)).isForall then
|
||||
let mut n := 0
|
||||
for g in ← RCases.rintro #[p] none g do
|
||||
n := n.max (← tryIntros g ps k)
|
||||
pure (n + 1)
|
||||
else k g pats
|
||||
|
||||
/--
|
||||
Applies a single extensionality theorem, using `pats` to introduce variables in the result.
|
||||
Runs continuation `k` on each subgoal.
|
||||
-/
|
||||
def withExt1 [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat))
|
||||
(k : MVarId → List (TSyntax `rcasesPat) → m Nat) : m Nat := do
|
||||
let mut n := 0
|
||||
for g in ← (applyExtTheoremAt g : TermElabM _) do
|
||||
n := n.max (← tryIntros g pats k)
|
||||
pure n
|
||||
|
||||
/--
|
||||
Applies extensionality theorems recursively, using `pats` to introduce variables in the result.
|
||||
Runs continuation `k` on each subgoal.
|
||||
-/
|
||||
def withExtN [Monad m] [MonadLiftT TermElabM m] [MonadExcept Exception m]
|
||||
(g : MVarId) (pats : List (TSyntax `rcasesPat)) (k : MVarId → List (TSyntax `rcasesPat) → m Nat)
|
||||
(depth := 1000000) (failIfUnchanged := true) : m Nat :=
|
||||
match depth with
|
||||
| 0 => k g pats
|
||||
| depth+1 => do
|
||||
if failIfUnchanged then
|
||||
withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false)
|
||||
else try
|
||||
withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false)
|
||||
catch _ => k g pats
|
||||
|
||||
/--
|
||||
Apply extensionality theorems as much as possible, using `pats` to introduce the variables
|
||||
in extensionality theorems like `funext`. Returns a list of subgoals.
|
||||
|
||||
This is built on top of `withExtN`, running in `TermElabM` to build the list of new subgoals.
|
||||
(And, for each goal, the patterns consumed.)
|
||||
-/
|
||||
def extCore (g : MVarId) (pats : List (TSyntax `rcasesPat))
|
||||
(depth := 1000000) (failIfUnchanged := true) :
|
||||
TermElabM (Nat × Array (MVarId × List (TSyntax `rcasesPat))) := do
|
||||
StateT.run (m := TermElabM) (s := #[])
|
||||
(withExtN g pats (fun g qs => modify (·.push (g, qs)) *> pure 0) depth failIfUnchanged)
|
||||
|
||||
@[builtin_tactic ext] def evalExt : Tactic := fun stx => do
|
||||
match stx with
|
||||
| `(tactic| ext $pats* $[: $n]?) => do
|
||||
let pats := RCases.expandRIntroPats pats
|
||||
let depth := n.map (·.getNat) |>.getD 1000000
|
||||
let (used, gs) ← extCore (← getMainGoal) pats.toList depth
|
||||
if RCases.linter.unusedRCasesPattern.get (← getOptions) then
|
||||
if used < pats.size then
|
||||
Linter.logLint RCases.linter.unusedRCasesPattern (mkNullNode pats[used:].toArray)
|
||||
m!"`ext` did not consume the patterns: {pats[used:]}"
|
||||
replaceMainGoal <| gs.map (·.1) |>.toList
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
end Lean.Elab.Tactic.Ext
|
||||
@@ -1,63 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Scott Morrison
|
||||
-/
|
||||
import Lean.Elab.Tactic.Basic
|
||||
import Lean.Meta.Tactic.Apply
|
||||
import Lean.Meta.Tactic.Intro
|
||||
|
||||
/-!
|
||||
# `false_or_by_contra` tactic
|
||||
|
||||
Changes the goal to `False`, retaining as much information as possible:
|
||||
|
||||
* If the goal is `False`, do nothing.
|
||||
* If the goal is an implication or a function type, introduce the argument and restart.
|
||||
(In particular, if the goal is `x ≠ y`, introduce `x = y`.)
|
||||
* Otherwise, for a propositional goal `P`, replace it with `¬ ¬ P`
|
||||
(attempting to find a `Decidable` instance, but otherwise falling back to working classically)
|
||||
and introduce `¬ P`.
|
||||
* For a non-propositional goal use `False.elim`.
|
||||
-/
|
||||
|
||||
namespace Lean.MVarId
|
||||
|
||||
open Lean Meta Elab Tactic
|
||||
|
||||
@[inherit_doc Lean.Parser.Tactic.falseOrByContra]
|
||||
-- When `useClassical` is `none`, we try to find a `Decidable` instance when replacing `P` with `¬ ¬ P`,
|
||||
-- but fall back to a classical instance. When it is `some true`, we always use the classical instance.
|
||||
-- When it is `some false`, if there is no `Decidable` instance we don't introduce the double negation,
|
||||
-- and fall back to `False.elim`.
|
||||
partial def falseOrByContra (g : MVarId) (useClassical : Option Bool := none) : MetaM MVarId := do
|
||||
let ty ← whnfR (← g.getType)
|
||||
match ty with
|
||||
| .const ``False _ => pure g
|
||||
| .forallE _ _ _ _
|
||||
| .app (.const ``Not _) _ => falseOrByContra (← g.intro1).2
|
||||
| _ =>
|
||||
let gs ← if ← isProp ty then
|
||||
match useClassical with
|
||||
| some true => some <$> g.applyConst ``Classical.byContradiction
|
||||
| some false =>
|
||||
try some <$> g.applyConst ``Decidable.byContradiction
|
||||
catch _ => pure none
|
||||
| none =>
|
||||
try some <$> g.applyConst ``Decidable.byContradiction
|
||||
catch _ => some <$> g.applyConst ``Classical.byContradiction
|
||||
else
|
||||
pure none
|
||||
if let some gs := gs then
|
||||
let [g] := gs | panic! "expected one subgoal"
|
||||
pure (← g.intro1).2
|
||||
else
|
||||
let [g] ← g.applyConst ``False.elim | panic! "expected one sugoal"
|
||||
pure g
|
||||
|
||||
@[builtin_tactic falseOrByContra]
|
||||
def elabFalseOrByContra : Tactic
|
||||
| `(tactic| false_or_by_contra) => do liftMetaTactic1 (falseOrByContra ·)
|
||||
| _ => no_error_if_unused% throwUnsupportedSyntax
|
||||
|
||||
end Lean.MVarId
|
||||
@@ -43,11 +43,9 @@ def tacticToDischarge (tacticCode : Syntax) : TacticM (IO.Ref Term.State × Simp
|
||||
let runTac? : TermElabM (Option Expr) :=
|
||||
try
|
||||
/- We must only save messages and info tree changes. Recall that `simp` uses temporary metavariables (`withNewMCtxDepth`).
|
||||
So, we must not save references to them at `Term.State`.
|
||||
-/
|
||||
So, we must not save references to them at `Term.State`. -/
|
||||
withoutModifyingStateWithInfoAndMessages do
|
||||
Term.withSynthesize (mayPostpone := false) do
|
||||
Term.runTactic (report := false) mvar.mvarId! tacticCode
|
||||
Term.withSynthesize (mayPostpone := false) <| Term.runTactic mvar.mvarId! tacticCode
|
||||
let result ← instantiateMVars mvar
|
||||
if result.hasExprMVar then
|
||||
return none
|
||||
|
||||
@@ -865,12 +865,6 @@ def tryPostponeIfHasMVars (expectedType? : Option Expr) (msg : String) : TermEla
|
||||
throwError "{msg}, expected type contains metavariables{indentD expectedType?}"
|
||||
return expectedType
|
||||
|
||||
def withExpectedType (expectedType? : Option Expr) (x : Expr → TermElabM Expr) : TermElabM Expr := do
|
||||
tryPostponeIfNoneOrMVar expectedType?
|
||||
let some expectedType ← pure expectedType?
|
||||
| throwError "expected type must be known"
|
||||
x expectedType
|
||||
|
||||
/--
|
||||
Save relevant context for term elaboration postponement.
|
||||
-/
|
||||
|
||||
@@ -884,6 +884,182 @@ def isLit : Expr → Bool
|
||||
| lit .. => true
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Return the "body" of a forall expression.
|
||||
Example: let `e` be the representation for `forall (p : Prop) (q : Prop), p ∧ q`, then
|
||||
`getForallBody e` returns ``.app (.app (.const `And []) (.bvar 1)) (.bvar 0)``
|
||||
-/
|
||||
def getForallBody : Expr → Expr
|
||||
| forallE _ _ b .. => getForallBody b
|
||||
| e => e
|
||||
|
||||
def getForallBodyMaxDepth : (maxDepth : Nat) → Expr → Expr
|
||||
| (n+1), forallE _ _ b _ => getForallBodyMaxDepth n b
|
||||
| 0, e => e
|
||||
| _, e => e
|
||||
|
||||
/-- Given a sequence of nested foralls `(a₁ : α₁) → ... → (aₙ : αₙ) → _`,
|
||||
returns the names `[a₁, ... aₙ]`. -/
|
||||
def getForallBinderNames : Expr → List Name
|
||||
| forallE n _ b _ => n :: getForallBinderNames b
|
||||
| _ => []
|
||||
|
||||
/--
|
||||
If the given expression is a sequence of
|
||||
function applications `f a₁ .. aₙ`, return `f`.
|
||||
Otherwise return the input expression.
|
||||
-/
|
||||
def getAppFn : Expr → Expr
|
||||
| app f _ => getAppFn f
|
||||
| e => e
|
||||
|
||||
private def getAppNumArgsAux : Expr → Nat → Nat
|
||||
| app f _, n => getAppNumArgsAux f (n+1)
|
||||
| _, n => n
|
||||
|
||||
/-- Counts the number `n` of arguments for an expression `f a₁ .. aₙ`. -/
|
||||
def getAppNumArgs (e : Expr) : Nat :=
|
||||
getAppNumArgsAux e 0
|
||||
|
||||
/--
|
||||
Like `Lean.Expr.getAppFn` but assumes the application has up to `maxArgs` arguments.
|
||||
If there are any more arguments than this, then they are returned by `getAppFn` as part of the function.
|
||||
|
||||
In particular, if the given expression is a sequence of function applications `f a₁ .. aₙ`,
|
||||
returns `f a₁ .. aₖ` where `k` is minimal such that `n - k ≤ maxArgs`.
|
||||
-/
|
||||
def getBoundedAppFn : (maxArgs : Nat) → Expr → Expr
|
||||
| maxArgs' + 1, .app f _ => getBoundedAppFn maxArgs' f
|
||||
| _, e => e
|
||||
|
||||
private def getAppArgsAux : Expr → Array Expr → Nat → Array Expr
|
||||
| app f a, as, i => getAppArgsAux f (as.set! i a) (i-1)
|
||||
| _, as, _ => as
|
||||
|
||||
/-- Given `f a₁ a₂ ... aₙ`, returns `#[a₁, ..., aₙ]` -/
|
||||
@[inline] def getAppArgs (e : Expr) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := e.getAppNumArgs
|
||||
getAppArgsAux e (mkArray nargs dummy) (nargs-1)
|
||||
|
||||
private def getBoundedAppArgsAux : Expr → Array Expr → Nat → Array Expr
|
||||
| app f a, as, i + 1 => getBoundedAppArgsAux f (as.set! i a) i
|
||||
| _, as, _ => as
|
||||
|
||||
/--
|
||||
Like `Lean.Expr.getAppArgs` but returns up to `maxArgs` arguments.
|
||||
|
||||
In particular, given `f a₁ a₂ ... aₙ`, returns `#[aₖ₊₁, ..., aₙ]`
|
||||
where `k` is minimal such that the size of this array is at most `maxArgs`.
|
||||
-/
|
||||
@[inline] def getBoundedAppArgs (maxArgs : Nat) (e : Expr) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := min maxArgs e.getAppNumArgs
|
||||
getBoundedAppArgsAux e (mkArray nargs dummy) nargs
|
||||
|
||||
private def getAppRevArgsAux : Expr → Array Expr → Array Expr
|
||||
| app f a, as => getAppRevArgsAux f (as.push a)
|
||||
| _, as => as
|
||||
|
||||
/-- Same as `getAppArgs` but reverse the output array. -/
|
||||
@[inline] def getAppRevArgs (e : Expr) : Array Expr :=
|
||||
getAppRevArgsAux e (Array.mkEmpty e.getAppNumArgs)
|
||||
|
||||
@[specialize] def withAppAux (k : Expr → Array Expr → α) : Expr → Array Expr → Nat → α
|
||||
| app f a, as, i => withAppAux k f (as.set! i a) (i-1)
|
||||
| f, as, _ => k f as
|
||||
|
||||
/-- Given `e = f a₁ a₂ ... aₙ`, returns `k f #[a₁, ..., aₙ]`. -/
|
||||
@[inline] def withApp (e : Expr) (k : Expr → Array Expr → α) : α :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := e.getAppNumArgs
|
||||
withAppAux k e (mkArray nargs dummy) (nargs-1)
|
||||
|
||||
/--
|
||||
Given `f a_1 ... a_n`, returns `#[a_1, ..., a_n]`.
|
||||
Note that `f` may be an application.
|
||||
The resulting array has size `n` even if `f.getAppNumArgs < n`.
|
||||
-/
|
||||
@[inline] def getAppArgsN (e : Expr) (n : Nat) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
loop n e (mkArray n dummy)
|
||||
where
|
||||
loop : Nat → Expr → Array Expr → Array Expr
|
||||
| 0, _, as => as
|
||||
| i+1, .app f a, as => loop i f (as.set! i a)
|
||||
| _, _, _ => panic! "too few arguments at"
|
||||
|
||||
/--
|
||||
Given `e` of the form `f a_1 ... a_n`, return `f`.
|
||||
If `n` is greater than the number of arguments, then return `e.getAppFn`.
|
||||
-/
|
||||
def stripArgsN (e : Expr) (n : Nat) : Expr :=
|
||||
match n, e with
|
||||
| 0, _ => e
|
||||
| n+1, .app f _ => stripArgsN f n
|
||||
| _, _ => e
|
||||
|
||||
/--
|
||||
Given `e` of the form `f a_1 ... a_n ... a_m`, return `f a_1 ... a_n`.
|
||||
If `n` is greater than the arity, then return `e`.
|
||||
-/
|
||||
def getAppPrefix (e : Expr) (n : Nat) : Expr :=
|
||||
e.stripArgsN (e.getAppNumArgs - n)
|
||||
|
||||
/-- Given `e = fn a₁ ... aₙ`, runs `f` on `fn` and each of the arguments `aᵢ` and
|
||||
makes a new function application with the results. -/
|
||||
def traverseApp {M} [Monad M]
|
||||
(f : Expr → M Expr) (e : Expr) : M Expr :=
|
||||
e.withApp fun fn args => mkAppN <$> f fn <*> args.mapM f
|
||||
|
||||
@[specialize] private def withAppRevAux (k : Expr → Array Expr → α) : Expr → Array Expr → α
|
||||
| app f a, as => withAppRevAux k f (as.push a)
|
||||
| f, as => k f as
|
||||
|
||||
/-- Same as `withApp` but with arguments reversed. -/
|
||||
@[inline] def withAppRev (e : Expr) (k : Expr → Array Expr → α) : α :=
|
||||
withAppRevAux k e (Array.mkEmpty e.getAppNumArgs)
|
||||
|
||||
def getRevArgD : Expr → Nat → Expr → Expr
|
||||
| app _ a, 0, _ => a
|
||||
| app f _, i+1, v => getRevArgD f i v
|
||||
| _, _, v => v
|
||||
|
||||
def getRevArg! : Expr → Nat → Expr
|
||||
| app _ a, 0 => a
|
||||
| app f _, i+1 => getRevArg! f i
|
||||
| _, _ => panic! "invalid index"
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns the `i`th argument or panics if out of bounds. -/
|
||||
@[inline] def getArg! (e : Expr) (i : Nat) (n := e.getAppNumArgs) : Expr :=
|
||||
getRevArg! e (n - i - 1)
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns the `i`th argument or returns `v₀` if out of bounds. -/
|
||||
@[inline] def getArgD (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs) : Expr :=
|
||||
getRevArgD e (n - i - 1) v₀
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns true if `f` is a constant with name `n`. -/
|
||||
def isAppOf (e : Expr) (n : Name) : Bool :=
|
||||
match e.getAppFn with
|
||||
| const c _ => c == n
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Given `f a₁ ... aᵢ`, returns true if `f` is a constant
|
||||
with name `n` and has the correct number of arguments.
|
||||
-/
|
||||
def isAppOfArity : Expr → Name → Nat → Bool
|
||||
| const c _, n, 0 => c == n
|
||||
| app f _, n, a+1 => isAppOfArity f n a
|
||||
| _, _, _ => false
|
||||
|
||||
/-- Similar to `isAppOfArity` but skips `Expr.mdata`. -/
|
||||
def isAppOfArity' : Expr → Name → Nat → Bool
|
||||
| mdata _ b , n, a => isAppOfArity' b n a
|
||||
| const c _, n, 0 => c == n
|
||||
| app f _, n, a+1 => isAppOfArity' f n a
|
||||
| _, _, _ => false
|
||||
|
||||
def appFn! : Expr → Expr
|
||||
| app f _ => f
|
||||
| _ => panic! "application expected"
|
||||
@@ -922,9 +1098,8 @@ def isStringLit : Expr → Bool
|
||||
| lit (Literal.strVal _) => true
|
||||
| _ => false
|
||||
|
||||
def isCharLit : Expr → Bool
|
||||
| app (const c _) a => c == ``Char.ofNat && a.isNatLit
|
||||
| _ => false
|
||||
def isCharLit (e : Expr) : Bool :=
|
||||
e.isAppOfArity ``Char.ofNat 1 && e.appArg!.isNatLit
|
||||
|
||||
def constName! : Expr → Name
|
||||
| const n _ => n
|
||||
@@ -934,10 +1109,6 @@ def constName? : Expr → Option Name
|
||||
| const n _ => some n
|
||||
| _ => none
|
||||
|
||||
/-- If the expression is a constant, return that name. Otherwise return `Name.anonymous`. -/
|
||||
def constName (e : Expr) : Name :=
|
||||
e.constName?.getD Name.anonymous
|
||||
|
||||
def constLevels! : Expr → List Level
|
||||
| const _ ls => ls
|
||||
| _ => panic! "constant expected"
|
||||
@@ -1006,213 +1177,6 @@ def projIdx! : Expr → Nat
|
||||
| proj _ i _ => i
|
||||
| _ => panic! "proj expression expected"
|
||||
|
||||
/--
|
||||
Return the "body" of a forall expression.
|
||||
Example: let `e` be the representation for `forall (p : Prop) (q : Prop), p ∧ q`, then
|
||||
`getForallBody e` returns ``.app (.app (.const `And []) (.bvar 1)) (.bvar 0)``
|
||||
-/
|
||||
def getForallBody : Expr → Expr
|
||||
| forallE _ _ b .. => getForallBody b
|
||||
| e => e
|
||||
|
||||
def getForallBodyMaxDepth : (maxDepth : Nat) → Expr → Expr
|
||||
| (n+1), forallE _ _ b _ => getForallBodyMaxDepth n b
|
||||
| 0, e => e
|
||||
| _, e => e
|
||||
|
||||
/-- Given a sequence of nested foralls `(a₁ : α₁) → ... → (aₙ : αₙ) → _`,
|
||||
returns the names `[a₁, ... aₙ]`. -/
|
||||
def getForallBinderNames : Expr → List Name
|
||||
| forallE n _ b _ => n :: getForallBinderNames b
|
||||
| _ => []
|
||||
|
||||
/--
|
||||
If the given expression is a sequence of
|
||||
function applications `f a₁ .. aₙ`, return `f`.
|
||||
Otherwise return the input expression.
|
||||
-/
|
||||
def getAppFn : Expr → Expr
|
||||
| app f _ => getAppFn f
|
||||
| e => e
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns true if `f` is a constant with name `n`. -/
|
||||
def isAppOf (e : Expr) (n : Name) : Bool :=
|
||||
match e.getAppFn with
|
||||
| const c _ => c == n
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Given `f a₁ ... aᵢ`, returns true if `f` is a constant
|
||||
with name `n` and has the correct number of arguments.
|
||||
-/
|
||||
def isAppOfArity : Expr → Name → Nat → Bool
|
||||
| const c _, n, 0 => c == n
|
||||
| app f _, n, a+1 => isAppOfArity f n a
|
||||
| _, _, _ => false
|
||||
|
||||
/-- Similar to `isAppOfArity` but skips `Expr.mdata`. -/
|
||||
def isAppOfArity' : Expr → Name → Nat → Bool
|
||||
| mdata _ b , n, a => isAppOfArity' b n a
|
||||
| const c _, n, 0 => c == n
|
||||
| app f _, n, a+1 => isAppOfArity' f n a
|
||||
| _, _, _ => false
|
||||
|
||||
/--
|
||||
Checks if an expression is a "natural number numeral in normal form",
|
||||
i.e. of type `Nat`, and explicitly of the form `OfNat.ofNat n`
|
||||
where `n` matches `.lit (.natVal n)` for some literal natural number `n`.
|
||||
and if so returns `n`.
|
||||
-/
|
||||
-- Note that `Expr.lit (.natVal n)` is not considered in normal form!
|
||||
def nat? (e : Expr) : Option Nat := do
|
||||
guard <| e.isAppOfArity ``OfNat.ofNat 3
|
||||
let lit (.natVal n) := e.appFn!.appArg! | none
|
||||
n
|
||||
|
||||
/--
|
||||
Checks if an expression is an "integer numeral in normal form",
|
||||
i.e. of type `Nat` or `Int`, and either a natural number numeral in normal form (as specified by `nat?`),
|
||||
or the negation of a positive natural number numberal in normal form,
|
||||
and if so returns the integer.
|
||||
-/
|
||||
def int? (e : Expr) : Option Int :=
|
||||
if e.isAppOfArity ``Neg.neg 3 then
|
||||
match e.appArg!.nat? with
|
||||
| none => none
|
||||
| some 0 => none
|
||||
| some n => some (-n)
|
||||
else
|
||||
e.nat?
|
||||
|
||||
private def getAppNumArgsAux : Expr → Nat → Nat
|
||||
| app f _, n => getAppNumArgsAux f (n+1)
|
||||
| _, n => n
|
||||
|
||||
/-- Counts the number `n` of arguments for an expression `f a₁ .. aₙ`. -/
|
||||
def getAppNumArgs (e : Expr) : Nat :=
|
||||
getAppNumArgsAux e 0
|
||||
|
||||
/--
|
||||
Like `Lean.Expr.getAppFn` but assumes the application has up to `maxArgs` arguments.
|
||||
If there are any more arguments than this, then they are returned by `getAppFn` as part of the function.
|
||||
|
||||
In particular, if the given expression is a sequence of function applications `f a₁ .. aₙ`,
|
||||
returns `f a₁ .. aₖ` where `k` is minimal such that `n - k ≤ maxArgs`.
|
||||
-/
|
||||
def getBoundedAppFn : (maxArgs : Nat) → Expr → Expr
|
||||
| maxArgs' + 1, .app f _ => getBoundedAppFn maxArgs' f
|
||||
| _, e => e
|
||||
|
||||
private def getAppArgsAux : Expr → Array Expr → Nat → Array Expr
|
||||
| app f a, as, i => getAppArgsAux f (as.set! i a) (i-1)
|
||||
| _, as, _ => as
|
||||
|
||||
/-- Given `f a₁ a₂ ... aₙ`, returns `#[a₁, ..., aₙ]` -/
|
||||
@[inline] def getAppArgs (e : Expr) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := e.getAppNumArgs
|
||||
getAppArgsAux e (mkArray nargs dummy) (nargs-1)
|
||||
|
||||
private def getBoundedAppArgsAux : Expr → Array Expr → Nat → Array Expr
|
||||
| app f a, as, i + 1 => getBoundedAppArgsAux f (as.set! i a) i
|
||||
| _, as, _ => as
|
||||
|
||||
/--
|
||||
Like `Lean.Expr.getAppArgs` but returns up to `maxArgs` arguments.
|
||||
|
||||
In particular, given `f a₁ a₂ ... aₙ`, returns `#[aₖ₊₁, ..., aₙ]`
|
||||
where `k` is minimal such that the size of this array is at most `maxArgs`.
|
||||
-/
|
||||
@[inline] def getBoundedAppArgs (maxArgs : Nat) (e : Expr) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := min maxArgs e.getAppNumArgs
|
||||
getBoundedAppArgsAux e (mkArray nargs dummy) nargs
|
||||
|
||||
private def getAppRevArgsAux : Expr → Array Expr → Array Expr
|
||||
| app f a, as => getAppRevArgsAux f (as.push a)
|
||||
| _, as => as
|
||||
|
||||
/-- Same as `getAppArgs` but reverse the output array. -/
|
||||
@[inline] def getAppRevArgs (e : Expr) : Array Expr :=
|
||||
getAppRevArgsAux e (Array.mkEmpty e.getAppNumArgs)
|
||||
|
||||
@[specialize] def withAppAux (k : Expr → Array Expr → α) : Expr → Array Expr → Nat → α
|
||||
| app f a, as, i => withAppAux k f (as.set! i a) (i-1)
|
||||
| f, as, _ => k f as
|
||||
|
||||
/-- Given `e = f a₁ a₂ ... aₙ`, returns `k f #[a₁, ..., aₙ]`. -/
|
||||
@[inline] def withApp (e : Expr) (k : Expr → Array Expr → α) : α :=
|
||||
let dummy := mkSort levelZero
|
||||
let nargs := e.getAppNumArgs
|
||||
withAppAux k e (mkArray nargs dummy) (nargs-1)
|
||||
|
||||
/-- Return the function (name) and arguments of an application. -/
|
||||
def getAppFnArgs (e : Expr) : Name × Array Expr :=
|
||||
withApp e λ e a => (e.constName, a)
|
||||
|
||||
/--
|
||||
Given `f a_1 ... a_n`, returns `#[a_1, ..., a_n]`.
|
||||
Note that `f` may be an application.
|
||||
The resulting array has size `n` even if `f.getAppNumArgs < n`.
|
||||
-/
|
||||
@[inline] def getAppArgsN (e : Expr) (n : Nat) : Array Expr :=
|
||||
let dummy := mkSort levelZero
|
||||
loop n e (mkArray n dummy)
|
||||
where
|
||||
loop : Nat → Expr → Array Expr → Array Expr
|
||||
| 0, _, as => as
|
||||
| i+1, .app f a, as => loop i f (as.set! i a)
|
||||
| _, _, _ => panic! "too few arguments at"
|
||||
|
||||
/--
|
||||
Given `e` of the form `f a_1 ... a_n`, return `f`.
|
||||
If `n` is greater than the number of arguments, then return `e.getAppFn`.
|
||||
-/
|
||||
def stripArgsN (e : Expr) (n : Nat) : Expr :=
|
||||
match n, e with
|
||||
| 0, _ => e
|
||||
| n+1, .app f _ => stripArgsN f n
|
||||
| _, _ => e
|
||||
|
||||
/--
|
||||
Given `e` of the form `f a_1 ... a_n ... a_m`, return `f a_1 ... a_n`.
|
||||
If `n` is greater than the arity, then return `e`.
|
||||
-/
|
||||
def getAppPrefix (e : Expr) (n : Nat) : Expr :=
|
||||
e.stripArgsN (e.getAppNumArgs - n)
|
||||
|
||||
/-- Given `e = fn a₁ ... aₙ`, runs `f` on `fn` and each of the arguments `aᵢ` and
|
||||
makes a new function application with the results. -/
|
||||
def traverseApp {M} [Monad M]
|
||||
(f : Expr → M Expr) (e : Expr) : M Expr :=
|
||||
e.withApp fun fn args => mkAppN <$> f fn <*> args.mapM f
|
||||
|
||||
@[specialize] private def withAppRevAux (k : Expr → Array Expr → α) : Expr → Array Expr → α
|
||||
| app f a, as => withAppRevAux k f (as.push a)
|
||||
| f, as => k f as
|
||||
|
||||
/-- Same as `withApp` but with arguments reversed. -/
|
||||
@[inline] def withAppRev (e : Expr) (k : Expr → Array Expr → α) : α :=
|
||||
withAppRevAux k e (Array.mkEmpty e.getAppNumArgs)
|
||||
|
||||
def getRevArgD : Expr → Nat → Expr → Expr
|
||||
| app _ a, 0, _ => a
|
||||
| app f _, i+1, v => getRevArgD f i v
|
||||
| _, _, v => v
|
||||
|
||||
def getRevArg! : Expr → Nat → Expr
|
||||
| app _ a, 0 => a
|
||||
| app f _, i+1 => getRevArg! f i
|
||||
| _, _ => panic! "invalid index"
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns the `i`th argument or panics if out of bounds. -/
|
||||
@[inline] def getArg! (e : Expr) (i : Nat) (n := e.getAppNumArgs) : Expr :=
|
||||
getRevArg! e (n - i - 1)
|
||||
|
||||
/-- Given `f a₀ a₁ ... aₙ`, returns the `i`th argument or returns `v₀` if out of bounds. -/
|
||||
@[inline] def getArgD (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs) : Expr :=
|
||||
getRevArgD e (n - i - 1) v₀
|
||||
|
||||
def hasLooseBVars (e : Expr) : Bool :=
|
||||
e.looseBVarRange > 0
|
||||
|
||||
@@ -1595,12 +1559,6 @@ partial def cleanupAnnotations (e : Expr) : Expr :=
|
||||
let e' := e.consumeMData.consumeTypeAnnotations
|
||||
if e' == e then e else cleanupAnnotations e'
|
||||
|
||||
def isFalse (e : Expr) : Bool :=
|
||||
e.cleanupAnnotations.isConstOf ``False
|
||||
|
||||
def isTrue (e : Expr) : Bool :=
|
||||
e.cleanupAnnotations.isConstOf ``True
|
||||
|
||||
/-- Return true iff `e` contains a free variable which satisfies `p`. -/
|
||||
@[inline] def hasAnyFVar (e : Expr) (p : FVarId → Bool) : Bool :=
|
||||
let rec @[specialize] visit (e : Expr) := if !e.hasFVar then false else
|
||||
@@ -1958,14 +1916,7 @@ def mkNot (p : Expr) : Expr := mkApp (mkConst ``Not) p
|
||||
def mkOr (p q : Expr) : Expr := mkApp2 (mkConst ``Or) p q
|
||||
/-- Return `p ∧ q` -/
|
||||
def mkAnd (p q : Expr) : Expr := mkApp2 (mkConst ``And) p q
|
||||
/-- Make an n-ary `And` application. `mkAndN []` returns `True`. -/
|
||||
def mkAndN : List Expr → Expr
|
||||
| [] => mkConst ``True
|
||||
| [p] => p
|
||||
| p :: ps => mkAnd p (mkAndN ps)
|
||||
/-- Return `Classical.em p` -/
|
||||
def mkEM (p : Expr) : Expr := mkApp (mkConst ``Classical.em) p
|
||||
/-- Return `p ↔ q` -/
|
||||
def mkIff (p q : Expr) : Expr := mkApp2 (mkConst ``Iff) p q
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -64,7 +64,8 @@ inductive MessageData where
|
||||
/-- Tagged sections. `Name` should be viewed as a "kind", and is used by `MessageData` inspector functions.
|
||||
Example: an inspector that tries to find "definitional equality failures" may look for the tag "DefEqFailure". -/
|
||||
| tagged : Name → MessageData → MessageData
|
||||
| trace (cls : Name) (msg : MessageData) (children : Array MessageData) (collapsed : Bool)
|
||||
| trace (cls : Name) (msg : MessageData) (children : Array MessageData)
|
||||
(collapsed : Bool := false)
|
||||
deriving Inhabited
|
||||
|
||||
namespace MessageData
|
||||
|
||||
@@ -39,6 +39,7 @@ import Lean.Meta.Structure
|
||||
import Lean.Meta.Constructions
|
||||
import Lean.Meta.CongrTheorems
|
||||
import Lean.Meta.Eqns
|
||||
import Lean.Meta.CasesOn
|
||||
import Lean.Meta.ExprLens
|
||||
import Lean.Meta.ExprTraverse
|
||||
import Lean.Meta.Eval
|
||||
|
||||
@@ -1084,21 +1084,19 @@ private def forallBoundedTelescopeImp (type : Expr) (maxFVars? : Option Nat) (k
|
||||
def forallBoundedTelescope (type : Expr) (maxFVars? : Option Nat) (k : Array Expr → Expr → n α) : n α :=
|
||||
map2MetaM (fun k => forallBoundedTelescopeImp type maxFVars? k) k
|
||||
|
||||
private partial def lambdaTelescopeImp (e : Expr) (consumeLet : Bool) (k : Array Expr → Expr → MetaM α) (cleanupAnnotations := false) : MetaM α := do
|
||||
private partial def lambdaTelescopeImp (e : Expr) (consumeLet : Bool) (k : Array Expr → Expr → MetaM α) : MetaM α := do
|
||||
process consumeLet (← getLCtx) #[] 0 e
|
||||
where
|
||||
process (consumeLet : Bool) (lctx : LocalContext) (fvars : Array Expr) (j : Nat) (e : Expr) : MetaM α := do
|
||||
match consumeLet, e with
|
||||
| _, .lam n d b bi =>
|
||||
let d := d.instantiateRevRange j fvars.size fvars
|
||||
let d := if cleanupAnnotations then d.cleanupAnnotations else d
|
||||
let fvarId ← mkFreshFVarId
|
||||
let lctx := lctx.mkLocalDecl fvarId n d bi
|
||||
let fvar := mkFVar fvarId
|
||||
process consumeLet lctx (fvars.push fvar) j b
|
||||
| true, .letE n t v b _ => do
|
||||
let t := t.instantiateRevRange j fvars.size fvars
|
||||
let t := if cleanupAnnotations then t.cleanupAnnotations else t
|
||||
let v := v.instantiateRevRange j fvars.size fvars
|
||||
let fvarId ← mkFreshFVarId
|
||||
let lctx := lctx.mkLetDecl fvarId n t v
|
||||
@@ -1110,23 +1108,16 @@ where
|
||||
withNewLocalInstancesImp fvars j do
|
||||
k fvars e
|
||||
|
||||
/--
|
||||
Similar to `lambdaTelescope` but for lambda and let expressions.
|
||||
|
||||
If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
|
||||
-/
|
||||
def lambdaLetTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
|
||||
map2MetaM (fun k => lambdaTelescopeImp e true k (cleanupAnnotations := cleanupAnnotations)) k
|
||||
/-- Similar to `lambdaTelescope` but for lambda and let expressions. -/
|
||||
def lambdaLetTelescope (e : Expr) (k : Array Expr → Expr → n α) : n α :=
|
||||
map2MetaM (fun k => lambdaTelescopeImp e true k) k
|
||||
|
||||
/--
|
||||
Given `e` of the form `fun ..xs => A`, execute `k xs A`.
|
||||
This combinator will declare local declarations, create free variables for them,
|
||||
execute `k` with updated local context, and make sure the cache is restored after executing `k`.
|
||||
|
||||
If `cleanupAnnotations` is `true`, we apply `Expr.cleanupAnnotations` to each type in the telescope.
|
||||
-/
|
||||
def lambdaTelescope (e : Expr) (k : Array Expr → Expr → n α) (cleanupAnnotations := false) : n α :=
|
||||
map2MetaM (fun k => lambdaTelescopeImp e false k (cleanupAnnotations := cleanupAnnotations)) k
|
||||
execute `k` with updated local context, and make sure the cache is restored after executing `k`. -/
|
||||
def lambdaTelescope (e : Expr) (k : Array Expr → Expr → n α) : n α :=
|
||||
map2MetaM (fun k => lambdaTelescopeImp e false k) k
|
||||
|
||||
/-- Return the parameter names for the given global declaration. -/
|
||||
def getParamNames (declName : Name) : MetaM (Array Name) := do
|
||||
|
||||
178
src/Lean/Meta/CasesOn.lean
Normal file
178
src/Lean/Meta/CasesOn.lean
Normal file
@@ -0,0 +1,178 @@
|
||||
/-
|
||||
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.Meta.KAbstract
|
||||
import Lean.Meta.Check
|
||||
import Lean.Meta.AppBuilder
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
structure CasesOnApp where
|
||||
declName : Name
|
||||
us : List Level
|
||||
params : Array Expr
|
||||
motive : Expr
|
||||
indices : Array Expr
|
||||
major : Expr
|
||||
alts : Array Expr
|
||||
altNumParams : Array Nat
|
||||
remaining : Array Expr
|
||||
/-- `true` if the `casesOn` can only eliminate into `Prop` -/
|
||||
propOnly : Bool
|
||||
|
||||
/-- Return `some c` if `e` is a `casesOn` application. -/
|
||||
def toCasesOnApp? (e : Expr) : MetaM (Option CasesOnApp) := do
|
||||
let f := e.getAppFn
|
||||
let .const declName us := f | return none
|
||||
unless isCasesOnRecursor (← getEnv) declName do return none
|
||||
let indName := declName.getPrefix
|
||||
let .inductInfo info ← getConstInfo indName | return none
|
||||
let args := e.getAppArgs
|
||||
unless args.size >= info.numParams + 1 /- motive -/ + info.numIndices + 1 /- major -/ + info.numCtors do return none
|
||||
let params := args[:info.numParams]
|
||||
let motive := args[info.numParams]!
|
||||
let indices := args[info.numParams + 1 : info.numParams + 1 + info.numIndices]
|
||||
let major := args[info.numParams + 1 + info.numIndices]!
|
||||
let alts := args[info.numParams + 1 + info.numIndices + 1 : info.numParams + 1 + info.numIndices + 1 + info.numCtors]
|
||||
let remaining := args[info.numParams + 1 + info.numIndices + 1 + info.numCtors :]
|
||||
let propOnly := info.levelParams.length == us.length
|
||||
let mut altNumParams := #[]
|
||||
for ctor in info.ctors do
|
||||
let .ctorInfo ctorInfo ← getConstInfo ctor | unreachable!
|
||||
altNumParams := altNumParams.push ctorInfo.numFields
|
||||
return some { declName, us, params, motive, indices, major, alts, remaining, propOnly, altNumParams }
|
||||
|
||||
/-- Convert `c` back to `Expr` -/
|
||||
def CasesOnApp.toExpr (c : CasesOnApp) : Expr :=
|
||||
mkAppN (mkAppN (mkApp (mkAppN (mkApp (mkAppN (mkConst c.declName c.us) c.params) c.motive) c.indices) c.major) c.alts) c.remaining
|
||||
|
||||
/--
|
||||
Given a `casesOn` application `c` of the form
|
||||
```
|
||||
casesOn As (fun is x => motive[is, xs]) is major (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining
|
||||
```
|
||||
and an expression `e : B[is, major]`, construct the term
|
||||
```
|
||||
casesOn As (fun is x => B[is, x] → motive[i, xs]) is major (fun ys_1 (y : B[_, C_1[ys_1]]) => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n (y : B[_, C_n[ys_n]]) => (alt_n : motive (C_n[ys_n]) e remaining
|
||||
```
|
||||
We use `kabstract` to abstract the `is` and `major` from `B[is, major]`.
|
||||
|
||||
This is used in in `Lean.Elab.PreDefinition.WF.Fix` when replacing recursive calls with calls to
|
||||
the argument provided by `fix` to refine the termination argument, which may mention `major`.
|
||||
See there for how to use this function.
|
||||
-/
|
||||
def CasesOnApp.addArg (c : CasesOnApp) (arg : Expr) (checkIfRefined : Bool := false) : MetaM CasesOnApp := do
|
||||
lambdaTelescope c.motive fun motiveArgs motiveBody => do
|
||||
unless motiveArgs.size == c.indices.size + 1 do
|
||||
throwError "failed to add argument to `casesOn` application, motive must be lambda expression with #{c.indices.size + 1} binders"
|
||||
let argType ← inferType arg
|
||||
let discrs := c.indices ++ #[c.major]
|
||||
let mut argTypeAbst := argType
|
||||
for motiveArg in motiveArgs.reverse, discr in discrs.reverse do
|
||||
argTypeAbst := (← kabstract argTypeAbst discr).instantiate1 motiveArg
|
||||
let motiveBody ← mkArrow argTypeAbst motiveBody
|
||||
let us ← if c.propOnly then pure c.us else pure ((← getLevel motiveBody) :: c.us.tail!)
|
||||
let motive ← mkLambdaFVars motiveArgs motiveBody
|
||||
let remaining := #[arg] ++ c.remaining
|
||||
let aux := mkAppN (mkConst c.declName us) c.params
|
||||
let aux := mkApp aux motive
|
||||
let aux := mkAppN aux discrs
|
||||
check aux
|
||||
unless (← isTypeCorrect aux) do
|
||||
throwError "failed to add argument to `casesOn` application, type error when constructing the new motive{indentExpr aux}"
|
||||
let auxType ← inferType aux
|
||||
let alts ← updateAlts argType auxType
|
||||
return { c with us, motive, alts, remaining }
|
||||
where
|
||||
updateAlts (argType : Expr) (auxType : Expr) : MetaM (Array Expr) := do
|
||||
let mut auxType := auxType
|
||||
let mut altsNew := #[]
|
||||
let mut refined := false
|
||||
for alt in c.alts, numParams in c.altNumParams do
|
||||
auxType ← whnfD auxType
|
||||
match auxType with
|
||||
| .forallE _ d b _ =>
|
||||
let (altNew, refinedAt) ← forallBoundedTelescope d (some numParams) fun xs d => do
|
||||
forallBoundedTelescope d (some 1) fun x _ => do
|
||||
let alt := alt.beta xs
|
||||
let alt ← mkLambdaFVars x alt -- x is the new argument we are adding to the alternative
|
||||
if checkIfRefined then
|
||||
return (← mkLambdaFVars xs alt, !(← isDefEq argType (← inferType x[0]!)))
|
||||
else
|
||||
return (← mkLambdaFVars xs alt, true)
|
||||
if refinedAt then
|
||||
refined := true
|
||||
auxType := b.instantiate1 altNew
|
||||
altsNew := altsNew.push altNew
|
||||
| _ => throwError "unexpected type at `casesOnAddArg`"
|
||||
unless refined do
|
||||
throwError "failed to add argument to `casesOn` application, argument type was not refined by `casesOn`"
|
||||
return altsNew
|
||||
|
||||
/-- Similar to `CasesOnApp.addArg`, but returns `none` on failure. -/
|
||||
def CasesOnApp.addArg? (c : CasesOnApp) (arg : Expr) (checkIfRefined : Bool := false) : MetaM (Option CasesOnApp) :=
|
||||
try
|
||||
return some (← c.addArg arg checkIfRefined)
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
/--
|
||||
Given a `casesOn` application `c` of the form
|
||||
```
|
||||
casesOn As (fun is x => motive[is, xs]) is major (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining
|
||||
```
|
||||
and an expression `B[is, major]` (which may not be a type, e.g. `n : Nat`)
|
||||
for every alternative `i`, construct the expression `fun ys_i => B[_, C_i[ys_i]]`
|
||||
|
||||
This is similar to `CasesOnApp.addArg` when you only have an expression to
|
||||
refined, and not a type with a value.
|
||||
|
||||
This is used in in `Lean.Elab.PreDefinition.WF.GuessFix` when constructing the context of recursive
|
||||
calls to refine the functions' paramter, which may mention `major`.
|
||||
See there for how to use this function.
|
||||
-/
|
||||
def CasesOnApp.refineThrough (c : CasesOnApp) (e : Expr) : MetaM (Array Expr) :=
|
||||
lambdaTelescope c.motive fun motiveArgs _motiveBody => do
|
||||
unless motiveArgs.size == c.indices.size + 1 do
|
||||
throwError "failed to transfer argument through `casesOn` application, motive must be lambda expression with #{c.indices.size + 1} binders"
|
||||
let discrs := c.indices ++ #[c.major]
|
||||
let mut eAbst := e
|
||||
for motiveArg in motiveArgs.reverse, discr in discrs.reverse do
|
||||
eAbst ← kabstract eAbst discr
|
||||
eAbst := eAbst.instantiate1 motiveArg
|
||||
-- Let's create something that’s a `Sort` and mentions `e`
|
||||
-- (recall that `e` itself possibly isn't a type),
|
||||
-- by writing `e = e`, so that we can use it as a motive
|
||||
let eEq ← mkEq eAbst eAbst
|
||||
let motive ← mkLambdaFVars motiveArgs eEq
|
||||
let us := if c.propOnly then c.us else levelZero :: c.us.tail!
|
||||
-- Now instantiate the casesOn wth this synthetic motive
|
||||
let aux := mkAppN (mkConst c.declName us) c.params
|
||||
let aux := mkApp aux motive
|
||||
let aux := mkAppN aux discrs
|
||||
check aux
|
||||
let auxType ← inferType aux
|
||||
-- The type of the remaining arguments will mention `e` instantiated for each arg
|
||||
-- so extract them
|
||||
forallTelescope auxType fun altAuxs _ => do
|
||||
let altAuxTys ← altAuxs.mapM (inferType ·)
|
||||
(Array.zip c.altNumParams altAuxTys).mapM fun (altNumParams, altAuxTy) => do
|
||||
forallBoundedTelescope altAuxTy altNumParams fun fvs body => do
|
||||
unless fvs.size = altNumParams do
|
||||
throwError "failed to transfer argument through `casesOn` application, alt type must be telescope with #{altNumParams} arguments"
|
||||
-- extract type from our synthetic equality
|
||||
let body := body.getArg! 2
|
||||
-- and abstract over the parameters of the alternatives, so that we can safely pass the Expr out
|
||||
mkLambdaFVars fvs body
|
||||
|
||||
/-- A non-failing version of `CasesOnApp.refineThrough` -/
|
||||
def CasesOnApp.refineThrough? (c : CasesOnApp) (e : Expr) :
|
||||
MetaM (Option (Array Expr)) :=
|
||||
try
|
||||
return some (← c.refineThrough e)
|
||||
catch _ =>
|
||||
return none
|
||||
|
||||
end Lean.Meta
|
||||
@@ -62,7 +62,7 @@ builtin_initialize eqnsExt : EnvExtension EqnsExtState ←
|
||||
-/
|
||||
private def mkSimpleEqThm (declName : Name) : MetaM (Option Name) := do
|
||||
if let some (.defnInfo info) := (← getEnv).find? declName then
|
||||
lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
|
||||
lambdaTelescope info.value fun xs body => do
|
||||
let lhs := mkAppN (mkConst info.name <| info.levelParams.map mkLevelParam) xs
|
||||
let type ← mkForallFVars xs (← mkEq lhs body)
|
||||
let value ← mkLambdaFVars xs (← mkEqRefl lhs)
|
||||
|
||||
@@ -889,27 +889,22 @@ def withMkMatcherInput (matcherName : Name) (k : MkMatcherInput → MetaM α) :
|
||||
end Match
|
||||
|
||||
/-- Auxiliary function for MatcherApp.addArg -/
|
||||
private partial def updateAlts (unrefinedArgType : Expr) (typeNew : Expr) (altNumParams : Array Nat) (alts : Array Expr) (refined : Bool) (i : Nat) : MetaM (Array Nat × Array Expr) := do
|
||||
private partial def updateAlts (typeNew : Expr) (altNumParams : Array Nat) (alts : Array Expr) (i : Nat) : MetaM (Array Nat × Array Expr) := do
|
||||
if h : i < alts.size then
|
||||
let alt := alts.get ⟨i, h⟩
|
||||
let numParams := altNumParams[i]!
|
||||
let typeNew ← whnfD typeNew
|
||||
match typeNew with
|
||||
| Expr.forallE _ d b _ =>
|
||||
let (alt, refined) ← forallBoundedTelescope d (some numParams) fun xs d => do
|
||||
let alt ← forallBoundedTelescope d (some numParams) fun xs d => do
|
||||
let alt ← try instantiateLambda alt xs catch _ => throwError "unexpected matcher application, insufficient number of parameters in alternative"
|
||||
forallBoundedTelescope d (some 1) fun x _ => do
|
||||
let alt ← mkLambdaFVars x alt -- x is the new argument we are adding to the alternative
|
||||
let refined := if refined then refined else
|
||||
!(← isDefEq unrefinedArgType (← inferType x[0]!))
|
||||
return (← mkLambdaFVars xs alt, refined)
|
||||
updateAlts unrefinedArgType (b.instantiate1 alt) (altNumParams.set! i (numParams+1)) (alts.set ⟨i, h⟩ alt) refined (i+1)
|
||||
mkLambdaFVars xs alt
|
||||
updateAlts (b.instantiate1 alt) (altNumParams.set! i (numParams+1)) (alts.set ⟨i, h⟩ alt) (i+1)
|
||||
| _ => throwError "unexpected type at MatcherApp.addArg"
|
||||
else
|
||||
if refined then
|
||||
return (altNumParams, alts)
|
||||
else
|
||||
throwError "failed to add argument to matcher application, argument type was not refined by `casesOn`"
|
||||
return (altNumParams, alts)
|
||||
|
||||
/-- Given
|
||||
- matcherApp `match_i As (fun xs => motive[xs]) discrs (fun ys_1 => (alt_1 : motive (C_1[ys_1])) ... (fun ys_n => (alt_n : motive (C_n[ys_n]) remaining`, and
|
||||
@@ -953,7 +948,7 @@ def MatcherApp.addArg (matcherApp : MatcherApp) (e : Expr) : MetaM MatcherApp :=
|
||||
unless (← isTypeCorrect aux) do
|
||||
throwError "failed to add argument to matcher application, type error when constructing the new motive"
|
||||
let auxType ← inferType aux
|
||||
let (altNumParams, alts) ← updateAlts eType auxType matcherApp.altNumParams matcherApp.alts false 0
|
||||
let (altNumParams, alts) ← updateAlts auxType matcherApp.altNumParams matcherApp.alts 0
|
||||
return { matcherApp with
|
||||
matcherLevels := matcherLevels,
|
||||
motive := motive,
|
||||
|
||||
@@ -131,7 +131,6 @@ structure MatcherApp where
|
||||
matcherName : Name
|
||||
matcherLevels : Array Level
|
||||
uElimPos? : Option Nat
|
||||
discrInfos : Array Match.DiscrInfo
|
||||
params : Array Expr
|
||||
motive : Expr
|
||||
discrs : Array Expr
|
||||
@@ -139,55 +138,28 @@ structure MatcherApp where
|
||||
alts : Array Expr
|
||||
remaining : Array Expr
|
||||
|
||||
/--
|
||||
Recognizes if `e` is a matcher application, and destructs it into the `MatcherApp` data structure.
|
||||
|
||||
This can optionally also treat `casesOn` recursor applications as a special case
|
||||
of matcher applications.
|
||||
-/
|
||||
def matchMatcherApp? [Monad m] [MonadEnv m] [MonadError m] (e : Expr) (alsoCasesOn := false) :
|
||||
m (Option MatcherApp) := do
|
||||
if let .const declName declLevels := e.getAppFn then
|
||||
if let some info ← getMatcherInfo? declName then
|
||||
def matchMatcherApp? [Monad m] [MonadEnv m] (e : Expr) : m (Option MatcherApp) := do
|
||||
match e.getAppFn with
|
||||
| Expr.const declName declLevels =>
|
||||
match (← getMatcherInfo? declName) with
|
||||
| none => return none
|
||||
| some info =>
|
||||
let args := e.getAppArgs
|
||||
if args.size < info.arity then
|
||||
return none
|
||||
return some {
|
||||
matcherName := declName
|
||||
matcherLevels := declLevels.toArray
|
||||
uElimPos? := info.uElimPos?
|
||||
discrInfos := info.discrInfos
|
||||
params := args.extract 0 info.numParams
|
||||
motive := args[info.getMotivePos]!
|
||||
discrs := args[info.numParams + 1 : info.numParams + 1 + info.numDiscrs]
|
||||
altNumParams := info.altNumParams
|
||||
alts := args[info.numParams + 1 + info.numDiscrs : info.numParams + 1 + info.numDiscrs + info.numAlts]
|
||||
remaining := args[info.numParams + 1 + info.numDiscrs + info.numAlts : args.size]
|
||||
}
|
||||
|
||||
if alsoCasesOn && isCasesOnRecursor (← getEnv) declName then
|
||||
let indName := declName.getPrefix
|
||||
let .inductInfo info ← getConstInfo indName | return none
|
||||
let args := e.getAppArgs
|
||||
unless args.size >= info.numParams + 1 /- motive -/ + info.numIndices + 1 /- major -/ + info.numCtors do return none
|
||||
let params := args[:info.numParams]
|
||||
let motive := args[info.numParams]!
|
||||
let discrs := args[info.numParams + 1 : info.numParams + 1 + info.numIndices + 1]
|
||||
let discrInfos := Array.mkArray (info.numIndices + 1) {}
|
||||
let alts := args[info.numParams + 1 + info.numIndices + 1 : info.numParams + 1 + info.numIndices + 1 + info.numCtors]
|
||||
let remaining := args[info.numParams + 1 + info.numIndices + 1 + info.numCtors :]
|
||||
let uElimPos? := if info.levelParams.length == declLevels.length then none else some 0
|
||||
let mut altNumParams := #[]
|
||||
for ctor in info.ctors do
|
||||
let .ctorInfo ctorInfo ← getConstInfo ctor | unreachable!
|
||||
altNumParams := altNumParams.push ctorInfo.numFields
|
||||
return some {
|
||||
matcherName := declName
|
||||
matcherLevels := declLevels.toArray
|
||||
uElimPos?, discrInfos, params, motive, discrs, alts, remaining, altNumParams
|
||||
}
|
||||
|
||||
return none
|
||||
else
|
||||
return some {
|
||||
matcherName := declName
|
||||
matcherLevels := declLevels.toArray
|
||||
uElimPos? := info.uElimPos?
|
||||
params := args.extract 0 info.numParams
|
||||
motive := args[info.getMotivePos]!
|
||||
discrs := args[info.numParams + 1 : info.numParams + 1 + info.numDiscrs]
|
||||
altNumParams := info.altNumParams
|
||||
alts := args[info.numParams + 1 + info.numDiscrs : info.numParams + 1 + info.numDiscrs + info.numAlts]
|
||||
remaining := args[info.numParams + 1 + info.numDiscrs + info.numAlts : args.size]
|
||||
}
|
||||
| _ => return none
|
||||
|
||||
def MatcherApp.toExpr (matcherApp : MatcherApp) : Expr :=
|
||||
let result := mkAppN (mkConst matcherApp.matcherName matcherApp.matcherLevels.toList) matcherApp.params
|
||||
|
||||
@@ -40,7 +40,7 @@ def matchEqHEq? (e : Expr) : MetaM (Option (Expr × Expr × Expr)) := do
|
||||
return none
|
||||
|
||||
def matchFalse (e : Expr) : MetaM Bool := do
|
||||
testHelper e fun e => return e.isFalse
|
||||
testHelper e fun e => return e.isConstOf ``False
|
||||
|
||||
def matchNot? (e : Expr) : MetaM (Option Expr) :=
|
||||
matchHelper? e fun e => do
|
||||
|
||||
@@ -188,10 +188,6 @@ def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig :=
|
||||
def apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {}) : MetaM (List MVarId) :=
|
||||
mvarId.apply e cfg
|
||||
|
||||
/-- Short-hand for applying a constant to the goal. -/
|
||||
def _root_.Lean.MVarId.applyConst (mvar : MVarId) (c : Name) (cfg : ApplyConfig := {}) : MetaM (List MVarId) := do
|
||||
mvar.apply (← mkConstWithFreshMVarLevels c) cfg
|
||||
|
||||
partial def splitAndCore (mvarId : MVarId) : MetaM (List MVarId) :=
|
||||
mvarId.withContext do
|
||||
mvarId.checkNotAssigned `splitAnd
|
||||
|
||||
@@ -8,5 +8,3 @@ import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Nat
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Fin
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.UInt
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Int
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Char
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.String
|
||||
|
||||
@@ -1,71 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.ToExpr
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.UInt
|
||||
|
||||
namespace Char
|
||||
open Lean Meta Simp
|
||||
|
||||
def fromExpr? (e : Expr) : SimpM (Option Char) := OptionT.run do
|
||||
guard (e.isAppOfArity ``Char.ofNat 1)
|
||||
let value ← Nat.fromExpr? e.appArg!
|
||||
return Char.ofNat value
|
||||
|
||||
@[inline] def reduceUnary [ToExpr α] (declName : Name) (op : Char → α) (arity : Nat := 1) (e : Expr) : SimpM Step := do
|
||||
unless e.isAppOfArity declName arity do return .continue
|
||||
let some c ← fromExpr? e.appArg! | return .continue
|
||||
return .done { expr := toExpr (op c) }
|
||||
|
||||
@[inline] def reduceBinPred (declName : Name) (arity : Nat) (op : Char → Char → Bool) (e : Expr) : SimpM Step := do
|
||||
unless e.isAppOfArity declName arity do return .continue
|
||||
let some n ← fromExpr? e.appFn!.appArg! | return .continue
|
||||
let some m ← fromExpr? e.appArg! | return .continue
|
||||
evalPropStep e (op n m)
|
||||
|
||||
@[inline] def reduceBoolPred (declName : Name) (arity : Nat) (op : Char → Char → Bool) (e : Expr) : SimpM Step := do
|
||||
unless e.isAppOfArity declName arity do return .continue
|
||||
let some n ← fromExpr? e.appFn!.appArg! | return .continue
|
||||
let some m ← fromExpr? e.appArg! | return .continue
|
||||
return .done { expr := toExpr (op n m) }
|
||||
|
||||
builtin_simproc [simp, seval] reduceToLower (Char.toLower _) := reduceUnary ``Char.toLower Char.toLower
|
||||
builtin_simproc [simp, seval] reduceToUpper (Char.toUpper _) := reduceUnary ``Char.toUpper Char.toUpper
|
||||
builtin_simproc [simp, seval] reduceToNat (Char.toNat _) := reduceUnary ``Char.toNat Char.toNat
|
||||
builtin_simproc [simp, seval] reduceIsWhitespace (Char.isWhitespace _) := reduceUnary ``Char.isWhitespace Char.isWhitespace
|
||||
builtin_simproc [simp, seval] reduceIsUpper (Char.isUpper _) := reduceUnary ``Char.isUpper Char.isUpper
|
||||
builtin_simproc [simp, seval] reduceIsLower (Char.isLower _) := reduceUnary ``Char.isLower Char.isLower
|
||||
builtin_simproc [simp, seval] reduceIsAlpha (Char.isAlpha _) := reduceUnary ``Char.isAlpha Char.isAlpha
|
||||
builtin_simproc [simp, seval] reduceIsDigit (Char.isDigit _) := reduceUnary ``Char.isDigit Char.isDigit
|
||||
builtin_simproc [simp, seval] reduceIsAlphaNum (Char.isAlphanum _) := reduceUnary ``Char.isAlphanum Char.isAlphanum
|
||||
builtin_simproc [simp, seval] reduceToString (toString (_ : Char)) := reduceUnary ``toString toString 3
|
||||
builtin_simproc [simp, seval] reduceVal (Char.val _) := fun e => do
|
||||
unless e.isAppOfArity ``Char.val 1 do return .continue
|
||||
let some c ← fromExpr? e.appArg! | return .continue
|
||||
return .done { expr := UInt32.toExprCore c.val }
|
||||
builtin_simproc [simp, seval] reduceEq (( _ : Char) = _) := reduceBinPred ``Eq 3 (. = .)
|
||||
builtin_simproc [simp, seval] reduceNe (( _ : Char) ≠ _) := reduceBinPred ``Ne 3 (. ≠ .)
|
||||
builtin_simproc [simp, seval] reduceBEq (( _ : Char) == _) := reduceBoolPred ``BEq.beq 4 (. == .)
|
||||
builtin_simproc [simp, seval] reduceBNe (( _ : Char) != _) := reduceBoolPred ``bne 4 (. != .)
|
||||
|
||||
/--
|
||||
Return `.done` for Char values. We don't want to unfold in the symbolic evaluator.
|
||||
In regular `simp`, we want to prevent the nested raw literal from being converted into
|
||||
a `OfNat.ofNat` application. TODO: cleanup
|
||||
-/
|
||||
builtin_simproc ↓ [simp, seval] isValue (Char.ofNat _ ) := fun e => do
|
||||
unless (← fromExpr? e).isSome do return .continue
|
||||
return .done { expr := e }
|
||||
|
||||
builtin_simproc [simp, seval] reduceOfNatAux (Char.ofNatAux _ _) := fun e => do
|
||||
unless e.isAppOfArity ``Char.ofNatAux 2 do return .continue
|
||||
let some n ← Nat.fromExpr? e.appFn!.appArg! | return .continue
|
||||
return .done { expr := toExpr (Char.ofNat n) }
|
||||
|
||||
builtin_simproc [simp, seval] reduceDefault ((default : Char)) := fun e => do
|
||||
unless e.isAppOfArity ``default 2 do return .continue
|
||||
return .done { expr := toExpr (default : Char) }
|
||||
|
||||
end Char
|
||||
@@ -11,11 +11,11 @@ builtin_simproc ↓ [simp, seval] reduceIte (ite _ _ _) := fun e => do
|
||||
unless e.isAppOfArity ``ite 5 do return .continue
|
||||
let c := e.getArg! 1
|
||||
let r ← simp c
|
||||
if r.expr.isTrue then
|
||||
if r.expr.isConstOf ``True then
|
||||
let eNew := e.getArg! 3
|
||||
let pr := mkApp (mkAppN (mkConst ``ite_cond_eq_true e.getAppFn.constLevels!) e.getAppArgs) (← r.getProof)
|
||||
return .visit { expr := eNew, proof? := pr }
|
||||
if r.expr.isFalse then
|
||||
if r.expr.isConstOf ``False then
|
||||
let eNew := e.getArg! 4
|
||||
let pr := mkApp (mkAppN (mkConst ``ite_cond_eq_false e.getAppFn.constLevels!) e.getAppArgs) (← r.getProof)
|
||||
return .visit { expr := eNew, proof? := pr }
|
||||
@@ -25,13 +25,13 @@ builtin_simproc ↓ [simp, seval] reduceDite (dite _ _ _) := fun e => do
|
||||
unless e.isAppOfArity ``dite 5 do return .continue
|
||||
let c := e.getArg! 1
|
||||
let r ← simp c
|
||||
if r.expr.isTrue then
|
||||
if r.expr.isConstOf ``True then
|
||||
let pr ← r.getProof
|
||||
let h := mkApp2 (mkConst ``of_eq_true) c pr
|
||||
let eNew := mkApp (e.getArg! 3) h |>.headBeta
|
||||
let prNew := mkApp (mkAppN (mkConst ``dite_cond_eq_true e.getAppFn.constLevels!) e.getAppArgs) pr
|
||||
return .visit { expr := eNew, proof? := prNew }
|
||||
if r.expr.isFalse then
|
||||
if r.expr.isConstOf ``False then
|
||||
let pr ← r.getProof
|
||||
let h := mkApp2 (mkConst ``of_eq_false) c pr
|
||||
let eNew := mkApp (e.getArg! 4) h |>.headBeta
|
||||
|
||||
@@ -42,12 +42,6 @@ def Value.toExpr (v : Value) : Expr :=
|
||||
let some v₂ ← fromExpr? e.appArg! | return .continue
|
||||
evalPropStep e (op v₁.value v₂.value)
|
||||
|
||||
@[inline] def reduceBoolPred (declName : Name) (arity : Nat) (op : Nat → Nat → Bool) (e : Expr) : SimpM Step := do
|
||||
unless e.isAppOfArity declName arity do return .continue
|
||||
let some v₁ ← fromExpr? e.appFn!.appArg! | return .continue
|
||||
let some v₂ ← fromExpr? e.appArg! | return .continue
|
||||
return .done { expr := Lean.toExpr (op v₁.value v₂.value) }
|
||||
|
||||
/-
|
||||
The following code assumes users did not override the `Fin n` instances for the arithmetic operators.
|
||||
If they do, they must disable the following `simprocs`.
|
||||
@@ -63,10 +57,6 @@ builtin_simproc [simp, seval] reduceLT (( _ : Fin _) < _) := reduceBinPred ``L
|
||||
builtin_simproc [simp, seval] reduceLE (( _ : Fin _) ≤ _) := reduceBinPred ``LE.le 4 (. ≤ .)
|
||||
builtin_simproc [simp, seval] reduceGT (( _ : Fin _) > _) := reduceBinPred ``GT.gt 4 (. > .)
|
||||
builtin_simproc [simp, seval] reduceGE (( _ : Fin _) ≥ _) := reduceBinPred ``GE.ge 4 (. ≥ .)
|
||||
builtin_simproc [simp, seval] reduceEq (( _ : Fin _) = _) := reduceBinPred ``Eq 3 (. = .)
|
||||
builtin_simproc [simp, seval] reduceNe (( _ : Fin _) ≠ _) := reduceBinPred ``Ne 3 (. ≠ .)
|
||||
builtin_simproc [simp, seval] reduceBEq (( _ : Fin _) == _) := reduceBoolPred ``BEq.beq 4 (. == .)
|
||||
builtin_simproc [simp, seval] reduceBNe (( _ : Fin _) != _) := reduceBoolPred ``bne 4 (. != .)
|
||||
|
||||
/-- Return `.done` for Fin values. We don't want to unfold in the symbolic evaluator. -/
|
||||
builtin_simproc [seval] isValue ((OfNat.ofNat _ : Fin _)) := fun e => do
|
||||
|
||||
@@ -49,12 +49,6 @@ def toExpr (v : Int) : Expr :=
|
||||
let some v₂ ← fromExpr? e.appArg! | return .continue
|
||||
evalPropStep e (op v₁ v₂)
|
||||
|
||||
@[inline] def reduceBoolPred (declName : Name) (arity : Nat) (op : Int → Int → Bool) (e : Expr) : SimpM Step := do
|
||||
unless e.isAppOfArity declName arity do return .continue
|
||||
let some n ← fromExpr? e.appFn!.appArg! | return .continue
|
||||
let some m ← fromExpr? e.appArg! | return .continue
|
||||
return .done { expr := Lean.toExpr (op n m) }
|
||||
|
||||
/-
|
||||
The following code assumes users did not override the `Int` instances for the arithmetic operators.
|
||||
If they do, they must disable the following `simprocs`.
|
||||
@@ -99,9 +93,5 @@ builtin_simproc [simp, seval] reduceLT (( _ : Int) < _) := reduceBinPred ``LT.
|
||||
builtin_simproc [simp, seval] reduceLE (( _ : Int) ≤ _) := reduceBinPred ``LE.le 4 (. ≤ .)
|
||||
builtin_simproc [simp, seval] reduceGT (( _ : Int) > _) := reduceBinPred ``GT.gt 4 (. > .)
|
||||
builtin_simproc [simp, seval] reduceGE (( _ : Int) ≥ _) := reduceBinPred ``GE.ge 4 (. ≥ .)
|
||||
builtin_simproc [simp, seval] reduceEq (( _ : Int) = _) := reduceBinPred ``Eq 3 (. = .)
|
||||
builtin_simproc [simp, seval] reduceNe (( _ : Int) ≠ _) := reduceBinPred ``Ne 3 (. ≠ .)
|
||||
builtin_simproc [simp, seval] reduceBEq (( _ : Int) == _) := reduceBoolPred ``BEq.beq 4 (. == .)
|
||||
builtin_simproc [simp, seval] reduceBNe (( _ : Int) != _) := reduceBoolPred ``bne 4 (. != .)
|
||||
|
||||
end Int
|
||||
|
||||
@@ -31,12 +31,6 @@ def fromExpr? (e : Expr) : SimpM (Option Nat) := do
|
||||
let some m ← fromExpr? e.appArg! | return .continue
|
||||
evalPropStep e (op n m)
|
||||
|
||||
@[inline] def reduceBoolPred (declName : Name) (arity : Nat) (op : Nat → Nat → Bool) (e : Expr) : SimpM Step := do
|
||||
unless e.isAppOfArity declName arity do return .continue
|
||||
let some n ← fromExpr? e.appFn!.appArg! | return .continue
|
||||
let some m ← fromExpr? e.appArg! | return .continue
|
||||
return .done { expr := toExpr (op n m) }
|
||||
|
||||
builtin_simproc [simp, seval] reduceSucc (Nat.succ _) := reduceUnary ``Nat.succ 1 (· + 1)
|
||||
|
||||
/-
|
||||
@@ -56,10 +50,6 @@ builtin_simproc [simp, seval] reduceLT (( _ : Nat) < _) := reduceBinPred ``LT.
|
||||
builtin_simproc [simp, seval] reduceLE (( _ : Nat) ≤ _) := reduceBinPred ``LE.le 4 (. ≤ .)
|
||||
builtin_simproc [simp, seval] reduceGT (( _ : Nat) > _) := reduceBinPred ``GT.gt 4 (. > .)
|
||||
builtin_simproc [simp, seval] reduceGE (( _ : Nat) ≥ _) := reduceBinPred ``GE.ge 4 (. ≥ .)
|
||||
builtin_simproc [simp, seval] reduceEq (( _ : Nat) = _) := reduceBinPred ``Eq 3 (. = .)
|
||||
builtin_simproc [simp, seval] reduceNe (( _ : Nat) ≠ _) := reduceBinPred ``Ne 3 (. ≠ .)
|
||||
builtin_simproc [simp, seval] reduceBEq (( _ : Nat) == _) := reduceBoolPred ``BEq.beq 4 (. == .)
|
||||
builtin_simproc [simp, seval] reduceBNe (( _ : Nat) != _) := reduceBoolPred ``bne 4 (. != .)
|
||||
|
||||
/-- Return `.done` for Nat values. We don't want to unfold in the symbolic evaluator. -/
|
||||
builtin_simproc [seval] isValue ((OfNat.ofNat _ : Nat)) := fun e => do
|
||||
|
||||
@@ -1,36 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
import Lean.ToExpr
|
||||
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Char
|
||||
|
||||
namespace String
|
||||
open Lean Meta Simp
|
||||
|
||||
def fromExpr? (e : Expr) : SimpM (Option String) := OptionT.run do
|
||||
let .lit (.strVal s) := e | failure
|
||||
return s
|
||||
|
||||
builtin_simproc [simp, seval] reduceAppend ((_ ++ _ : String)) := fun e => do
|
||||
unless e.isAppOfArity ``HAppend.hAppend 6 do return .continue
|
||||
let some a ← fromExpr? e.appFn!.appArg! | return .continue
|
||||
let some b ← fromExpr? e.appArg! | return .continue
|
||||
return .done { expr := toExpr (a ++ b) }
|
||||
|
||||
private partial def reduceListChar (e : Expr) (s : String) : SimpM Step := do
|
||||
trace[Meta.debug] "reduceListChar {e}, {s}"
|
||||
if e.isAppOfArity ``List.nil 1 then
|
||||
return .done { expr := toExpr s }
|
||||
else if e.isAppOfArity ``List.cons 3 then
|
||||
let some c ← Char.fromExpr? e.appFn!.appArg! | return .continue
|
||||
reduceListChar e.appArg! (s.push c)
|
||||
else
|
||||
return .continue
|
||||
|
||||
builtin_simproc [simp, seval] reduceMk (String.mk _) := fun e => do
|
||||
unless e.isAppOfArity ``String.mk 1 do return .continue
|
||||
reduceListChar e.appArg! ""
|
||||
|
||||
end String
|
||||
@@ -9,10 +9,7 @@ open Lean Meta Simp
|
||||
|
||||
macro "declare_uint_simprocs" typeName:ident : command =>
|
||||
let ofNat := typeName.getId ++ `ofNat
|
||||
let ofNatCore := mkIdent (typeName.getId ++ `ofNatCore)
|
||||
let toNat := mkIdent (typeName.getId ++ `toNat)
|
||||
let fromExpr := mkIdent `fromExpr
|
||||
let toExprCore := mkIdent `toExprCore
|
||||
let toExpr := mkIdent `toExpr
|
||||
`(
|
||||
namespace $typeName
|
||||
@@ -29,10 +26,6 @@ def $fromExpr (e : Expr) : OptionT SimpM Value := do
|
||||
let value := $(mkIdent ofNat) value
|
||||
return { value, ofNatFn := e.appFn!.appFn! }
|
||||
|
||||
def $toExprCore (v : $typeName) : Expr :=
|
||||
let vExpr := mkRawNatLit v.val
|
||||
mkApp3 (mkConst ``OfNat.ofNat [levelZero]) (mkConst $(quote typeName.getId)) vExpr (mkApp (mkConst $(quote (typeName.getId ++ `instOfNat))) vExpr)
|
||||
|
||||
def $toExpr (v : Value) : Expr :=
|
||||
let vExpr := mkRawNatLit v.value.val
|
||||
mkApp2 v.ofNatFn vExpr (mkApp (mkConst $(quote (typeName.getId ++ `instOfNat))) vExpr)
|
||||
@@ -50,12 +43,6 @@ def $toExpr (v : Value) : Expr :=
|
||||
let some m ← ($fromExpr e.appArg!) | return .continue
|
||||
evalPropStep e (op n.value m.value)
|
||||
|
||||
@[inline] def reduceBoolPred (declName : Name) (arity : Nat) (op : $typeName → $typeName → Bool) (e : Expr) : SimpM Step := do
|
||||
unless e.isAppOfArity declName arity do return .continue
|
||||
let some n ← ($fromExpr e.appFn!.appArg!) | return .continue
|
||||
let some m ← ($fromExpr e.appArg!) | return .continue
|
||||
return .done { expr := Lean.toExpr (op n.value m.value) }
|
||||
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceAdd):ident ((_ + _ : $typeName)) := reduceBin ``HAdd.hAdd 6 (· + ·)
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceMul):ident ((_ * _ : $typeName)) := reduceBin ``HMul.hMul 6 (· * ·)
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceSub):ident ((_ - _ : $typeName)) := reduceBin ``HSub.hSub 6 (· - ·)
|
||||
@@ -66,23 +53,6 @@ builtin_simproc [simp, seval] $(mkIdent `reduceLT):ident (( _ : $typeName) < _)
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceLE):ident (( _ : $typeName) ≤ _) := reduceBinPred ``LE.le 4 (. ≤ .)
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceGT):ident (( _ : $typeName) > _) := reduceBinPred ``GT.gt 4 (. > .)
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceGE):ident (( _ : $typeName) ≥ _) := reduceBinPred ``GE.ge 4 (. ≥ .)
|
||||
builtin_simproc [simp, seval] reduceEq (( _ : $typeName) = _) := reduceBinPred ``Eq 3 (. = .)
|
||||
builtin_simproc [simp, seval] reduceNe (( _ : $typeName) ≠ _) := reduceBinPred ``Ne 3 (. ≠ .)
|
||||
builtin_simproc [simp, seval] reduceBEq (( _ : $typeName) == _) := reduceBoolPred ``BEq.beq 4 (. == .)
|
||||
builtin_simproc [simp, seval] reduceBNe (( _ : $typeName) != _) := reduceBoolPred ``bne 4 (. != .)
|
||||
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceOfNatCore):ident ($ofNatCore _ _) := fun e => do
|
||||
unless e.isAppOfArity $(quote ofNatCore.getId) 2 do return .continue
|
||||
let some value ← Nat.fromExpr? e.appFn!.appArg! | return .continue
|
||||
let value := $(mkIdent ofNat) value
|
||||
let eNew := $toExprCore value
|
||||
return .done { expr := eNew }
|
||||
|
||||
builtin_simproc [simp, seval] $(mkIdent `reduceToNat):ident ($toNat _) := fun e => do
|
||||
unless e.isAppOfArity $(quote toNat.getId) 1 do return .continue
|
||||
let some v ← ($fromExpr e.appArg!) | return .continue
|
||||
let n := $toNat v.value
|
||||
return .done { expr := mkNatLit n }
|
||||
|
||||
/-- Return `.done` for UInt values. We don't want to unfold in the symbolic evaluator. -/
|
||||
builtin_simproc [seval] isValue ((OfNat.ofNat _ : $typeName)) := fun e => do
|
||||
|
||||
@@ -650,7 +650,7 @@ def simpTargetCore (mvarId : MVarId) (ctx : Simp.Context) (simprocs : SimprocsAr
|
||||
(mayCloseGoal := true) (usedSimps : UsedSimps := {}) : MetaM (Option MVarId × UsedSimps) := do
|
||||
let target ← instantiateMVars (← mvarId.getType)
|
||||
let (r, usedSimps) ← simp target ctx simprocs discharge? usedSimps
|
||||
if mayCloseGoal && r.expr.isTrue then
|
||||
if mayCloseGoal && r.expr.consumeMData.isConstOf ``True then
|
||||
match r.proof? with
|
||||
| some proof => mvarId.assign (← mkOfEqTrue proof)
|
||||
| none => mvarId.assign (mkConst ``True.intro)
|
||||
@@ -673,7 +673,7 @@ def simpTarget (mvarId : MVarId) (ctx : Simp.Context) (simprocs : SimprocsArray
|
||||
|
||||
This method assumes `mvarId` is not assigned, and we are already using `mvarId`s local context. -/
|
||||
def applySimpResultToProp (mvarId : MVarId) (proof : Expr) (prop : Expr) (r : Simp.Result) (mayCloseGoal := true) : MetaM (Option (Expr × Expr)) := do
|
||||
if mayCloseGoal && r.expr.isFalse then
|
||||
if mayCloseGoal && r.expr.consumeMData.isConstOf ``False then
|
||||
match r.proof? with
|
||||
| some eqProof => mvarId.assign (← mkFalseElim (← mvarId.getType) (← mkEqMP eqProof proof))
|
||||
| none => mvarId.assign (← mkFalseElim (← mvarId.getType) proof)
|
||||
@@ -721,7 +721,7 @@ def applySimpResultToLocalDecl (mvarId : MVarId) (fvarId : FVarId) (r : Simp.Res
|
||||
if r.proof?.isNone then
|
||||
-- New result is definitionally equal to input. Thus, we can avoid creating a new variable if there are dependencies
|
||||
let mvarId ← mvarId.replaceLocalDeclDefEq fvarId r.expr
|
||||
if mayCloseGoal && r.expr.isFalse then
|
||||
if mayCloseGoal && r.expr.consumeMData.isConstOf ``False then
|
||||
mvarId.assign (← mkFalseElim (← mvarId.getType) (mkFVar fvarId))
|
||||
return none
|
||||
else
|
||||
@@ -757,7 +757,7 @@ def simpGoal (mvarId : MVarId) (ctx : Simp.Context) (simprocs : SimprocsArray :=
|
||||
| none => return (none, usedSimps)
|
||||
| some (value, type) => toAssert := toAssert.push { userName := localDecl.userName, type := type, value := value }
|
||||
| none =>
|
||||
if r.expr.isFalse then
|
||||
if r.expr.consumeMData.isConstOf ``False then
|
||||
mvarIdNew.assign (← mkFalseElim (← mvarIdNew.getType) (mkFVar fvarId))
|
||||
return (none, usedSimps)
|
||||
-- TODO: if there are no forwards dependencies we may consider using the same approach we used when `r.proof?` is a `some ...`
|
||||
@@ -802,7 +802,7 @@ def dsimpGoal (mvarId : MVarId) (ctx : Simp.Context) (simplifyTarget : Bool := t
|
||||
let type ← instantiateMVars (← fvarId.getType)
|
||||
let (typeNew, usedSimps') ← dsimp type ctx
|
||||
usedSimps := usedSimps'
|
||||
if typeNew.isFalse then
|
||||
if typeNew.consumeMData.isConstOf ``False then
|
||||
mvarIdNew.assign (← mkFalseElim (← mvarIdNew.getType) (mkFVar fvarId))
|
||||
return (none, usedSimps)
|
||||
if typeNew != type then
|
||||
@@ -811,7 +811,7 @@ def dsimpGoal (mvarId : MVarId) (ctx : Simp.Context) (simplifyTarget : Bool := t
|
||||
let target ← mvarIdNew.getType
|
||||
let (targetNew, usedSimps') ← dsimp target ctx usedSimps
|
||||
usedSimps := usedSimps'
|
||||
if targetNew.isTrue then
|
||||
if targetNew.consumeMData.isConstOf ``True then
|
||||
mvarIdNew.assign (mkConst ``True.intro)
|
||||
return (none, usedSimps)
|
||||
if let some (_, lhs, rhs) := targetNew.consumeMData.eq? then
|
||||
|
||||
@@ -182,7 +182,7 @@ def simpCtorEq : Simproc := fun e => withReducibleAndInstances do
|
||||
@[inline] def simpUsingDecide : Simproc := fun e => do
|
||||
unless (← getConfig).decide do
|
||||
return .continue
|
||||
if e.hasFVar || e.hasMVar || e.isTrue || e.isFalse then
|
||||
if e.hasFVar || e.hasMVar || e.consumeMData.isConstOf ``True || e.consumeMData.isConstOf ``False then
|
||||
return .continue
|
||||
try
|
||||
let d ← mkDecide e
|
||||
@@ -288,7 +288,7 @@ Discharge procedure for the ground/symbolic evaluator.
|
||||
def dischargeGround (e : Expr) : SimpM (Option Expr) := do
|
||||
trace[Meta.Tactic.simp.discharge] ">> discharge?: {e}"
|
||||
let r ← simp e
|
||||
if r.expr.isTrue then
|
||||
if r.expr.consumeMData.isConstOf ``True then
|
||||
try
|
||||
return some (← mkOfEqTrue (← r.getProof))
|
||||
catch _ =>
|
||||
@@ -387,10 +387,9 @@ def simpGround : Simproc := fun e => do
|
||||
if ctx.simpTheorems.isErased (.decl declName) then return .continue
|
||||
-- Matcher applications should have been reduced before we get here.
|
||||
if (← isMatcher declName) then return .continue
|
||||
let r ← withTraceNode `Meta.Tactic.simp.ground (fun
|
||||
| .ok r => return m!"seval: {e} => {r.expr}"
|
||||
| .error err => return m!"seval: {e} => {err.toMessageData}") do
|
||||
seval e
|
||||
trace[Meta.Tactic.Simp.ground] "seval: {e}"
|
||||
let r ← seval e
|
||||
trace[Meta.Tactic.Simp.ground] "seval result: {e} => {r.expr}"
|
||||
return .done r
|
||||
|
||||
def preDefault (s : SimprocsArray) : Simproc :=
|
||||
@@ -432,7 +431,7 @@ where
|
||||
go (e : Expr) : Bool :=
|
||||
match e with
|
||||
| .forallE _ d b _ => (d.isEq || d.isHEq || b.hasLooseBVar 0) && go b
|
||||
| _ => e.isFalse
|
||||
| _ => e.consumeMData.isConstOf ``False
|
||||
|
||||
def dischargeUsingAssumption? (e : Expr) : SimpM (Option Expr) := do
|
||||
(← getLCtx).findDeclRevM? fun localDecl => do
|
||||
@@ -472,7 +471,6 @@ where
|
||||
return some mvarId
|
||||
|
||||
def dischargeDefault? (e : Expr) : SimpM (Option Expr) := do
|
||||
let e := e.cleanupAnnotations
|
||||
if isEqnThmHypothesis e then
|
||||
if let some r ← dischargeUsingAssumption? e then
|
||||
return some r
|
||||
@@ -486,7 +484,7 @@ def dischargeDefault? (e : Expr) : SimpM (Option Expr) := do
|
||||
else
|
||||
withTheReader Context (fun ctx => { ctx with dischargeDepth := ctx.dischargeDepth + 1 }) do
|
||||
let r ← simp e
|
||||
if r.expr.isTrue then
|
||||
if r.expr.consumeMData.isConstOf ``True then
|
||||
try
|
||||
return some (← mkOfEqTrue (← r.getProof))
|
||||
catch _ =>
|
||||
|
||||
@@ -130,7 +130,7 @@ def main : M (Option MVarId) := do
|
||||
let mut toClear := #[]
|
||||
let mut modified := false
|
||||
for e in (← get).entries do
|
||||
if e.type.isTrue then
|
||||
if e.type.consumeMData.isConstOf ``True then
|
||||
-- Do not assert `True` hypotheses
|
||||
toClear := toClear.push e.fvarId
|
||||
else if modified || e.type != e.origType then
|
||||
|
||||
@@ -104,16 +104,6 @@ def elabTail := leading_parser atomic (" : " >> ident >> optional (" <= " >> ide
|
||||
optional docComment >> optional Term.«attributes» >> Term.attrKind >>
|
||||
"elab" >> optPrecedence >> optNamedName >> optNamedPrio >> many1 (ppSpace >> elabArg) >> elabTail
|
||||
|
||||
/--
|
||||
Declares a binder predicate. For example:
|
||||
```
|
||||
binder_predicate x " > " y:term => `($x > $y)
|
||||
```
|
||||
-/
|
||||
@[builtin_command_parser] def binderPredicate := leading_parser
|
||||
optional docComment >> optional Term.attributes >> optional Term.attrKind >>
|
||||
"binder_predicate" >> optNamedName >> optNamedPrio >> ppSpace >> ident >> many (ppSpace >> macroArg) >> " => " >> termParser
|
||||
|
||||
end Command
|
||||
|
||||
end Parser
|
||||
|
||||
@@ -569,12 +569,6 @@ def haveDecl := leading_parser (withAnonymousAntiquot := false)
|
||||
haveIdDecl <|> (ppSpace >> letPatDecl) <|> haveEqnsDecl
|
||||
@[builtin_term_parser] def «have» := leading_parser:leadPrec
|
||||
withPosition ("have" >> haveDecl) >> optSemicolon termParser
|
||||
/-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/
|
||||
@[builtin_term_parser] def «haveI» := leading_parser
|
||||
withPosition ("haveI " >> haveDecl) >> optSemicolon termParser
|
||||
/-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/
|
||||
@[builtin_term_parser] def «letI» := leading_parser
|
||||
withPosition ("letI " >> haveDecl) >> optSemicolon termParser
|
||||
|
||||
def «scoped» := leading_parser "scoped "
|
||||
def «local» := leading_parser "local "
|
||||
|
||||
@@ -247,19 +247,6 @@ See also `Lean.PrettyPrinter.Delaborator.Context.depth`.
|
||||
def withIncDepth (act : DelabM α) : DelabM α := fun ctx =>
|
||||
act { ctx with depth := ctx.depth + 1 }
|
||||
|
||||
/--
|
||||
Returns true if `e` is a "shallow" expression.
|
||||
Local variables, constants, and other atomic expressions are always shallow.
|
||||
In general, an expression is considered to be shallow if its depth is at most `threshold`.
|
||||
|
||||
Since the implementation uses `Lean.Expr.approxDepth`, the `threshold` is clamped to `[0, 254]`.
|
||||
-/
|
||||
def isShallowExpression (threshold : Nat) (e : Expr) : Bool :=
|
||||
-- Approximate depth is saturated at 255 for very deep expressions.
|
||||
-- Need to clamp to `[0, 254]` so that not every expression is shallow.
|
||||
let threshold := min 254 threshold
|
||||
e.approxDepth.toNat ≤ threshold
|
||||
|
||||
/--
|
||||
Returns `true` if, at the current depth, we should omit the term and use `⋯` rather than
|
||||
delaborating it. This function can only return `true` if `pp.deepTerms` is set to `false`.
|
||||
@@ -268,59 +255,25 @@ an expression, which prevents terms such as atomic expressions or `OfNat.ofNat`
|
||||
delaborated as `⋯`.
|
||||
-/
|
||||
def shouldOmitExpr (e : Expr) : DelabM Bool := do
|
||||
-- Atomic expressions never get omitted, so we can do an early return here.
|
||||
if e.isAtomic then
|
||||
return false
|
||||
|
||||
if (← getPPOption getPPDeepTerms) then
|
||||
if ← getPPOption getPPDeepTerms then
|
||||
return false
|
||||
|
||||
let depth := (← read).depth
|
||||
let depthThreshold ← getPPOption getPPDeepTermsThreshold
|
||||
let approxDepth := e.approxDepth.toNat
|
||||
let depthExcess := depth - depthThreshold
|
||||
-- This threshold for shallow expressions effectively allows full terms to be pretty printed 25% deeper,
|
||||
-- so long as the subterm actually can be fully pretty printed within this extra 25% depth.
|
||||
let threshold := depthThreshold/4 - depthExcess
|
||||
|
||||
return depthExcess > 0 && !isShallowExpression threshold e
|
||||
let isMaxedOutApproxDepth := approxDepth >= 255
|
||||
let isShallowExpression :=
|
||||
!isMaxedOutApproxDepth && approxDepth <= depthThreshold/4 - depthExcess
|
||||
|
||||
/--
|
||||
Returns `true` if the given expression is a proof and should be omitted.
|
||||
This function only returns `true` if `pp.proofs` is set to `false`.
|
||||
return depthExcess > 0 && !isShallowExpression
|
||||
|
||||
"Shallow" proofs are not omitted.
|
||||
The `pp.proofs.threshold` option controls the depth threshold for what constitutes a shallow proof.
|
||||
See `Lean.PrettyPrinter.Delaborator.isShallowExpression`.
|
||||
-/
|
||||
def shouldOmitProof (e : Expr) : DelabM Bool := do
|
||||
-- Atomic expressions never get omitted, so we can do an early return here.
|
||||
if e.isAtomic then
|
||||
return false
|
||||
|
||||
if (← getPPOption getPPProofs) then
|
||||
return false
|
||||
|
||||
unless (← try Meta.isProof e catch _ => pure false) do
|
||||
return false
|
||||
|
||||
return !isShallowExpression (← getPPOption getPPProofsThreshold) e
|
||||
|
||||
/--
|
||||
Annotates the term with the current expression position and registers `TermInfo`
|
||||
to associate the term to the current expression.
|
||||
-/
|
||||
def annotateTermInfo (stx : Term) : Delab := do
|
||||
let stx ← annotateCurPos stx
|
||||
addTermInfo (← getPos) stx (← getExpr)
|
||||
pure stx
|
||||
|
||||
/--
|
||||
Modifies the delaborator so that it annotates the resulting term with the current expression
|
||||
position and registers `TermInfo` to associate the term to the current expression.
|
||||
-/
|
||||
def withAnnotateTermInfo (d : Delab) : Delab := do
|
||||
let stx ← d
|
||||
annotateTermInfo stx
|
||||
|
||||
/--
|
||||
Delaborates the current expression as `⋯` and attaches `Elab.OmissionInfo`, which influences how the
|
||||
@@ -346,14 +299,13 @@ partial def delab : Delab := do
|
||||
if ← shouldOmitExpr e then
|
||||
return ← omission
|
||||
|
||||
if ← shouldOmitProof e then
|
||||
let pf ← omission
|
||||
-- no need to hide atomic proofs
|
||||
if ← pure !e.isAtomic <&&> pure !(← getPPOption getPPProofs) <&&> (try Meta.isProof e catch _ => pure false) then
|
||||
if ← getPPOption getPPProofsWithType then
|
||||
let stx ← withType delab
|
||||
return ← annotateCurPos (← `(($pf : $stx)))
|
||||
return ← annotateTermInfo (← `((_ : $stx)))
|
||||
else
|
||||
return pf
|
||||
|
||||
return ← annotateTermInfo (← ``(_))
|
||||
let k ← getExprKind
|
||||
let stx ← withIncDepth <| delabFor k <|> (liftM $ show MetaM _ from throwError "don't know how to delaborate '{k}'")
|
||||
if ← getPPOption getPPAnalyzeTypeAscriptions <&&> getPPOption getPPAnalysisNeedsType <&&> pure !e.isMData then
|
||||
|
||||
@@ -331,11 +331,7 @@ With this combinator one can use an arity-2 delaborator to pretty print this as
|
||||
The combinator will fail if fewer than this number of arguments are passed,
|
||||
and if more than this number of arguments are passed the arguments are handled using
|
||||
the standard application delaborator.
|
||||
* `x`: constructs data corresponding to the main application (`f x` in the example).
|
||||
|
||||
In the event of overapplication, the delaborator `x` is wrapped in
|
||||
`Lean.PrettyPrinter.Delaborator.withAnnotateTermInfo` to register `TermInfo` for the resulting term.
|
||||
The effect of this is that the term is hoverable in the Infoview.
|
||||
* `x`: constructs data corresponding to the main application (`f x` in the example)
|
||||
-/
|
||||
def withOverApp (arity : Nat) (x : Delab) : Delab := do
|
||||
let n := (← getExpr).getAppNumArgs
|
||||
@@ -343,7 +339,7 @@ def withOverApp (arity : Nat) (x : Delab) : Delab := do
|
||||
if n == arity then
|
||||
x
|
||||
else
|
||||
delabAppCore (n - arity) (withAnnotateTermInfo x)
|
||||
delabAppCore (n - arity) x
|
||||
|
||||
/-- State for `delabAppMatch` and helpers. -/
|
||||
structure AppMatchState where
|
||||
@@ -681,13 +677,6 @@ def delabLetE : Delab := do
|
||||
`(let $(mkIdent n) : $stxT := $stxV; $stxB)
|
||||
else `(let $(mkIdent n) := $stxV; $stxB)
|
||||
|
||||
@[builtin_delab app.Char.ofNat]
|
||||
def delabChar : Delab := do
|
||||
let e ← getExpr
|
||||
guard <| e.getAppNumArgs == 1
|
||||
let .lit (.natVal n) := e.appArg! | failure
|
||||
return quote (Char.ofNat n)
|
||||
|
||||
@[builtin_delab lit]
|
||||
def delabLit : Delab := do
|
||||
let Expr.lit l ← getExpr | unreachable!
|
||||
@@ -804,50 +793,23 @@ def delabProj : Delab := do
|
||||
let idx := Syntax.mkLit fieldIdxKind (toString (idx + 1));
|
||||
`($(e).$idx:fieldIdx)
|
||||
|
||||
/--
|
||||
Delaborates an application of a projection function, for example `Prod.fst p` as `p.fst`.
|
||||
Collapses intermediate parent projections, so for example rather than `o.toB.toA.x` it produces `o.x`.
|
||||
|
||||
Does not delaborate projection functions from classes, since the instance parameter is implicit;
|
||||
we would rather see `default` than `instInhabitedNat.default`.
|
||||
-/
|
||||
/-- Delaborate a call to a projection function such as `Prod.fst`. -/
|
||||
@[builtin_delab app]
|
||||
partial def delabProjectionApp : Delab := whenPPOption getPPStructureProjections do
|
||||
let (field, arity, _) ← projInfo
|
||||
withOverApp arity do
|
||||
let stx ← withAppArg <| withoutParentProjections delab
|
||||
`($(stx).$(mkIdent field):ident)
|
||||
where
|
||||
/--
|
||||
If this is a projection that could delaborate using dot notation,
|
||||
returns the field name, the arity of the projector, and whether this is a parent projection.
|
||||
Otherwise it fails.
|
||||
-/
|
||||
projInfo : DelabM (Name × Nat × Bool) := do
|
||||
let .app fn _ ← getExpr | failure
|
||||
let .const c@(.str _ field) _ := fn.getAppFn | failure
|
||||
let env ← getEnv
|
||||
let some info := env.getProjectionFnInfo? c | failure
|
||||
-- Don't delaborate for classes since the instance parameter is implicit.
|
||||
guard <| !info.fromClass
|
||||
-- If pp.explicit is true, and the structure has parameters, we should not
|
||||
-- use field notation because we will not be able to see the parameters.
|
||||
guard <| !(← getPPOption getPPExplicit) || info.numParams == 0
|
||||
let arity := info.numParams + 1
|
||||
let some (.ctorInfo cVal) := env.find? info.ctorName | failure
|
||||
let isParentProj := (isSubobjectField? env cVal.induct field).isSome
|
||||
return (field, arity, isParentProj)
|
||||
/--
|
||||
Consumes projections to parent structures.
|
||||
For example, if the current expression is `o.toB.toA`, runs `d` with `o` as the current expression.
|
||||
-/
|
||||
withoutParentProjections {α} (d : DelabM α) : DelabM α :=
|
||||
(do
|
||||
let (_, arity, isParentProj) ← projInfo
|
||||
guard isParentProj
|
||||
guard <| (← getExpr).getAppNumArgs == arity
|
||||
withAppArg <| withoutParentProjections d)
|
||||
<|> d
|
||||
def delabProjectionApp : Delab := whenPPOption getPPStructureProjections $ do
|
||||
let Expr.app fn _ ← getExpr | failure
|
||||
let .const c@(.str _ f) _ ← pure fn.getAppFn | failure
|
||||
let env ← getEnv
|
||||
let some info ← pure $ env.getProjectionFnInfo? c | failure
|
||||
-- can't use with classes since the instance parameter is implicit
|
||||
guard $ !info.fromClass
|
||||
-- If pp.explicit is true, and the structure has parameters, we should not
|
||||
-- use field notation because we will not be able to see the parameters.
|
||||
let expl ← getPPOption getPPExplicit
|
||||
guard $ !expl || info.numParams == 0
|
||||
-- projection function should be fully applied (#struct params + 1 instance parameter)
|
||||
withOverApp (info.numParams + 1) do
|
||||
let appStx ← withAppArg delab
|
||||
`($(appStx).$(mkIdent f):ident)
|
||||
|
||||
/--
|
||||
This delaborator tries to elide functions which are known coercions.
|
||||
|
||||
@@ -118,17 +118,12 @@ register_builtin_option pp.tagAppFns : Bool := {
|
||||
register_builtin_option pp.proofs : Bool := {
|
||||
defValue := false
|
||||
group := "pp"
|
||||
descr := "(pretty printer) display proofs when true, and replace proofs appearing within expressions by `⋯` when false"
|
||||
descr := "(pretty printer) if set to false, replace proofs appearing as an argument to a function with a placeholder"
|
||||
}
|
||||
register_builtin_option pp.proofs.withType : Bool := {
|
||||
defValue := false
|
||||
defValue := true
|
||||
group := "pp"
|
||||
descr := "(pretty printer) when `pp.proofs` is false, adds a type ascription to the omitted proof"
|
||||
}
|
||||
register_builtin_option pp.proofs.threshold : Nat := {
|
||||
defValue := 0
|
||||
group := "pp"
|
||||
descr := "(pretty printer) when `pp.proofs` is false, controls the complexity of proofs at which they begin being replaced with `⋯`"
|
||||
descr := "(pretty printer) when eliding a proof (see `pp.proofs`), show its type instead"
|
||||
}
|
||||
register_builtin_option pp.instances : Bool := {
|
||||
defValue := true
|
||||
@@ -225,15 +220,14 @@ def getPPPrivateNames (o : Options) : Bool := o.get pp.privateNames.name (getPPA
|
||||
def getPPInstantiateMVars (o : Options) : Bool := o.get pp.instantiateMVars.name pp.instantiateMVars.defValue
|
||||
def getPPBeta (o : Options) : Bool := o.get pp.beta.name pp.beta.defValue
|
||||
def getPPSafeShadowing (o : Options) : Bool := o.get pp.safeShadowing.name pp.safeShadowing.defValue
|
||||
def getPPProofs (o : Options) : Bool := o.get pp.proofs.name (pp.proofs.defValue || getPPAll o)
|
||||
def getPPProofs (o : Options) : Bool := o.get pp.proofs.name (getPPAll o)
|
||||
def getPPProofsWithType (o : Options) : Bool := o.get pp.proofs.withType.name pp.proofs.withType.defValue
|
||||
def getPPProofsThreshold (o : Options) : Nat := o.get pp.proofs.threshold.name pp.proofs.threshold.defValue
|
||||
def getPPMotivesPi (o : Options) : Bool := o.get pp.motives.pi.name pp.motives.pi.defValue
|
||||
def getPPMotivesNonConst (o : Options) : Bool := o.get pp.motives.nonConst.name pp.motives.nonConst.defValue
|
||||
def getPPMotivesAll (o : Options) : Bool := o.get pp.motives.all.name pp.motives.all.defValue
|
||||
def getPPInstances (o : Options) : Bool := o.get pp.instances.name pp.instances.defValue
|
||||
def getPPInstanceTypes (o : Options) : Bool := o.get pp.instanceTypes.name pp.instanceTypes.defValue
|
||||
def getPPDeepTerms (o : Options) : Bool := o.get pp.deepTerms.name (pp.deepTerms.defValue || getPPAll o)
|
||||
def getPPDeepTerms (o : Options) : Bool := o.get pp.deepTerms.name pp.deepTerms.defValue
|
||||
def getPPDeepTermsThreshold (o : Options) : Nat := o.get pp.deepTerms.threshold.name pp.deepTerms.threshold.defValue
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -117,7 +117,7 @@ def publishDiagnostics (m : DocumentMeta) (diagnostics : Array Lsp.Diagnostic) (
|
||||
method := "textDocument/publishDiagnostics"
|
||||
param := {
|
||||
uri := m.uri
|
||||
version? := some m.version
|
||||
version? := m.version
|
||||
diagnostics := diagnostics
|
||||
: PublishDiagnosticsParams
|
||||
}
|
||||
|
||||
@@ -28,18 +28,12 @@ instance : ToExpr Nat where
|
||||
toExpr := mkNatLit
|
||||
toTypeExpr := mkConst ``Nat
|
||||
|
||||
instance : ToExpr Int where
|
||||
toTypeExpr := .const ``Int []
|
||||
toExpr i := match i with
|
||||
| .ofNat n => mkApp (.const ``Int.ofNat []) (toExpr n)
|
||||
| .negSucc n => mkApp (.const ``Int.negSucc []) (toExpr n)
|
||||
|
||||
instance : ToExpr Bool where
|
||||
toExpr := fun b => if b then mkConst ``Bool.true else mkConst ``Bool.false
|
||||
toTypeExpr := mkConst ``Bool
|
||||
|
||||
instance : ToExpr Char where
|
||||
toExpr := fun c => mkApp (mkConst ``Char.ofNat) (mkRawNatLit c.toNat)
|
||||
toExpr := fun c => mkApp (mkConst ``Char.ofNat) (toExpr c.toNat)
|
||||
toTypeExpr := mkConst ``Char
|
||||
|
||||
instance : ToExpr String where
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user