Compare commits

..

3 Commits

Author SHA1 Message Date
Scott Morrison
54de6271fd merge master 2024-02-14 12:14:04 +11:00
Leonardo de Moura
eb7951e872 chore: replace tactic builtin 2024-02-13 13:39:34 -08:00
Scott Morrison
e601cdb193 chore: upstream replace tactic 2024-02-13 22:57:16 +11:00
456 changed files with 1067 additions and 6993 deletions

View File

@@ -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

View File

@@ -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
---------

View File

@@ -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 =>

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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

View File

@@ -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}

View File

@@ -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

View File

@@ -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

View File

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.ByCases
import Init.Classical
namespace Array

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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]

View File

@@ -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

View File

@@ -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

View File

@@ -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)]

View File

@@ -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

View File

@@ -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

View File

@@ -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))

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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]

View File

@@ -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

View File

@@ -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 (· < ·)

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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 =>

View File

@@ -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

View File

@@ -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]⟩

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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]

View File

@@ -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

View File

@@ -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

View File

@@ -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₂)

View File

@@ -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

View File

@@ -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.

View File

@@ -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}"

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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"

View File

@@ -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

View File

@@ -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

View File

@@ -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' {}

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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.
-/

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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
View 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 thats 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

View File

@@ -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)

View File

@@ -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,

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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 _ =>

View File

@@ -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

View File

@@ -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

View File

@@ -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 "

View File

@@ -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

View File

@@ -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.

View File

@@ -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

View File

@@ -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
}

View File

@@ -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