Compare commits

..

38 Commits

Author SHA1 Message Date
Kim Morrison
7b7ca92383 chore: upstream List.modify, add lemmas, relate to Array.modify 2024-10-22 11:06:54 +11:00
Tobias Grosser
8d789f7b63 feat: add BitVec.toInt_sub, simplify BitVec.toInt_neg (#5772)
This also requires us to expand the theory of `Int.bmod`.

---------

Co-authored-by: Alex Keizer <alex@keizer.dev>
2024-10-21 22:38:29 +00:00
Leonardo de Moura
82d31a1793 perf: has_univ_mvar, has_univ_mvar, and has_fvar in C++ (#5793)
`instantiate_mvars` is now implemented in C/C++, and makes many calls to
`has_fvar`, `has_mvar`. The new C/C++ implementations are inlined and
avoid unnecessary RC inc/decs.
2024-10-21 16:56:30 +00:00
Joachim Breitner
76164b284b fix: RecursorVal.getInduct to return name of major argument’s type (#5679)
Previously `RecursorVal.getInduct` would return the prefix of the
recursor’s name, which is unlikely the right value for the “derived”
recursors in nested recursion. The code using `RecursorVal.getInduct`
seems to expect the name of the inductive type of major argument here.

If we return that name, this fixes #5661.

This bug becomes more visible now that we have structural mutual
recursion.

Also, to avoid confusion, renames the function to ``getMajorInduct`.
2024-10-21 08:45:18 +00:00
Kim Morrison
51377afd6c feat: simp lemmas for Array.isEqv and beq (#5786)
- [ ] depends on: #5785
2024-10-21 07:37:40 +00:00
Kim Morrison
6f642abe70 feat: Nat.forall_lt_succ and variants (#5785) 2024-10-21 06:51:23 +00:00
Kim Morrison
8151ac79d6 chore: Array cleanup (#5782)
More cleanup of Array API. More to come.
2024-10-21 06:00:37 +00:00
Kim Morrison
4f18c29cb4 chore: make 'while' available earlier (#5784) 2024-10-21 05:56:37 +00:00
Kim Morrison
5d155d8b02 chore: simplify signature of Array.mapIdx (#5749)
This PR simplifies the signature of `Array.mapIdx`, to take a function
`f : Nat \to \a \to \b` rather than a function `f : Fin as.size \to \a
\to \b`.

Lean doesn't actually use the extra generality anywhere (so in fact this
change *simplifies* all the call sites of `Array.mapIdx`, since we no
longer need to throw away the proof).

This change would make the function signature equivalent to
`List.mapIdx`, hence making it easier to write verification lemmas.

We keep the original behaviour as `Array.mapFinIdx`.
2024-10-21 05:48:42 +00:00
Henrik Böving
def81076de feat: bv_decide introduces uninterpreted symbols everywhere (#5781)
Co-authored-by: Tobias Grosser <tobias@grosser.es>
2024-10-20 21:01:21 +00:00
Kyle Miller
46f1335b80 fix: have Lake not create core aliases into Lake namespace (#5688)
This replaces `export Lean (Name NameMap)` and `export System
(SearchPath FilePath)` with the relevant `open` commands. This fixes
docgen output so that it can refer to, for example, `Lean.Name` instead
of `Lake.Name`.

The reason for these `export`s was convenience: by doing `open Lake` you
could get these aliases for free. However, aliases affect pretty
printing, and the Lake aliases took precedence. We don't want to disable
pretty printing re-exported names because this can be a valid pattern
(names could incrementally get re-exported from namespace to parent
namespace).

In the future we might implement a feature to be able to `scoped open`
some names.

Breaking change: Lakefiles that refer to `FilePath` may need to change
this to `System.FilePath` or otherwise add `open System (FilePath)`.

Closes #2524
2024-10-20 18:40:44 +00:00
Kyle Miller
682173d7c0 feat: #version command (#5768)
Prints `Lean.versionString` and target/platform information. Example:
```
Lean 4.12.0, commit 8218940152
Target: arm64-apple-darwin23.5.0 macOS
```
2024-10-18 20:17:52 +00:00
Joachim Breitner
26df545598 fix: structural nested recursion confused when nested type appears first (#5766)
this fixes #5726
2024-10-18 19:41:24 +00:00
Sebastian Ullrich
11ae8bae42 fix: include references in attributes in call hierarchy (#5650)
By ensuring all `declModifiers` are included in `addDeclarationRanges`,
`implementedBy` references etc are included in the call hierarchy
2024-10-18 15:38:32 +00:00
Henrik Böving
a167860e3b chore: @hargoniX Std.Sat codeowner, fix Kim's user name (#5765) 2024-10-18 11:13:28 +00:00
Markus Himmel
cc76496050 chore: check-prelude also for Std (#5764) 2024-10-18 10:53:52 +00:00
Sebastian Ullrich
41b35baea2 fix: duplicate info trees from IO.processCommandsIncrementally (#5763)
As reported in https://github.com/leanprover-community/repl/pull/57
2024-10-18 10:17:30 +00:00
Kim Morrison
a6243f6076 chore: deprecation for Array.data (#5687) 2024-10-18 03:16:38 +00:00
Kyle Miller
fd15d8f9ed feat: Lean.Expr.name? (#5760)
Adds a recognizer for `Name` literal expressions. Handles `Name`
constructors as well as the `Lean.Name.mkStr*` functions.
2024-10-18 02:40:26 +00:00
Kyle Miller
1d66ff8231 fix: app unexpander for sorryAx (#5759)
Fixes a long-standing bug in the the `sorryAx` app unexpander that
prevented it from applying. Now `sorry` pretty prints as `sorry`.
2024-10-18 01:44:52 +00:00
Kim Morrison
51ab162a5a chore: upstream Array.reduceOption (#5758) 2024-10-18 00:41:09 +00:00
Kim Morrison
41797a78c3 chore: deprecate Nat.sum (#5746) 2024-10-18 00:03:36 +00:00
David Thrane Christiansen
d6a7eb3987 feat: add Hashable instance for Char (#5747)
I needed this in downstream code, and it seems to make the most sense to
just contribute it here.
2024-10-17 14:46:10 +00:00
Sebastian Ullrich
fc5e3cc66e fix: do not force snapshot tree too early (#5752)
This turns out to be the issue behind #5736, though really it is yet
another indicator of a general thread pool weakness.
2024-10-17 12:23:34 +00:00
Marc Huisinga
372f344155 fix: some goal state issues (#5677)
This PR resolves the following issues related to goal state display:
1. In a new line after a `case` tactic with a completed proof, the state
of the proof in the `case` would be displayed, not the proof state after
the `case`
1. In the range of `next =>` / `case' ... =>`, the state of the proof in
the corresponding case would not be displayed, whereas this is true for
`case`
1. In the `suffices ... by` tactic, the tactic state of the `by` block
was not displayed after the `by` and before the first tactic

The incorrect goal state after `case` was caused by `evalCase` adding a
`TacticInfo` with the full block proof state for the full range of the
`case` block that the goal state selection has no means of
distinguishing from the `TacticInfo` with the same range that contains
the state after the whole `case` block. Narrowing the range of this
`TacticInfo` to `case ... =>` fixed this issue.

The lack of a case proof state on `next =>` was caused by the `case`
syntax that `next` expands to receiving noncanonical synthetic
`SourceInfo`, which is usually ignored by the language server. Adding a
token antiquotation for `next` fixed this issue.

The lack of a case proof state on `case' ... =>` was caused by
`evalCase'` not adding a `TacticInfo` with the full block state to the
range of `case' ... =>`. Adding this `TacticInfo` fixed this issue.

The tactic state of the block not being displayed after the `by` was
caused by the macro expansion of `suffices` to `have` not transferring
the trailing whitespace of the `by`. Ensuring that this trailing
whitespace information is transferred fixed this issue.

Fixes #2881.
2024-10-17 12:09:54 +00:00
Sebastian Ullrich
f2ac0d03c6 perf: do not lint unused variables defined in tactics by default (#5338)
Should ensure we visit at most as many expr nodes as in the final expr
instead of many possibly overlapping mvar assignments. This is likely
the only way we can ensure acceptable performance in all cases.

---------

Co-authored-by: Kim Morrison <kim@tqft.net>
2024-10-17 09:55:11 +00:00
Joachim Breitner
08d8a0873e doc: remove docstring from implicitDefEqProofs (#5751)
this option was added in fb97275dcb to
prepare for #4595, due to boostrapping issues, but #4595 has not landed
yet. This is be very confusing when people discover this option and try
to use it (as I did).

So let's clearly mark this as not yet implemented on `master`, and add
the
docstring only with #4595.
2024-10-17 09:38:52 +00:00
Sebastian Ullrich
68b0471de9 chore: remove SplitIf.ext cache (#5571)
Incompatible as is with parallelism; let's first check if it has any
impact at all
2024-10-17 09:36:00 +00:00
Kim Morrison
3a34a8e0d1 chore: move Array.mapIdx lemmas to new file (#5748) 2024-10-17 05:54:25 +00:00
Kim Morrison
6fa75e346a chore: upstream List.foldxM_map (#5697) 2024-10-17 04:30:08 +00:00
Eric Wieser
2669fb525f feat: change lake new math to use autoImplicit false (#5715)
The reality is that almost every math project uses this setting already,
even if it is not the default:

*
36b7d4a6d0/lakefile.lean (L7)
*
9ea3a96243/lakefile.lean (L45)
*
97755eaae3/lakefile.toml (L6)
*
fb92dbf97f/lakefile.lean (L7)
*
c8569b3d39/lakefile.toml (L6)
*
c7fae107fd/lakefile.lean (L8)
*
1d891c770d/lakefile.lean (L27)

The fact that MIL uses it is particularly notable, as it means that
newcomers have an unexpected surprise when they want to take on a brand
new project.

---

I don't know whether this is `chore`, `feat`, `fix`, `refactor`, or
something else.
2024-10-17 04:29:48 +00:00
Eric Wieser
8632b79023 doc: point out that OfScientific is called with raw literals (#5725) 2024-10-17 04:29:00 +00:00
Kim Morrison
e8970463d1 fix: change String.dropPrefix? signature (#5745) 2024-10-17 03:51:45 +00:00
Kim Morrison
69e8cd3d8a chore: cleanup in Array/Lemmas (#5744) 2024-10-17 03:36:26 +00:00
Kim Morrison
565ac23b78 chore: move Antisymm to Std.Antisymm (#5740) 2024-10-17 02:26:55 +00:00
Kim Morrison
c1750f4316 chore: upstream basic material on Sum (#5741) 2024-10-17 01:27:41 +00:00
Kim Morrison
092c87a70f chore: upstream ne_of_apply_ne (#5743) 2024-10-17 01:24:01 +00:00
Kim Morrison
b8fc6c593a chore: upstream ne_of_mem_of_not_mem (#5742) 2024-10-17 01:18:23 +00:00
164 changed files with 2359 additions and 950 deletions

View File

@@ -11,7 +11,9 @@ jobs:
with:
# the default is to use a virtual merge commit between the PR and master: just use the PR
ref: ${{ github.event.pull_request.head.sha }}
sparse-checkout: src/Lean
sparse-checkout: |
src/Lean
src/Std
- name: Check Prelude
run: |
failed_files=""
@@ -19,8 +21,8 @@ jobs:
if ! grep -q "^prelude$" "$file"; then
failed_files="$failed_files$file\n"
fi
done < <(find src/Lean -name '*.lean' -print0)
done < <(find src/Lean src/Std -name '*.lean' -print0)
if [ -n "$failed_files" ]; then
echo -e "The following files should use 'prelude':\n$failed_files"
exit 1
fi
fi

View File

@@ -4,14 +4,14 @@
# Listed persons will automatically be asked by GitHub to review a PR touching these paths.
# If multiple names are listed, a review by any of them is considered sufficient by default.
/.github/ @Kha @semorrison
/RELEASES.md @semorrison
/.github/ @Kha @kim-em
/RELEASES.md @kim-em
/src/kernel/ @leodemoura
/src/lake/ @tydeu
/src/Lean/Compiler/ @leodemoura
/src/Lean/Data/Lsp/ @mhuisi
/src/Lean/Elab/Deriving/ @semorrison
/src/Lean/Elab/Tactic/ @semorrison
/src/Lean/Elab/Deriving/ @kim-em
/src/Lean/Elab/Tactic/ @kim-em
/src/Lean/Language/ @Kha
/src/Lean/Meta/Tactic/ @leodemoura
/src/Lean/Parser/ @Kha
@@ -19,7 +19,7 @@
/src/Lean/PrettyPrinter/Delaborator/ @kmill
/src/Lean/Server/ @mhuisi
/src/Lean/Widget/ @Vtec234
/src/Init/Data/ @semorrison
/src/Init/Data/ @kim-em
/src/Init/Data/Array/Lemmas.lean @digama0
/src/Init/Data/List/Lemmas.lean @digama0
/src/Init/Data/List/BasicAux.lean @digama0
@@ -45,3 +45,4 @@
/src/Std/ @TwoFX
/src/Std/Tactic/BVDecide/ @hargoniX
/src/Lean/Elab/Tactic/BVDecide/ @hargoniX
/src/Std/Sat/ @hargoniX

View File

@@ -35,3 +35,4 @@ import Init.Ext
import Init.Omega
import Init.MacroTrace
import Init.Grind
import Init.While

View File

@@ -1937,15 +1937,6 @@ instance : Subsingleton (Squash α) where
apply Quot.sound
trivial
/-! # Relations -/
/--
`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
-/
class Antisymm {α : Sort u} (r : α α Prop) : Prop where
/-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
antisymm {a b : α} : r a b r b a a = b
namespace Lean
/-! # Kernel reduction hints -/
@@ -2121,4 +2112,14 @@ instance : Commutative Or := ⟨fun _ _ => propext or_comm⟩
instance : Commutative And := fun _ _ => propext and_comm
instance : Commutative Iff := fun _ _ => propext iff_comm
/--
`Antisymm (·≤·)` says that `(·≤·)` is antisymmetric, that is, `a ≤ b → b ≤ a → a = b`.
-/
class Antisymm (r : α α Prop) : Prop where
/-- An antisymmetric relation `(·≤·)` satisfies `a ≤ b → b ≤ a → a = b`. -/
antisymm {a b : α} : r a b r b a a = b
@[deprecated Antisymm (since := "2024-10-16"), inherit_doc Antisymm]
abbrev _root_.Antisymm (r : α α Prop) : Prop := Std.Antisymm r
end Std

View File

@@ -16,3 +16,4 @@ import Init.Data.Array.Lemmas
import Init.Data.Array.TakeDrop
import Init.Data.Array.Bootstrap
import Init.Data.Array.GetLit
import Init.Data.Array.MapIdx

View File

@@ -25,6 +25,8 @@ variable {α : Type u}
namespace Array
@[deprecated size (since := "2024-10-13")] abbrev data := @toList
/-! ### Preliminary theorems -/
@[simp] theorem size_set (a : Array α) (i : Fin a.size) (v : α) : (set a i v).size = a.size :=
@@ -78,6 +80,26 @@ theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
end Array
namespace List
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem getElem_toArray {a : List α} {i : Nat} (h : i < a.toArray.size) :
a.toArray[i] = a[i]'(by simpa using h) := rfl
@[simp] theorem getElem?_toArray {a : List α} {i : Nat} : a.toArray[i]? = a[i]? := rfl
@[simp] theorem getElem!_toArray [Inhabited α] {a : List α} {i : Nat} :
a.toArray[i]! = a[i]! := rfl
end List
namespace Array
@[deprecated toList_toArray (since := "2024-09-09")] abbrev data_toArray := @toList_toArray
@[deprecated Array.toList (since := "2024-09-10")] abbrev Array.data := @Array.toList
@@ -396,20 +418,25 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
decreasing_by simp_wf; decreasing_trivial_pre_omega
map 0 (mkEmpty as.size)
/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Fin as.size α m β) : m (Array β) :=
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m]
(as : Array α) (f : Fin as.size α m β) : m (Array β) :=
let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = as.size) (bs : Array β) : m (Array β) := do
match i, inv with
| 0, _ => pure bs
| i+1, inv =>
have : j < as.size := by
have j_lt : j < as.size := by
rw [ inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
apply Nat.le_add_right
let idx : Fin as.size := j, this
have : i + (j + 1) = as.size := by rw [ inv, Nat.add_comm j 1, Nat.add_assoc]
map i (j+1) this (bs.push ( f idx (as.get idx)))
map i (j+1) this (bs.push ( f j, j_lt (as.get j, j_lt)))
map as.size 0 rfl (mkEmpty as.size)
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Nat α m β) : m (Array β) :=
as.mapFinIdxM fun i a => f i a
@[inline]
def findSomeM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : α m (Option β)) : m (Option β) := do
for a in as do
@@ -515,8 +542,13 @@ def foldr {α : Type u} {β : Type v} (f : α → β → β) (init : β) (as : A
def map {α : Type u} {β : Type v} (f : α β) (as : Array α) : Array β :=
Id.run <| as.mapM f
/-- Variant of `mapIdx` which receives the index as a `Fin as.size`. -/
@[inline]
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
Id.run <| as.mapFinIdxM f
@[inline]
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Nat α β) : Array β :=
Id.run <| as.mapIdxM f
/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/
@@ -817,9 +849,15 @@ def split (as : Array α) (p : α → Bool) : Array α × Array α :=
/-! ## Auxiliary functions used in metaprogramming.
We do not intend to provide verification theorems for these functions.
We do not currently intend to provide verification theorems for these functions.
-/
/- ### reduceOption -/
/-- Drop `none`s from a Array, and replace each remaining `some a` with `a`. -/
@[inline] def reduceOption (as : Array (Option α)) : Array α :=
as.filterMap id
/-! ### eraseReps -/
/--

View File

@@ -42,7 +42,7 @@ theorem foldrM_eq_reverse_foldlM_toList.aux [Monad m]
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
| i+1 => rw [ List.take_concat_get _ _ h]; simp [ (aux f arr · i)]
theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.reverse.foldlM (fun x y => f y x) init := by

View File

@@ -6,6 +6,8 @@ Authors: Leonardo de Moura
prelude
import Init.Data.Array.Basic
import Init.Data.BEq
import Init.Data.Nat.Lemmas
import Init.Data.List.Nat.BEq
import Init.ByCases
namespace Array
@@ -26,6 +28,14 @@ theorem rel_of_isEqvAux
subst hj'
exact heqv.left
theorem isEqvAux_of_rel (r : α α Bool) (a b : Array α) (hsz : a.size = b.size) (i : Nat) (hi : i a.size)
(w : j, (hj : j < i) r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz hi)))) : Array.isEqvAux a b hsz r i hi := by
induction i with
| zero => simp [Array.isEqvAux]
| succ i ih =>
simp only [isEqvAux, Bool.and_eq_true]
exact w i (Nat.lt_add_one i), ih _ fun j hj => w j (Nat.lt_add_right 1 hj)
theorem rel_of_isEqv (r : α α Bool) (a b : Array α) :
Array.isEqv a b r h : a.size = b.size, (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h')) := by
simp only [isEqv]
@@ -33,6 +43,29 @@ theorem rel_of_isEqv (r : αα → Bool) (a b : Array α) :
· exact fun h' => h, rel_of_isEqvAux r a b h a.size (Nat.le_refl ..) h'
· intro; contradiction
theorem isEqv_iff_rel (a b : Array α) (r) :
Array.isEqv a b r h : a.size = b.size, (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h')) :=
rel_of_isEqv r a b, fun h, w => by
simp only [isEqv, h, reduceDIte]
exact isEqvAux_of_rel r a b h a.size (by simp [h]) w
theorem isEqv_eq_decide (a b : Array α) (r) :
Array.isEqv a b r =
if h : a.size = b.size then decide ( (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h'))) else false := by
by_cases h : Array.isEqv a b r
· simp only [h, Bool.true_eq]
simp only [isEqv_iff_rel] at h
obtain h, w := h
simp [h, w]
· let h' := h
simp only [Bool.not_eq_true] at h
simp only [h, Bool.false_eq, dite_eq_right_iff, decide_eq_false_iff_not, Classical.not_forall,
Bool.not_eq_true]
simpa [isEqv_iff_rel] using h'
@[simp] theorem isEqv_toList [BEq α] (a b : Array α) : (a.toList.isEqv b.toList r) = (a.isEqv b r) := by
simp [isEqv_eq_decide, List.isEqv_eq_decide]
theorem eq_of_isEqv [DecidableEq α] (a b : Array α) (h : Array.isEqv a b (fun x y => x = y)) : a = b := by
have h, h' := rel_of_isEqv (fun x y => x = y) a b h
exact ext _ _ h (fun i lt _ => by simpa using h' i lt)
@@ -56,4 +89,22 @@ instance [DecidableEq α] : DecidableEq (Array α) :=
| true => isTrue (eq_of_isEqv a b h)
| false => isFalse fun h' => by subst h'; rw [isEqv_self] at h; contradiction
theorem beq_eq_decide [BEq α] (a b : Array α) :
(a == b) = if h : a.size = b.size then
decide ( (i : Nat) (h' : i < a.size), a[i] == b[i]'(h h')) else false := by
simp [BEq.beq, isEqv_eq_decide]
@[simp] theorem beq_toList [BEq α] (a b : Array α) : (a.toList == b.toList) = (a == b) := by
simp [beq_eq_decide, List.beq_eq_decide]
end Array
namespace List
@[simp] theorem isEqv_toArray [BEq α] (a b : List α) : (a.toArray.isEqv b.toArray r) = (a.isEqv b r) := by
simp [isEqv_eq_decide, Array.isEqv_eq_decide]
@[simp] theorem beq_toArray [BEq α] (a b : List α) : (a.toArray == b.toArray) = (a == b) := by
simp [beq_eq_decide, Array.beq_eq_decide]
end List

View File

@@ -41,6 +41,6 @@ where
getLit_eq (as : Array α) (i : Nat) (h₁ : as.size = n) (h₂ : i < n) : as.getLit i h₁ h₂ = getElem as.toList i ((id (α := as.toList.length = n) h₁) h₂) :=
rfl
go (i : Nat) (hi : i as.size) : toListLitAux as n hsz i hi (as.toList.drop i) = as.toList := by
induction i <;> simp [getLit_eq, List.get_drop_eq_drop, toListLitAux, List.drop, *]
induction i <;> simp only [List.drop, toListLitAux, getLit_eq, List.get_drop_eq_drop, *]
end Array

View File

@@ -8,19 +8,17 @@ import Init.Data.Nat.Lemmas
import Init.Data.List.Impl
import Init.Data.List.Monadic
import Init.Data.List.Range
import Init.Data.List.Nat.TakeDrop
import Init.Data.List.Nat.Modify
import Init.Data.Array.Mem
import Init.TacticsExtra
/-!
## Bootstrapping theorems about arrays
This file contains some theorems about `Array` and `List` needed for `Init.Data.List.Impl`.
## Theorems about `Array`.
-/
namespace Array
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl
theorem getElem_eq_getElem_toList {a : Array α} (h : i < a.size) : a[i] = a.toList[i] := by
@@ -45,21 +43,32 @@ theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[
rw [getElem?_eq]
split <;> simp_all
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
theorem getElem_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_getElem_toList, List.concat_eq_append, List.getElem_append_left, h]
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
@[simp] theorem getElem_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append]
rw [List.getElem_append_right] <;> simp [getElem_eq_getElem_toList, Nat.zero_lt_one]
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
theorem getElem_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 [getElem_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')]
simp [getElem_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
@[deprecated getElem_push (since := "2024-10-21")] abbrev get_push := @getElem_push
@[deprecated getElem_push_lt (since := "2024-10-21")] abbrev get_push_lt := @getElem_push_lt
@[deprecated getElem_push_eq (since := "2024-10-21")] abbrev get_push_eq := @getElem_push_eq
@[simp] theorem get!_eq_getElem! [Inhabited α] (a : Array α) (i : Nat) : a.get! i = a[i]! := by
simp [getElem!_def, get!, getD]
split <;> rename_i h
· simp [getElem?_eq_getElem h]
rfl
· simp [getElem?_eq_none_iff.2 (by simpa using h)]
end Array
@@ -76,13 +85,6 @@ We prefer to pull `List.toArray` outwards.
(a.toArrayAux b).size = b.size + a.length := by
simp [size]
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem getElem_toArray {a : List α} {i : Nat} (h : i < a.toArray.size) :
a.toArray[i] = a[i]'(by simpa using h) := rfl
@[simp] theorem getElem?_toArray {a : List α} {i : Nat} : a.toArray[i]? = a[i]? := rfl
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
apply ext'
simp
@@ -92,6 +94,14 @@ We prefer to pull `List.toArray` outwards.
funext a
simp
@[simp] theorem isEmpty_toArray (l : List α) : l.toArray.isEmpty = l.isEmpty := by
cases l <;> simp
@[simp] theorem toArray_singleton (a : α) : (List.singleton a).toArray = singleton a := rfl
@[simp] theorem back_toArray [Inhabited α] (l : List α) : l.toArray.back = l.getLast! := by
simp only [back, size_toArray, Array.get!_eq_getElem!, getElem!_toArray, getLast!_eq_getElem!]
theorem foldrM_toArray [Monad m] (f : α β m β) (init : β) (l : List α) :
l.toArray.foldrM f init = l.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList]
@@ -149,6 +159,9 @@ namespace Array
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
-- This is a duplicate of `List.toArray_toList`.
-- It's confusing to guess which namespace this theorem should live in,
-- so we provide both.
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[simp] theorem length_toList {l : Array α} : l.toList.length = l.size := rfl
@@ -250,7 +263,7 @@ theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by si
@[simp] theorem get_eq_getElem (a : Array α) (i : Fin _) : a.get i = a[i.1] := rfl
theorem getElem?_lt
(a : Array α) {i : Nat} (h : i < a.size) : a[i]? = some (a[i]) := dif_pos h
(a : Array α) {i : Nat} (h : i < a.size) : a[i]? = some a[i] := dif_pos h
theorem getElem?_ge
(a : Array α) {i : Nat} (h : i a.size) : a[i]? = none := dif_neg (Nat.not_lt_of_le h)
@@ -273,8 +286,10 @@ theorem getD_get? (a : Array α) (i : Nat) (d : α) :
theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default := rfl
@[simp] theorem get!_eq_getElem? [Inhabited α] (a : Array α) (i : Nat) : a.get! i = (a.get? i).getD default := by
by_cases p : i < a.size <;> simp [getD_get?, get!_eq_getD, p]
@[simp] theorem get!_eq_getElem? [Inhabited α] (a : Array α) (i : Nat) :
a.get! i = (a.get? i).getD default := by
by_cases p : i < a.size <;>
simp only [get!_eq_getD, getD_eq_get?, getD_get?, p, get?_eq_getElem?]
/-! # set -/
@@ -354,8 +369,8 @@ theorem getElem_ofFn_go (f : Fin n → α) (i) {acc k}
simp only [dif_pos hin]
rw [getElem_ofFn_go f (i+1) _ hin (by simp [*]) (fun j hj => ?hacc)]
cases (Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ (by simpa using hj)) with
| inl hj => simp [get_push, hj, hacc j hj]
| inr hj => simp [get_push, *]
| inl hj => simp [getElem_push, hj, hacc j hj]
| inr hj => simp [getElem_push, *]
else
simp [hin, hacc k (Nat.lt_of_lt_of_le hki (Nat.le_of_not_lt (hi hin)))]
termination_by n - i
@@ -423,7 +438,7 @@ theorem lt_of_getElem {x : α} {a : Array α} {idx : Nat} {hidx : idx < a.size}
idx < a.size :=
hidx
theorem getElem_mem {l : Array α} {i : Nat} (h : i < l.size) : l[i] l := by
@[simp] theorem getElem_mem {l : Array α} {i : Nat} (h : i < l.size) : l[i] l := by
erw [Array.mem_def, getElem_eq_getElem_toList]
apply List.get_mem
@@ -432,9 +447,11 @@ theorem getElem_fin_eq_getElem_toList (a : Array α) (i : Fin a.size) : a[i] = a
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
a[i] = a[i.toNat] := rfl
theorem get?_len_le (a : Array α) (i : Nat) (h : a.size i) : a[i]? = none := by
theorem getElem?_size_le (a : Array α) (i : Nat) (h : a.size i) : a[i]? = none := by
simp [getElem?_neg, h]
@[deprecated getElem?_size_le (since := "2024-10-21")] abbrev get?_len_le := @getElem?_size_le
theorem getElem_mem_toList (a : Array α) (h : i < a.size) : a[i] a.toList := by
simp only [getElem_eq_getElem_toList, List.getElem_mem]
@@ -442,35 +459,39 @@ theorem get?_eq_get?_toList (a : Array α) (i : Nat) : a.get? i = a.toList.get?
simp [getElem?_eq_getElem?_toList]
theorem get!_eq_get? [Inhabited α] (a : Array α) : a.get! n = (a.get? n).getD default := by
simp [get!_eq_getD]
simp only [get!_eq_getElem?, get?_eq_getElem?]
theorem getElem?_eq_some_iff {as : Array α} : as[n]? = some a h : n < as.size, as[n] = a := by
cases as
simp [List.getElem?_eq_some_iff]
@[simp] theorem back_eq_back? [Inhabited α] (a : Array α) : a.back = a.back?.getD default := by
simp [back, back?]
simp only [back, get!_eq_getElem?, get?_eq_getElem?, back?]
@[simp] theorem back?_push (a : Array α) : (a.push x).back? = some x := by
simp [back?, getElem?_eq_getElem?_toList]
theorem back_push [Inhabited α] (a : Array α) : (a.push x).back = x := by simp
theorem get?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
theorem getElem?_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
(a.push x)[i]? = some a[i] := by
rw [getElem?_pos, get_push_lt]
rw [getElem?_pos, getElem_push_lt]
theorem get?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := by
rw [getElem?_pos, get_push_eq]
@[deprecated getElem?_push_lt (since := "2024-10-21")] abbrev get?_push_lt := @getElem?_push_lt
theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x else a[i]? := by
theorem getElem?_push_eq (a : Array α) (x : α) : (a.push x)[a.size]? = some x := by
rw [getElem?_pos, getElem_push_eq]
@[deprecated getElem?_push_eq (since := "2024-10-21")] abbrev get?_push_eq := @getElem?_push_eq
theorem getElem?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x else a[i]? := by
match Nat.lt_trichotomy i a.size with
| Or.inl g =>
have h1 : i < a.size + 1 := by omega
have h2 : i a.size := by omega
simp [getElem?_def, size_push, g, h1, h2, get_push_lt]
simp [getElem?_def, size_push, g, h1, h2, getElem_push_lt]
| Or.inr (Or.inl heq) =>
simp [heq, getElem?_pos, get_push_eq]
simp [heq, getElem?_pos, getElem_push_eq]
| Or.inr (Or.inr g) =>
simp only [getElem?_def, size_push]
have h1 : ¬ (i < a.size) := by omega
@@ -478,9 +499,13 @@ theorem get?_push {a : Array α} : (a.push x)[i]? = if i = a.size then some x el
have h3 : i a.size := by omega
simp [h1, h2, h3]
@[simp] theorem get?_size {a : Array α} : a[a.size]? = none := by
@[deprecated getElem?_push (since := "2024-10-21")] abbrev get?_push := @getElem?_push
@[simp] theorem getElem?_size {a : Array α} : a[a.size]? = none := by
simp only [getElem?_def, Nat.lt_irrefl, dite_false]
@[deprecated getElem?_size (since := "2024-10-21")] abbrev get?_size := @getElem?_size
@[simp] theorem toList_set (a : Array α) (i v) : (a.set i v).toList = a.toList.set i.1 v := rfl
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
@@ -530,6 +555,9 @@ theorem getElem?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
a.swapAt i v = (a[i.1], a.set i v) := rfl
@[simp] theorem size_swapAt (a : Array α) (i : Fin a.size) (v : α) :
(a.swapAt i v).2.size = a.size := by simp [swapAt_def]
@[simp]
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
a.swapAt! i v = (a[i], a.set i, h v) := by simp [swapAt!, h]
@@ -562,11 +590,11 @@ theorem eq_push_pop_back_of_size_ne_zero [Inhabited α] {as : Array α} (h : as.
· simp [Nat.sub_add_cancel (Nat.zero_lt_of_ne_zero h)]
· intros i h h'
if hlt : i < as.pop.size then
rw [get_push_lt (h:=hlt), getElem_pop]
rw [getElem_push_lt (h:=hlt), getElem_pop]
else
have heq : i = as.pop.size :=
Nat.le_antisymm (size_pop .. Nat.le_pred_of_lt h) (Nat.le_of_not_gt hlt)
cases heq; rw [get_push_eq, back, size_pop, get!_eq_getD, getD, dif_pos h]; rfl
cases heq; rw [getElem_push_eq, back, size_pop, get!_eq_getD, getD, dif_pos h]; rfl
theorem eq_push_of_size_ne_zero {as : Array α} (h : as.size 0) :
(bs : Array α) (c : α), as = bs.push c :=
@@ -775,9 +803,9 @@ theorem map_induction (as : Array α) (f : α → β) (motive : Nat → Prop) (h
· intro j h
simp at h
by_cases h' : j < size b
· rw [get_push]
· rw [getElem_push]
simp_all
· rw [get_push, dif_neg h']
· rw [getElem_push, dif_neg h']
simp only [show j = i by omega]
exact (hs _ m).1
@@ -802,7 +830,7 @@ theorem map_spec (as : Array α) (f : α → β) (p : Fin as.size → β → Pro
(as.push x).map f = (as.map f).push (f x) := by
ext
· simp
· simp only [getElem_map, get_push, size_map]
· simp only [getElem_map, getElem_push, size_map]
split <;> rfl
@[simp] theorem map_pop {f : α β} {as : Array α} :
@@ -811,57 +839,6 @@ theorem map_spec (as : Array α) (f : α → β) (p : Fin as.size → β → Pro
· simp
· simp only [getElem_map, getElem_pop, size_map]
/-! ### mapIdx -/
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
theorem mapIdx_induction (as : Array α) (f : Fin as.size α β)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) := by
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : i h h', p i, h bs[i]) (hm : motive j) :
let arr : Array β := Array.mapIdxM.map (m := Id) as f i j h bs
motive as.size eq : arr.size = as.size, i h, p i, h arr[i] := by
induction i generalizing j bs with simp [mapIdxM.map]
| zero =>
have := (Nat.zero_add _).symm.trans h
exact this hm, h₁ this, fun _ _ => h₂ ..
| succ i ih =>
apply @ih (bs.push (f j, by omega as[j])) (j + 1) (by omega) (by simp; omega)
· intro i i_lt h'
rw [get_push]
split
· apply h₂
· simp only [size_push] at h'
obtain rfl : i = j := by omega
apply (hs i, by omega hm).1
· exact (hs j, by omega hm).2
simp [mapIdx, mapIdxM]; exact go rfl nofun h0
theorem mapIdx_spec (as : Array α) (f : Fin as.size α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapIdx (a : Array α) (f : Fin a.size α β) : (a.mapIdx f).size = a.size :=
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
Array.size_mapIdx _ _
@[simp] theorem getElem_mapIdx (a : Array α) (f : Fin a.size α β) (i : Nat)
(h : i < (mapIdx a f).size) :
(a.mapIdx f)[i] = f i, by simp_all (a[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
@[simp] theorem getElem?_mapIdx (a : Array α) (f : Fin a.size α β) (i : Nat) :
(a.mapIdx f)[i]? =
a[i]?.pbind fun b h => f i, (getElem?_eq_some_iff.1 h).1 b := by
simp only [getElem?_def, size_mapIdx, getElem_mapIdx]
split <;> simp_all
/-! ### modify -/
@[simp] theorem size_modify (a : Array α) (i : Nat) (f : α α) : (a.modify i f).size = a.size := by
@@ -875,6 +852,12 @@ theorem getElem_modify {as : Array α} {x i} (h : i < (as.modify x f).size) :
· simp only [Id.bind_eq, get_set _ _ _ (by simpa using h)]; split <;> simp [*]
· rw [if_neg (mt (by rintro rfl; exact h) (by simp_all))]
@[simp] theorem toList_modify (as : Array α) (f : α α) :
(as.modify x f).toList = as.toList.modify f x := by
apply List.ext_getElem
· simp
· simp [getElem_modify, List.getElem_modify]
theorem getElem_modify_self {as : Array α} {i : Nat} (f : α α) (h : i < (as.modify i f).size) :
(as.modify i f)[i] = f (as[i]'(by simpa using h)) := by
simp [getElem_modify h]
@@ -884,6 +867,11 @@ theorem getElem_modify_of_ne {as : Array α} {i : Nat} (h : i ≠ j)
(as.modify i f)[j] = as[j]'(by simpa using hj) := by
simp [getElem_modify hj, h]
theorem getElem?_modify {as : Array α} {i : Nat} {f : α α} {j : Nat} :
(as.modify i f)[j]? = if i = j then as[j]?.map f else as[j]? := by
simp only [getElem?_def, size_modify, getElem_modify, Option.map_dif]
split <;> split <;> rfl
/-! ### filter -/
@[simp] theorem toList_filter (p : α Bool) (l : Array α) :
@@ -945,7 +933,7 @@ theorem filterMap_congr {as bs : Array α} (h : as = bs)
theorem size_empty : (#[] : Array α).size = 0 := rfl
theorem toList_empty : (#[] : Array α).toList = [] := rfl
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
/-! ### append -/
@@ -1103,7 +1091,7 @@ theorem getElem_extract_loop_ge (as bs : Array α) (size start : Nat) (hge : i
have h₂ : bs.size < (extract.loop as size (start+1) (bs.push as[start])).size := by
rw [size_extract_loop]; apply Nat.lt_of_lt_of_le h₁; exact Nat.le_add_right ..
have h : (extract.loop as size (start + 1) (push bs as[start]))[bs.size] = as[start] := by
rw [getElem_extract_loop_lt as (bs.push as[start]) size (start+1) h₁ h₂, get_push_eq]
rw [getElem_extract_loop_lt as (bs.push as[start]) size (start+1) h₁ h₂, getElem_push_eq]
rw [h]; congr; rw [Nat.add_sub_cancel]
else
have hge : bs.size + 1 i := Nat.lt_of_le_of_ne hge hi
@@ -1130,6 +1118,14 @@ theorem getElem?_extract {as : Array α} {start stop : Nat} :
· omega
· rfl
@[simp] theorem toList_extract (as : Array α) (start stop : Nat) :
(as.extract start stop).toList = (as.toList.drop start).take (stop - start) := by
apply List.ext_getElem
· simp only [length_toList, size_extract, List.length_take, List.length_drop]
omega
· intros n h₁ h₂
simp
@[simp] theorem extract_all (as : Array α) : as.extract 0 as.size = as := by
apply ext
· rw [size_extract, Nat.min_self, Nat.sub_zero]
@@ -1299,7 +1295,7 @@ open Fin
· assumption
theorem getElem_swap' (a : Array α) (i j : Fin a.size) (k : Nat) (hk : k < a.size) :
(a.swap i j)[k]'(by simp_all) = if k = i then a[j] else if k = j then a[i] else a[k] := by
(a.swap i j)[k]'(by simp_all) = if k = i then a[j] else if k = j then a[i] else a[k] := by
split
· simp_all only [getElem_swap_left]
· split <;> simp_all
@@ -1309,7 +1305,7 @@ theorem getElem_swap (a : Array α) (i j : Fin a.size) (k : Nat) (hk : k < (a.sw
apply getElem_swap'
@[simp] theorem swap_swap (a : Array α) {i j : Fin a.size} :
(a.swap i j).swap i.1, (a.size_swap ..).symm i.2 j.1, (a.size_swap ..).symm j.2 = a := by
(a.swap i j).swap i.1, (a.size_swap ..).symm i.2 j.1, (a.size_swap ..).symm j.2 = a := by
apply ext
· simp only [size_swap]
· intros
@@ -1444,6 +1440,11 @@ theorem all_toArray (p : α → Bool) (l : List α) : l.toArray.all p = l.all p
apply ext'
simp
@[simp] theorem modify_toArray (f : α α) (l : List α) :
l.toArray.modify i f = (l.modify f i).toArray := by
apply ext'
simp
@[simp] theorem filter_toArray' (p : α Bool) (l : List α) (h : stop = l.toArray.size) :
l.toArray.filter p 0 stop = (l.filter p).toArray := by
subst h
@@ -1472,6 +1473,11 @@ theorem filterMap_toArray (f : α → Option β) (l : List α) :
apply ext'
simp
@[simp] theorem toArray_extract (l : List α) (start stop : Nat) :
l.toArray.extract start stop = ((l.drop start).take (stop - start)).toArray := by
apply ext'
simp
end List
/-! ### Deprecations -/

View File

@@ -0,0 +1,92 @@
/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.List.MapIdx
namespace Array
/-! ### mapFinIdx -/
-- This could also be proved from `SatisfiesM_mapIdxM` in Batteries.
theorem mapFinIdx_induction (as : Array α) (f : Fin as.size α β)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (Array.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) := by
let rec go {bs i j h} (h₁ : j = bs.size) (h₂ : i h h', p i, h bs[i]) (hm : motive j) :
let arr : Array β := Array.mapFinIdxM.map (m := Id) as f i j h bs
motive as.size eq : arr.size = as.size, i h, p i, h arr[i] := by
induction i generalizing j bs with simp [mapFinIdxM.map]
| zero =>
have := (Nat.zero_add _).symm.trans h
exact this hm, h₁ this, fun _ _ => h₂ ..
| succ i ih =>
apply @ih (bs.push (f j, by omega as[j])) (j + 1) (by omega) (by simp; omega)
· intro i i_lt h'
rw [getElem_push]
split
· apply h₂
· simp only [size_push] at h'
obtain rfl : i = j := by omega
apply (hs i, by omega hm).1
· exact (hs j, by omega hm).2
simp [mapFinIdx, mapFinIdxM]; exact go rfl nofun h0
theorem mapFinIdx_spec (as : Array α) (f : Fin as.size α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapFinIdx as f).size = as.size,
i h, p i, h ((Array.mapFinIdx as f)[i]) :=
(mapFinIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapFinIdx (a : Array α) (f : Fin a.size α β) : (a.mapFinIdx f).size = a.size :=
(mapFinIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
Array.size_mapFinIdx _ _
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat)
(h : i < (mapFinIdx a f).size) :
(a.mapFinIdx f)[i] = f i, by simp_all (a[i]'(by simp_all)) :=
(mapFinIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i _
@[simp] theorem getElem?_mapFinIdx (a : Array α) (f : Fin a.size α β) (i : Nat) :
(a.mapFinIdx f)[i]? =
a[i]?.pbind fun b h => f i, (getElem?_eq_some_iff.1 h).1 b := by
simp only [getElem?_def, size_mapFinIdx, getElem_mapFinIdx]
split <;> simp_all
/-! ### mapIdx -/
theorem mapIdx_induction (as : Array α) (f : Nat α β)
(motive : Nat Prop) (h0 : motive 0)
(p : Fin as.size β Prop)
(hs : i, motive i.1 p i (f i as[i]) motive (i + 1)) :
motive as.size eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
mapFinIdx_induction as (fun i a => f i a) motive h0 p hs
theorem mapIdx_spec (as : Array α) (f : Nat α β)
(p : Fin as.size β Prop) (hs : i, p i (f i as[i])) :
eq : (Array.mapIdx as f).size = as.size,
i h, p i, h ((Array.mapIdx as f)[i]) :=
(mapIdx_induction _ _ (fun _ => True) trivial p fun _ _ => hs .., trivial).2
@[simp] theorem size_mapIdx (a : Array α) (f : Nat α β) : (a.mapIdx f).size = a.size :=
(mapIdx_spec (p := fun _ _ => True) (hs := fun _ => trivial)).1
@[simp] theorem getElem_mapIdx (a : Array α) (f : Nat α β) (i : Nat)
(h : i < (mapIdx a f).size) :
(a.mapIdx f)[i] = f i (a[i]'(by simp_all)) :=
(mapIdx_spec _ _ (fun i b => b = f i a[i]) fun _ => rfl).2 i (by simp_all)
@[simp] theorem getElem?_mapIdx (a : Array α) (f : Nat α β) (i : Nat) :
(a.mapIdx f)[i]? =
a[i]?.map (f i) := by
simp [getElem?_def, size_mapIdx, getElem_mapIdx]
end Array

View File

@@ -316,6 +316,12 @@ theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
simp [Nat.sub_sub_eq_min, Nat.min_eq_right]
omega
@[simp] theorem sub_add_bmod_cancel {x y : BitVec w} :
((((2 ^ w : Nat) - y.toNat) : Int) + x.toNat).bmod (2 ^ w) =
((x.toNat : Int) - y.toNat).bmod (2 ^ w) := by
rw [Int.sub_eq_add_neg, Int.add_assoc, Int.add_comm, Int.bmod_add_cancel, Int.add_comm,
Int.sub_eq_add_neg]
private theorem lt_two_pow_of_le {x m n : Nat} (lt : x < 2 ^ m) (le : m n) : x < 2 ^ n :=
Nat.lt_of_lt_of_le lt (Nat.pow_le_pow_of_le_right (by trivial : 0 < 2) le)
@@ -1974,6 +1980,10 @@ theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n ((2^n - y.toNat) + x.toN
@[simp] theorem toNat_sub {n} (x y : BitVec n) :
(x - y).toNat = (((2^n - y.toNat) + x.toNat) % 2^n) := rfl
@[simp, bv_toNat] theorem toInt_sub {x y : BitVec w} :
(x - y).toInt = (x.toInt - y.toInt).bmod (2 ^ w) := by
simp [toInt_eq_toNat_bmod, @Int.ofNat_sub y.toNat (2 ^ w) (by omega)]
-- We prefer this lemma to `toNat_sub` for the `bv_toNat` simp set.
-- For reasons we don't yet understand, unfolding via `toNat_sub` sometimes
-- results in `omega` generating proof terms that are very slow in the kernel.
@@ -1996,6 +2006,8 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
@[simp] protected theorem sub_zero (x : BitVec n) : x - 0#n = x := by apply eq_of_toNat_eq ; simp
@[simp] protected theorem zero_sub (x : BitVec n) : 0#n - x = -x := rfl
@[simp] protected theorem sub_self (x : BitVec n) : x - x = 0#n := by
apply eq_of_toNat_eq
simp only [toNat_sub]
@@ -2008,18 +2020,8 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
theorem toInt_neg {x : BitVec w} :
(-x).toInt = (-x.toInt).bmod (2 ^ w) := by
simp only [toInt_eq_toNat_bmod, toNat_neg, Int.ofNat_emod, Int.emod_bmod_congr]
rw [ Int.subNatNat_of_le (by omega), Int.subNatNat_eq_coe, Int.sub_eq_add_neg, Int.add_comm,
Int.bmod_add_cancel]
by_cases h : x.toNat < ((2 ^ w) + 1) / 2
· rw [Int.bmod_pos (x := x.toNat)]
all_goals simp only [toNat_mod_cancel']
norm_cast
· rw [Int.bmod_neg (x := x.toNat)]
· simp only [toNat_mod_cancel']
rw_mod_cast [Int.neg_sub, Int.sub_eq_add_neg, Int.add_comm, Int.bmod_add_cancel]
· norm_cast
simp_all
rw [ BitVec.zero_sub, toInt_sub]
simp [BitVec.toInt_ofNat]
@[simp] theorem toFin_neg (x : BitVec n) :
(-x).toFin = Fin.ofNat' (2^n) (2^n - x.toNat) :=

View File

@@ -51,6 +51,9 @@ instance : Hashable USize where
instance : Hashable (Fin n) where
hash v := v.val.toUInt64
instance : Hashable Char where
hash c := c.val.toUInt64
instance : Hashable Int where
hash
| Int.ofNat n => UInt64.ofNat (2 * n)

View File

@@ -1125,6 +1125,17 @@ theorem emod_add_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n + y) n = Int.bmo
simp [Int.emod_def, Int.sub_eq_add_neg]
rw [Int.mul_neg, Int.add_right_comm, Int.bmod_add_mul_cancel]
@[simp]
theorem emod_sub_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n - y) n = Int.bmod (x - y) n := by
simp only [emod_def, Int.sub_eq_add_neg]
rw [Int.mul_neg, Int.add_right_comm, Int.bmod_add_mul_cancel]
@[simp]
theorem sub_emod_bmod_congr (x : Int) (n : Nat) : Int.bmod (x - y%n) n = Int.bmod (x - y) n := by
simp only [emod_def]
rw [Int.sub_eq_add_neg, Int.neg_sub, Int.sub_eq_add_neg, Int.add_assoc, Int.add_right_comm,
Int.bmod_add_mul_cancel, Int.sub_eq_add_neg]
@[simp]
theorem emod_mul_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n * y) n = Int.bmod (x * y) n := by
simp [Int.emod_def, Int.sub_eq_add_neg]
@@ -1140,9 +1151,28 @@ theorem bmod_add_bmod_congr : Int.bmod (Int.bmod x n + y) n = Int.bmod (x + y) n
rw [Int.sub_eq_add_neg, Int.add_right_comm, Int.sub_eq_add_neg]
simp
@[simp]
theorem bmod_sub_bmod_congr : Int.bmod (Int.bmod x n - y) n = Int.bmod (x - y) n := by
rw [Int.bmod_def x n]
split
next p =>
simp only [emod_sub_bmod_congr]
next p =>
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_right_comm, Int.sub_eq_add_neg, Int.sub_eq_add_neg]
simp [emod_sub_bmod_congr]
@[simp] theorem add_bmod_bmod : Int.bmod (x + Int.bmod y n) n = Int.bmod (x + y) n := by
rw [Int.add_comm x, Int.bmod_add_bmod_congr, Int.add_comm y]
@[simp] theorem sub_bmod_bmod : Int.bmod (x - Int.bmod y n) n = Int.bmod (x - y) n := by
rw [Int.bmod_def y n]
split
next p =>
simp [sub_emod_bmod_congr]
next p =>
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.neg_add, Int.neg_neg, Int.add_assoc, Int.sub_eq_add_neg]
simp [sub_emod_bmod_congr]
@[simp]
theorem bmod_mul_bmod : Int.bmod (Int.bmod x n * y) n = Int.bmod (x * y) n := by
rw [bmod_def x n]

View File

@@ -38,7 +38,7 @@ The operations are organized as follow:
* Sublists: `take`, `drop`, `takeWhile`, `dropWhile`, `partition`, `dropLast`,
`isPrefixOf`, `isPrefixOf?`, `isSuffixOf`, `isSuffixOf?`, `Subset`, `Sublist`,
`rotateLeft` and `rotateRight`.
* Manipulating elements: `replace`, `insert`, `erase`, `eraseP`, `eraseIdx`.
* Manipulating elements: `replace`, `insert`, `modify`, `erase`, `eraseP`, `eraseIdx`.
* Finding elements: `find?`, `findSome?`, `findIdx`, `indexOf`, `findIdx?`, `indexOf?`,
`countP`, `count`, and `lookup`.
* Logic: `any`, `all`, `or`, and `and`.
@@ -122,6 +122,11 @@ protected def beq [BEq α] : List α → List α → Bool
| a::as, b::bs => a == b && List.beq as bs
| _, _ => false
@[simp] theorem beq_nil_nil [BEq α] : List.beq ([] : List α) ([] : List α) = true := rfl
@[simp] theorem beq_cons_nil [BEq α] (a : α) (as : List α) : List.beq (a::as) [] = false := rfl
@[simp] theorem beq_nil_cons [BEq α] (a : α) (as : List α) : List.beq [] (a::as) = false := rfl
theorem beq_cons₂ [BEq α] (a b : α) (as bs : List α) : List.beq (a::as) (b::bs) = (a == b && List.beq as bs) := rfl
instance [BEq α] : BEq (List α) := List.beq
instance [BEq α] [LawfulBEq α] : LawfulBEq (List α) where
@@ -1114,6 +1119,35 @@ theorem replace_cons [BEq α] {a : α} :
@[inline] protected def insert [BEq α] (a : α) (l : List α) : List α :=
if l.elem a then l else a :: l
/-! ### modify -/
/--
Apply a function to the nth tail of `l`. Returns the input without
using `f` if the index is larger than the length of the List.
```
modifyTailIdx f 2 [a, b, c] = [a, b] ++ f [c]
```
-/
@[simp] def modifyTailIdx (f : List α List α) : Nat List α List α
| 0, l => f l
| _+1, [] => []
| n+1, a :: l => a :: modifyTailIdx f n l
/-- Apply `f` to the head of the list, if it exists. -/
@[inline] def modifyHead (f : α α) : List α List α
| [] => []
| a :: l => f a :: l
@[simp] theorem modifyHead_nil (f : α α) : [].modifyHead f = [] := by rw [modifyHead]
@[simp] theorem modifyHead_cons (a : α) (l : List α) (f : α α) :
(a :: l).modifyHead f = f a :: l := by rw [modifyHead]
/--
Apply `f` to the nth element of the list, if it exists, replacing that element with the result.
-/
def modify (f : α α) : Nat List α List α :=
modifyTailIdx (modifyHead f)
/-! ### erase -/
/--
@@ -1418,11 +1452,15 @@ def sum {α} [Add α] [Zero α] : List αα :=
@[simp] theorem sum_cons [Add α] [Zero α] {a : α} {l : List α} : (a::l).sum = a + l.sum := rfl
/-- Sum of a list of natural numbers. -/
-- We intend to subsequently deprecate this in favor of `List.sum`.
@[deprecated List.sum (since := "2024-10-17")]
protected def _root_.Nat.sum (l : List Nat) : Nat := l.foldr (·+·) 0
@[simp] theorem _root_.Nat.sum_nil : Nat.sum ([] : List Nat) = 0 := rfl
@[simp] theorem _root_.Nat.sum_cons (a : Nat) (l : List Nat) :
set_option linter.deprecated false in
@[simp, deprecated sum_nil (since := "2024-10-17")]
theorem _root_.Nat.sum_nil : Nat.sum ([] : List Nat) = 0 := rfl
set_option linter.deprecated false in
@[simp, deprecated sum_cons (since := "2024-10-17")]
theorem _root_.Nat.sum_cons (a : Nat) (l : List Nat) :
Nat.sum (a::l) = a + Nat.sum l := rfl
/-! ### range -/

View File

@@ -232,7 +232,8 @@ theorem sizeOf_get [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.g
apply Nat.lt_trans ih
simp_arith
theorem le_antisymm [LT α] [s : Antisymm (¬ · < · : α α Prop)] {as bs : List α} (h₁ : as bs) (h₂ : bs as) : as = bs :=
theorem le_antisymm [LT α] [s : Std.Antisymm (¬ · < · : α α Prop)]
{as bs : List α} (h₁ : as bs) (h₂ : bs as) : as = bs :=
match as, bs with
| [], [] => rfl
| [], _::_ => False.elim <| h₂ (List.lt.nil ..)
@@ -248,7 +249,8 @@ theorem le_antisymm [LT α] [s : Antisymm (¬ · < · : αα → Prop)] {as
have : a = b := s.antisymm hab hba
simp [this, ih]
instance [LT α] [Antisymm (¬ · < · : α α Prop)] : Antisymm (· · : List α List α Prop) where
instance [LT α] [Std.Antisymm (¬ · < · : α α Prop)] :
Std.Antisymm (· · : List α List α Prop) where
antisymm h₁ h₂ := le_antisymm h₁ h₂
end List

View File

@@ -38,7 +38,7 @@ The following operations were already given `@[csimp]` replacements in `Init/Dat
The following operations are given `@[csimp]` replacements below:
`set`, `filterMap`, `foldr`, `append`, `bind`, `join`,
`take`, `takeWhile`, `dropLast`, `replace`, `erase`, `eraseIdx`, `zipWith`,
`take`, `takeWhile`, `dropLast`, `replace`, `modify`, `erase`, `eraseIdx`, `zipWith`,
`enumFrom`, and `intercalate`.
-/
@@ -197,6 +197,24 @@ The following operations are given `@[csimp]` replacements below:
· simp [*]
· intro h; rw [IH] <;> simp_all
/-! ### modify -/
/-- Tail-recursive version of `modify`. -/
def modifyTR (f : α α) (n : Nat) (l : List α) : List α := go l n #[] where
/-- Auxiliary for `modifyTR`: `modifyTR.go f l n acc = acc.toList ++ modify f n l`. -/
go : List α Nat Array α List α
| [], _, acc => acc.toList
| a :: l, 0, acc => acc.toListAppend (f a :: l)
| a :: l, n+1, acc => go l n (acc.push a)
theorem modifyTR_go_eq : l n, modifyTR.go f l n acc = acc.toList ++ modify f n l
| [], n => by cases n <;> simp [modifyTR.go, modify]
| a :: l, 0 => by simp [modifyTR.go, modify]
| a :: l, n+1 => by simp [modifyTR.go, modify, modifyTR_go_eq l]
@[csimp] theorem modify_eq_modifyTR : @modify = @modifyTR := by
funext α f n l; simp [modifyTR, modifyTR_go_eq]
/-! ### erase -/
/-- Tail recursive version of `List.erase`. -/

View File

@@ -1047,9 +1047,6 @@ theorem get_cons_length (x : α) (xs : List α) (n : Nat) (h : n = xs.length) :
@[simp] theorem getLast?_singleton (a : α) : getLast? [a] = a := rfl
theorem getLast!_of_getLast? [Inhabited α] : {l : List α}, getLast? l = some a getLast! l = a
| _ :: _, rfl => rfl
theorem getLast?_eq_getLast : l h, @getLast? α l = some (getLast l h)
| [], h => nomatch h rfl
| _ :: _, _ => rfl
@@ -1083,6 +1080,21 @@ theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by
theorem getLastD_concat (a b l) : @getLastD α (l ++ [b]) a = b := by
rw [getLastD_eq_getLast?, getLast?_concat]; rfl
/-! ### getLast! -/
@[simp] theorem getLast!_nil [Inhabited α] : ([] : List α).getLast! = default := rfl
theorem getLast!_of_getLast? [Inhabited α] : {l : List α}, getLast? l = some a getLast! l = a
| _ :: _, rfl => rfl
theorem getLast!_eq_getElem! [Inhabited α] {l : List α} : l.getLast! = l[l.length - 1]! := by
cases l with
| nil => simp
| cons _ _ =>
apply getLast!_of_getLast?
rw [getElem!_pos, getElem_cons_length (h := by simp)]
rfl
/-! ## Head and tail -/
/-! ### head -/

View File

@@ -75,7 +75,7 @@ theorem le_min?_iff [Min α] [LE α]
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`,
-- and `le_min_iff`.
theorem min?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ·)]
theorem min?_eq_some_iff [Min α] [LE α] [anti : Std.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 α} :
@@ -146,7 +146,7 @@ theorem max?_le_iff [Max α] [LE α]
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `max_eq_or`,
-- and `le_min_iff`.
theorem max?_eq_some_iff [Max α] [LE α] [anti : Antisymm ((· : α) ·)]
theorem max?_eq_some_iff [Max α] [LE α] [anti : Std.Antisymm ((· : α) ·)]
(le_refl : a : α, a a)
(max_eq_or : a b : α, max a b = a max a b = b)
(max_le_iff : a b c : α, max b c a b a c a) {xs : List α} :

View File

@@ -99,4 +99,14 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
funext b
split <;> simp_all
/-! ### foldlM and foldrM -/
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : List β₁) (init : α) :
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
induction l generalizing g init <;> simp [*]
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ β₂) (g : β₂ α m α) (l : List β₁)
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
induction l generalizing g init <;> simp [*]
end List

View File

@@ -12,3 +12,5 @@ import Init.Data.List.Nat.TakeDrop
import Init.Data.List.Nat.Count
import Init.Data.List.Nat.Erase
import Init.Data.List.Nat.Find
import Init.Data.List.Nat.BEq
import Init.Data.List.Nat.Modify

View File

@@ -0,0 +1,47 @@
/-
Copyright (c) 2024 Lean FRO All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Nat.Lemmas
import Init.Data.List.Basic
namespace List
/-! ### isEqv-/
theorem isEqv_eq_decide (a b : List α) (r) :
isEqv a b r = if h : a.length = b.length then
decide ( (i : Nat) (h' : i < a.length), r (a[i]'(h h')) (b[i]'(h h'))) else false := by
induction a generalizing b with
| nil =>
cases b <;> simp
| cons a as ih =>
cases b with
| nil => simp
| cons b bs =>
simp only [isEqv, ih, length_cons, Nat.add_right_cancel_iff]
split <;> simp [Nat.forall_lt_succ_left']
/-! ### beq -/
theorem beq_eq_isEqv [BEq α] (a b : List α) : a.beq b = isEqv a b (· == ·) := by
induction a generalizing b with
| nil =>
cases b <;> simp
| cons a as ih =>
cases b with
| nil => simp
| cons b bs =>
simp only [beq_cons₂, ih, isEqv_eq_decide, length_cons, Nat.add_right_cancel_iff,
Nat.forall_lt_succ_left', getElem_cons_zero, getElem_cons_succ, Bool.decide_and,
Bool.decide_eq_true]
split <;> simp
theorem beq_eq_decide [BEq α] (a b : List α) :
(a == b) = if h : a.length = b.length then
decide ( (i : Nat) (h' : i < a.length), a[i] == b[i]'(h h')) else false := by
simp [BEq.beq, beq_eq_isEqv, isEqv_eq_decide]
end List

View File

@@ -0,0 +1,102 @@
/-
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.Nat.TakeDrop
namespace List
/-! ### modifyHead -/
@[simp] theorem modifyHead_modifyHead (l : List α) (f g : α α) :
(l.modifyHead f).modifyHead g = l.modifyHead (g f) := by cases l <;> simp [modifyHead]
/-! ### modify -/
@[simp] theorem modify_nil (f : α α) (n) : [].modify f n = [] := by cases n <;> rfl
@[simp] theorem modify_zero_cons (f : α α) (a : α) (l : List α) :
(a :: l).modify f 0 = f a :: l := rfl
@[simp] theorem modify_succ_cons (f : α α) (a : α) (l : List α) (n) :
(a :: l).modify f (n + 1) = a :: l.modify f n := by rfl
theorem modifyTailIdx_id : n (l : List α), l.modifyTailIdx id n = l
| 0, _ => rfl
| _+1, [] => rfl
| n+1, a :: l => congrArg (cons a) (modifyTailIdx_id n l)
theorem eraseIdx_eq_modifyTailIdx : n (l : List α), eraseIdx l n = modifyTailIdx tail n l
| 0, l => by cases l <;> rfl
| _+1, [] => rfl
| _+1, _ :: _ => congrArg (cons _) (eraseIdx_eq_modifyTailIdx _ _)
theorem getElem?_modify (f : α α) :
n (l : List α) m, (modify f n l)[m]? = (fun a => if n = m then f a else a) <$> l[m]?
| n, l, 0 => by cases l <;> cases n <;> simp
| n, [], _+1 => by cases n <;> rfl
| 0, _ :: l, m+1 => by cases h : l[m]? <;> simp [h, modify, m.succ_ne_zero.symm]
| n+1, a :: l, m+1 => by
simp only [modify_succ_cons, getElem?_cons_succ, Nat.reduceEqDiff, Option.map_eq_map]
refine (getElem?_modify f n l m).trans ?_
cases h' : l[m]? <;> by_cases h : n = m <;>
simp [h, if_pos, if_neg, Option.map, mt Nat.succ.inj, not_false_iff, h']
@[simp] theorem length_modifyTailIdx (f : List α List α) (H : l, length (f l) = length l) :
n l, length (modifyTailIdx f n l) = length l
| 0, _ => H _
| _+1, [] => rfl
| _+1, _ :: _ => congrArg (·+1) (length_modifyTailIdx _ H _ _)
theorem modifyTailIdx_add (f : List α List α) (n) (l₁ l₂ : List α) :
modifyTailIdx f (l₁.length + n) (l₁ ++ l₂) = l₁ ++ modifyTailIdx f n l₂ := by
induction l₁ <;> simp [*, Nat.succ_add]
@[simp] theorem length_modify (f : α α) : n l, length (modify f n l) = length l :=
length_modifyTailIdx _ fun l => by cases l <;> rfl
@[simp] theorem getElem?_modify_eq (f : α α) (n) (l : List α) :
(modify f n l)[n]? = f <$> l[n]? := by
simp only [getElem?_modify, if_pos]
@[simp] theorem getElem?_modify_ne (f : α α) {m n} (l : List α) (h : m n) :
(modify f m l)[n]? = l[n]? := by
simp only [getElem?_modify, if_neg h, id_map']
theorem getElem_modify (f : α α) (n) (l : List α) (m) (h : m < (modify f n l).length) :
(modify f n l)[m] =
if n = m then f (l[m]'(by simp at h; omega)) else l[m]'(by simp at h; omega) := by
rw [getElem_eq_iff, getElem?_modify]
simp at h
simp [h]
theorem modifyTailIdx_eq_take_drop (f : List α List α) (H : f [] = []) :
n l, modifyTailIdx f n l = take n l ++ f (drop n l)
| 0, _ => rfl
| _ + 1, [] => H.symm
| n + 1, b :: l => congrArg (cons b) (modifyTailIdx_eq_take_drop f H n l)
theorem modify_eq_take_drop (f : α α) :
n l, modify f n l = take n l ++ modifyHead f (drop n l) :=
modifyTailIdx_eq_take_drop _ rfl
theorem modify_eq_take_cons_drop (f : α α) {n l} (h : n < length l) :
modify f n l = take n l ++ f l[n] :: drop (n + 1) l := by
rw [modify_eq_take_drop, drop_eq_getElem_cons h]; rfl
theorem exists_of_modifyTailIdx (f : List α List α) {n} {l : List α} (h : n l.length) :
l₁ l₂, l = l₁ ++ l₂ l₁.length = n modifyTailIdx f n l = l₁ ++ f l₂ :=
have _, _, eq, hl : l₁ l₂, l = l₁ ++ l₂ l₁.length = n :=
_, _, (take_append_drop n l).symm, length_take_of_le h
_, _, eq, hl, hl eq modifyTailIdx_add (n := 0) ..
theorem exists_of_modify (f : α α) {n} {l : List α} (h : n < l.length) :
l₁ a l₂, l = l₁ ++ a :: l₂ l₁.length = n modify f n l = l₁ ++ f a :: l₂ :=
match exists_of_modifyTailIdx _ (Nat.le_of_lt h) with
| _, _::_, eq, hl, H => _, _, _, eq, hl, H
| _, [], eq, hl, _ => nomatch Nat.ne_of_gt h (eq append_nil _ hl)
end List

View File

@@ -490,10 +490,10 @@ protected theorem le_antisymm_iff {a b : Nat} : a = b ↔ a ≤ b ∧ b ≤ a :=
(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
instance : Antisymm ( . . : Nat Nat Prop) where
instance : Std.Antisymm ( . . : Nat Nat Prop) where
antisymm h₁ h₂ := Nat.le_antisymm h₁ h₂
instance : Antisymm (¬ . < . : Nat Nat Prop) where
instance : Std.Antisymm (¬ . < . : Nat Nat Prop) where
antisymm h₁ h₂ := Nat.le_antisymm (Nat.ge_of_not_lt h₂) (Nat.ge_of_not_lt h₁)
protected theorem add_le_add_left {n m : Nat} (h : n m) (k : Nat) : k + n k + m :=

View File

@@ -32,6 +32,77 @@ namespace Nat
@[simp] theorem exists_add_one_eq : ( n, n + 1 = a) 0 < a :=
fun n, h => by omega, fun h => a - 1, by omega
/-- Dependent variant of `forall_lt_succ_right`. -/
theorem forall_lt_succ_right' {p : (m : Nat) (m < n + 1) Prop} :
( m (h : m < n + 1), p m h) ( m (h : m < n), p m (by omega)) p n (by omega) := by
simp only [Nat.lt_succ_iff, Nat.le_iff_lt_or_eq]
constructor
· intro w
constructor
· intro m h
exact w _ (.inl h)
· exact w _ (.inr rfl)
· rintro w m (h|rfl)
· exact w.1 _ h
· exact w.2
/-- See `forall_lt_succ_right'` for a variant where `p` takes the bound as an argument. -/
theorem forall_lt_succ_right {p : Nat Prop} :
( m, m < n + 1 p m) ( m, m < n p m) p n := by
simpa using forall_lt_succ_right' (p := fun m _ => p m)
/-- Dependent variant of `forall_lt_succ_left`. -/
theorem forall_lt_succ_left' {p : (m : Nat) (m < n + 1) Prop} :
( m (h : m < n + 1), p m h) p 0 (by omega) ( m (h : m < n), p (m + 1) (by omega)) := by
constructor
· intro w
constructor
· exact w 0 (by omega)
· intro m h
exact w (m + 1) (by omega)
· rintro h₀, h₁ m h
cases m with
| zero => exact h₀
| succ m => exact h₁ m (by omega)
/-- See `forall_lt_succ_left'` for a variant where `p` takes the bound as an argument. -/
theorem forall_lt_succ_left {p : Nat Prop} :
( m, m < n + 1 p m) p 0 ( m, m < n p (m + 1)) := by
simpa using forall_lt_succ_left' (p := fun m _ => p m)
/-- Dependent variant of `exists_lt_succ_right`. -/
theorem exists_lt_succ_right' {p : (m : Nat) (m < n + 1) Prop} :
( m, (h : m < n + 1), p m h) ( m, (h : m < n), p m (by omega)) p n (by omega) := by
simp only [Nat.lt_succ_iff, Nat.le_iff_lt_or_eq]
constructor
· rintro m, (h|rfl), w
· exact .inl m, h, w
· exact .inr w
· rintro (m, h, w | w)
· exact m, by omega, w
· exact n, by omega, w
/-- See `exists_lt_succ_right'` for a variant where `p` takes the bound as an argument. -/
theorem exists_lt_succ_right {p : Nat Prop} :
( m, m < n + 1 p m) ( m, m < n p m) p n := by
simpa using exists_lt_succ_right' (p := fun m _ => p m)
/-- Dependent variant of `exists_lt_succ_left`. -/
theorem exists_lt_succ_left' {p : (m : Nat) (m < n + 1) Prop} :
( m, (h : m < n + 1), p m h) p 0 (by omega) ( m, (h : m < n), p (m + 1) (by omega)) := by
constructor
· rintro _|m, h, w
· exact .inl w
· exact .inr m, by omega, w
· rintro (w|m, h, w)
· exact 0, by omega, w
· exact m + 1, by omega, w
/-- See `exists_lt_succ_left'` for a variant where `p` takes the bound as an argument. -/
theorem exists_lt_succ_left {p : Nat Prop} :
( m, m < n + 1 p m) p 0 ( m, m < n p (m + 1)) := by
simpa using exists_lt_succ_left' (p := fun m _ => p m)
/-! ## add -/
protected theorem add_add_add_comm (a b c d : Nat) : (a + b) + (c + d) = (a + c) + (b + d) := by

View File

@@ -10,8 +10,10 @@ import Init.Data.Nat.Log2
/-- For decimal and scientific numbers (e.g., `1.23`, `3.12e10`).
Examples:
- `OfScientific.ofScientific 123 true 2` represents `1.23`
- `OfScientific.ofScientific 121 false 100` represents `121e100`
- `1.23` is syntax for `OfScientific.ofScientific (nat_lit 123) true (nat_lit 2)`
- `121e100` is syntax for `OfScientific.ofScientific (nat_lit 121) false (nat_lit 100)`
Note the use of `nat_lit`; there is no wrapping `OfNat.ofNat` in the resulting term.
-/
class OfScientific (α : Type u) where
ofScientific (mantissa : Nat) (exponentSign : Bool) (decimalExponent : Nat) : α

View File

@@ -44,7 +44,7 @@ theorem attach_congr {o₁ o₂ : Option α} (h : o₁ = o₂) :
simp
theorem attachWith_congr {o₁ o₂ : Option α} (w : o₁ = o₂) {P : α Prop} {H : x o₁, P x} :
o₁.attachWith P H = o₂.attachWith P fun x h => H _ (w h) := by
o₁.attachWith P H = o₂.attachWith P fun _ h => H _ (w h) := by
subst w
simp
@@ -128,12 +128,12 @@ theorem attach_map {o : Option α} (f : α → β) :
cases o <;> simp
theorem attachWith_map {o : Option α} (f : α β) {P : β Prop} {H : (b : β), b o.map f P b} :
(o.map f).attachWith P H = (o.attachWith (P f) (fun a h => H _ (mem_map_of_mem f h))).map
(o.map f).attachWith P H = (o.attachWith (P f) (fun _ h => H _ (mem_map_of_mem f h))).map
fun x, h => f x, h := by
cases o <;> simp
theorem map_attach {o : Option α} (f : { x // x o } β) :
o.attach.map f = o.pmap (fun a (h : a o) => f a, h) (fun a h => h) := by
o.attach.map f = o.pmap (fun a (h : a o) => f a, h) (fun _ h => h) := by
cases o <;> simp
theorem map_attachWith {o : Option α} {P : α Prop} {H : (a : α), a o P a}

View File

@@ -1148,23 +1148,23 @@ namespace String
/--
If `pre` is a prefix of `s`, i.e. `s = pre ++ t`, returns the remainder `t`.
-/
def dropPrefix? (s : String) (pre : Substring) : Option Substring :=
s.toSubstring.dropPrefix? pre
def dropPrefix? (s : String) (pre : String) : Option Substring :=
s.toSubstring.dropPrefix? pre.toSubstring
/--
If `suff` is a suffix of `s`, i.e. `s = t ++ suff`, returns the remainder `t`.
-/
def dropSuffix? (s : String) (suff : Substring) : Option Substring :=
s.toSubstring.dropSuffix? suff
def dropSuffix? (s : String) (suff : String) : Option Substring :=
s.toSubstring.dropSuffix? suff.toSubstring
/-- `s.stripPrefix pre` will remove `pre` from the beginning of `s` if it occurs there,
or otherwise return `s`. -/
def stripPrefix (s : String) (pre : Substring) : String :=
def stripPrefix (s : String) (pre : String) : String :=
s.dropPrefix? pre |>.map Substring.toString |>.getD s
/-- `s.stripSuffix suff` will remove `suff` from the end of `s` if it occurs there,
or otherwise return `s`. -/
def stripSuffix (s : String) (suff : Substring) : String :=
def stripSuffix (s : String) (suff : String) : String :=
s.dropSuffix? suff |>.map Substring.toString |>.getD s
end String

View File

@@ -4,21 +4,5 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yury G. Kudryashov
-/
prelude
import Init.Core
namespace Sum
deriving instance DecidableEq for Sum
deriving instance BEq for Sum
/-- Check if a sum is `inl` and if so, retrieve its contents. -/
def getLeft? : α β Option α
| inl a => some a
| inr _ => none
/-- Check if a sum is `inr` and if so, retrieve its contents. -/
def getRight? : α β Option β
| inr b => some b
| inl _ => none
end Sum
import Init.Data.Sum.Basic
import Init.Data.Sum.Lemmas

View File

@@ -0,0 +1,178 @@
/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yury G. Kudryashov
-/
prelude
import Init.PropLemmas
/-!
# Disjoint union of types
This file defines basic operations on the the sum type `α ⊕ β`.
`α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*.
## Main declarations
* `Sum.isLeft`: Returns whether `x : α ⊕ β` comes from the left component or not.
* `Sum.isRight`: Returns whether `x : α ⊕ β` comes from the right component or not.
* `Sum.getLeft`: Retrieves the left content of a `x : α ⊕ β` that is known to come from the left.
* `Sum.getRight`: Retrieves the right content of `x : α ⊕ β` that is known to come from the right.
* `Sum.getLeft?`: Retrieves the left content of `x : α ⊕ β` as an option type or returns `none`
if it's coming from the right.
* `Sum.getRight?`: Retrieves the right content of `x : α ⊕ β` as an option type or returns `none`
if it's coming from the left.
* `Sum.map`: Maps `α ⊕ β` to `γ ⊕ δ` component-wise.
* `Sum.elim`: Nondependent eliminator/induction principle for `α ⊕ β`.
* `Sum.swap`: Maps `α ⊕ β` to `β ⊕ α` by swapping components.
* `Sum.LiftRel`: The disjoint union of two relations.
* `Sum.Lex`: Lexicographic order on `α ⊕ β` induced by a relation on `α` and a relation on `β`.
## Further material
See `Batteries.Data.Sum.Lemmas` for theorems about these definitions.
## Notes
The definition of `Sum` takes values in `Type _`. This effectively forbids `Prop`- valued sum types.
To this effect, we have `PSum`, which takes value in `Sort _` and carries a more complicated
universe signature in consequence. The `Prop` version is `Or`.
-/
namespace Sum
deriving instance DecidableEq for Sum
deriving instance BEq for Sum
section get
/-- Check if a sum is `inl`. -/
def isLeft : α β Bool
| inl _ => true
| inr _ => false
/-- Check if a sum is `inr`. -/
def isRight : α β Bool
| inl _ => false
| inr _ => true
/-- Retrieve the contents from a sum known to be `inl`.-/
def getLeft : (ab : α β) ab.isLeft α
| inl a, _ => a
/-- Retrieve the contents from a sum known to be `inr`.-/
def getRight : (ab : α β) ab.isRight β
| inr b, _ => b
/-- Check if a sum is `inl` and if so, retrieve its contents. -/
def getLeft? : α β Option α
| inl a => some a
| inr _ => none
/-- Check if a sum is `inr` and if so, retrieve its contents. -/
def getRight? : α β Option β
| inr b => some b
| inl _ => none
@[simp] theorem isLeft_inl : (inl x : α β).isLeft = true := rfl
@[simp] theorem isLeft_inr : (inr x : α β).isLeft = false := rfl
@[simp] theorem isRight_inl : (inl x : α β).isRight = false := rfl
@[simp] theorem isRight_inr : (inr x : α β).isRight = true := rfl
@[simp] theorem getLeft_inl (h : (inl x : α β).isLeft) : (inl x).getLeft h = x := rfl
@[simp] theorem getRight_inr (h : (inr x : α β).isRight) : (inr x).getRight h = x := rfl
@[simp] theorem getLeft?_inl : (inl x : α β).getLeft? = some x := rfl
@[simp] theorem getLeft?_inr : (inr x : α β).getLeft? = none := rfl
@[simp] theorem getRight?_inl : (inl x : α β).getRight? = none := rfl
@[simp] theorem getRight?_inr : (inr x : α β).getRight? = some x := rfl
end get
/-- Define a function on `α ⊕ β` by giving separate definitions on `α` and `β`. -/
protected def elim {α β γ} (f : α γ) (g : β γ) : α β γ :=
fun x => Sum.casesOn x f g
@[simp] theorem elim_inl (f : α γ) (g : β γ) (x : α) :
Sum.elim f g (inl x) = f x := rfl
@[simp] theorem elim_inr (f : α γ) (g : β γ) (x : β) :
Sum.elim f g (inr x) = g x := rfl
/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/
protected def map (f : α α') (g : β β') : α β α' β' :=
Sum.elim (inl f) (inr g)
@[simp] theorem map_inl (f : α α') (g : β β') (x : α) : (inl x).map f g = inl (f x) := rfl
@[simp] theorem map_inr (f : α α') (g : β β') (x : β) : (inr x).map f g = inr (g x) := rfl
/-- Swap the factors of a sum type -/
def swap : α β β α := Sum.elim inr inl
@[simp] theorem swap_inl : swap (inl x : α β) = inr x := rfl
@[simp] theorem swap_inr : swap (inr x : α β) = inl x := rfl
section LiftRel
/-- Lifts pointwise two relations between `α` and `γ` and between `β` and `δ` to a relation between
`α ⊕ β` and `γ ⊕ δ`. -/
inductive LiftRel (r : α γ Prop) (s : β δ Prop) : α β γ δ Prop
/-- `inl a` and `inl c` are related via `LiftRel r s` if `a` and `c` are related via `r`. -/
| protected inl {a c} : r a c LiftRel r s (inl a) (inl c)
/-- `inr b` and `inr d` are related via `LiftRel r s` if `b` and `d` are related via `s`. -/
| protected inr {b d} : s b d LiftRel r s (inr b) (inr d)
@[simp] theorem liftRel_inl_inl : LiftRel r s (inl a) (inl c) r a c :=
fun h => by cases h; assumption, LiftRel.inl
@[simp] theorem not_liftRel_inl_inr : ¬LiftRel r s (inl a) (inr d) := nofun
@[simp] theorem not_liftRel_inr_inl : ¬LiftRel r s (inr b) (inl c) := nofun
@[simp] theorem liftRel_inr_inr : LiftRel r s (inr b) (inr d) s b d :=
fun h => by cases h; assumption, LiftRel.inr
instance {r : α γ Prop} {s : β δ Prop}
[ a c, Decidable (r a c)] [ b d, Decidable (s b d)] :
(ab : α β) (cd : γ δ), Decidable (LiftRel r s ab cd)
| inl _, inl _ => decidable_of_iff' _ liftRel_inl_inl
| inl _, inr _ => Decidable.isFalse not_liftRel_inl_inr
| inr _, inl _ => Decidable.isFalse not_liftRel_inr_inl
| inr _, inr _ => decidable_of_iff' _ liftRel_inr_inr
end LiftRel
section Lex
/-- Lexicographic order for sum. Sort all the `inl a` before the `inr b`, otherwise use the
respective order on `α` or `β`. -/
inductive Lex (r : α α Prop) (s : β β Prop) : α β α β Prop
/-- `inl a₁` and `inl a₂` are related via `Lex r s` if `a₁` and `a₂` are related via `r`. -/
| protected inl {a₁ a₂} (h : r a₁ a₂) : Lex r s (inl a₁) (inl a₂)
/-- `inr b₁` and `inr b₂` are related via `Lex r s` if `b₁` and `b₂` are related via `s`. -/
| protected inr {b₁ b₂} (h : s b₁ b₂) : Lex r s (inr b₁) (inr b₂)
/-- `inl a` and `inr b` are always related via `Lex r s`. -/
| sep (a b) : Lex r s (inl a) (inr b)
attribute [simp] Lex.sep
@[simp] theorem lex_inl_inl : Lex r s (inl a₁) (inl a₂) r a₁ a₂ :=
fun h => by cases h; assumption, Lex.inl
@[simp] theorem lex_inr_inr : Lex r s (inr b₁) (inr b₂) s b₁ b₂ :=
fun h => by cases h; assumption, Lex.inr
@[simp] theorem lex_inr_inl : ¬Lex r s (inr b) (inl a) := nofun
instance instDecidableRelSumLex [DecidableRel r] [DecidableRel s] : DecidableRel (Lex r s)
| inl _, inl _ => decidable_of_iff' _ lex_inl_inl
| inl _, inr _ => Decidable.isTrue (Lex.sep _ _)
| inr _, inl _ => Decidable.isFalse lex_inr_inl
| inr _, inr _ => decidable_of_iff' _ lex_inr_inr
end Lex
end Sum

View File

@@ -0,0 +1,251 @@
/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yury G. Kudryashov
-/
prelude
import Init.Data.Sum.Basic
import Init.Ext
/-!
# Disjoint union of types
Theorems about the definitions introduced in `Init.Data.Sum.Basic`.
-/
open Function
namespace Sum
@[simp] protected theorem «forall» {p : α β Prop} :
( x, p x) ( a, p (inl a)) b, p (inr b) :=
fun h => fun _ => h _, fun _ => h _, fun h₁, h₂ => Sum.rec h₁ h₂
@[simp] protected theorem «exists» {p : α β Prop} :
( x, p x) ( a, p (inl a)) b, p (inr b) :=
fun
| inl a, h => Or.inl a, h
| inr b, h => Or.inr b, h,
fun
| Or.inl a, h => inl a, h
| Or.inr b, h => inr b, h
theorem forall_sum {γ : α β Sort _} (p : ( ab, γ ab) Prop) :
( fab, p fab) ( fa fb, p (Sum.rec fa fb)) := by
refine fun h fa fb => h _, fun h fab => ?_
have h1 : fab = Sum.rec (fun a => fab (Sum.inl a)) (fun b => fab (Sum.inr b)) := by
apply funext
rintro (_ | _) <;> rfl
rw [h1]; exact h _ _
section get
@[simp] theorem inl_getLeft : (x : α β) (h : x.isLeft), inl (x.getLeft h) = x
| inl _, _ => rfl
@[simp] theorem inr_getRight : (x : α β) (h : x.isRight), inr (x.getRight h) = x
| inr _, _ => rfl
@[simp] theorem getLeft?_eq_none_iff {x : α β} : x.getLeft? = none x.isRight := by
cases x <;> simp only [getLeft?, isRight, eq_self_iff_true, reduceCtorEq]
@[simp] theorem getRight?_eq_none_iff {x : α β} : x.getRight? = none x.isLeft := by
cases x <;> simp only [getRight?, isLeft, eq_self_iff_true, reduceCtorEq]
theorem eq_left_getLeft_of_isLeft : {x : α β} (h : x.isLeft), x = inl (x.getLeft h)
| inl _, _ => rfl
@[simp] theorem getLeft_eq_iff (h : x.isLeft) : x.getLeft h = a x = inl a := by
cases x <;> simp at h
theorem eq_right_getRight_of_isRight : {x : α β} (h : x.isRight), x = inr (x.getRight h)
| inr _, _ => rfl
@[simp] theorem getRight_eq_iff (h : x.isRight) : x.getRight h = b x = inr b := by
cases x <;> simp at h
@[simp] theorem getLeft?_eq_some_iff : x.getLeft? = some a x = inl a := by
cases x <;> simp only [getLeft?, Option.some.injEq, inl.injEq, reduceCtorEq]
@[simp] theorem getRight?_eq_some_iff : x.getRight? = some b x = inr b := by
cases x <;> simp only [getRight?, Option.some.injEq, inr.injEq, reduceCtorEq]
@[simp] theorem bnot_isLeft (x : α β) : !x.isLeft = x.isRight := by cases x <;> rfl
@[simp] theorem isLeft_eq_false {x : α β} : x.isLeft = false x.isRight := by cases x <;> simp
theorem not_isLeft {x : α β} : ¬x.isLeft x.isRight := by simp
@[simp] theorem bnot_isRight (x : α β) : !x.isRight = x.isLeft := by cases x <;> rfl
@[simp] theorem isRight_eq_false {x : α β} : x.isRight = false x.isLeft := by cases x <;> simp
theorem not_isRight {x : α β} : ¬x.isRight x.isLeft := by simp
theorem isLeft_iff : x.isLeft y, x = Sum.inl y := by cases x <;> simp
theorem isRight_iff : x.isRight y, x = Sum.inr y := by cases x <;> simp
end get
theorem inl.inj_iff : (inl a : α β) = inl b a = b := inl.inj, congrArg _
theorem inr.inj_iff : (inr a : α β) = inr b a = b := inr.inj, congrArg _
theorem inl_ne_inr : inl a inr b := nofun
theorem inr_ne_inl : inr b inl a := nofun
/-! ### `Sum.elim` -/
@[simp] theorem elim_comp_inl (f : α γ) (g : β γ) : Sum.elim f g inl = f :=
rfl
@[simp] theorem elim_comp_inr (f : α γ) (g : β γ) : Sum.elim f g inr = g :=
rfl
@[simp] theorem elim_inl_inr : @Sum.elim α β _ inl inr = id :=
funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl
theorem comp_elim (f : γ δ) (g : α γ) (h : β γ) :
f Sum.elim g h = Sum.elim (f g) (f h) :=
funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl
@[simp] theorem elim_comp_inl_inr (f : α β γ) :
Sum.elim (f inl) (f inr) = f :=
funext fun x => Sum.casesOn x (fun _ => rfl) fun _ => rfl
theorem elim_eq_iff {u u' : α γ} {v v' : β γ} :
Sum.elim u v = Sum.elim u' v' u = u' v = v' := by
simp [funext_iff]
/-! ### `Sum.map` -/
@[simp] theorem map_map (f' : α' α'') (g' : β' β'') (f : α α') (g : β β') :
x : Sum α β, (x.map f g).map f' g' = x.map (f' f) (g' g)
| inl _ => rfl
| inr _ => rfl
@[simp] theorem map_comp_map (f' : α' α'') (g' : β' β'') (f : α α') (g : β β') :
Sum.map f' g' Sum.map f g = Sum.map (f' f) (g' g) :=
funext <| map_map f' g' f g
@[simp] theorem map_id_id : Sum.map (@id α) (@id β) = id :=
funext fun x => Sum.recOn x (fun _ => rfl) fun _ => rfl
theorem elim_map {f₁ : α β} {f₂ : β ε} {g₁ : γ δ} {g₂ : δ ε} {x} :
Sum.elim f₂ g₂ (Sum.map f₁ g₁ x) = Sum.elim (f₂ f₁) (g₂ g₁) x := by
cases x <;> rfl
theorem elim_comp_map {f₁ : α β} {f₂ : β ε} {g₁ : γ δ} {g₂ : δ ε} :
Sum.elim f₂ g₂ Sum.map f₁ g₁ = Sum.elim (f₂ f₁) (g₂ g₁) :=
funext fun _ => elim_map
@[simp] theorem isLeft_map (f : α β) (g : γ δ) (x : α γ) :
isLeft (x.map f g) = isLeft x := by
cases x <;> rfl
@[simp] theorem isRight_map (f : α β) (g : γ δ) (x : α γ) :
isRight (x.map f g) = isRight x := by
cases x <;> rfl
@[simp] theorem getLeft?_map (f : α β) (g : γ δ) (x : α γ) :
(x.map f g).getLeft? = x.getLeft?.map f := by
cases x <;> rfl
@[simp] theorem getRight?_map (f : α β) (g : γ δ) (x : α γ) :
(x.map f g).getRight? = x.getRight?.map g := by cases x <;> rfl
/-! ### `Sum.swap` -/
@[simp] theorem swap_swap (x : α β) : swap (swap x) = x := by cases x <;> rfl
@[simp] theorem swap_swap_eq : swap swap = @id (α β) := funext <| swap_swap
@[simp] theorem isLeft_swap (x : α β) : x.swap.isLeft = x.isRight := by cases x <;> rfl
@[simp] theorem isRight_swap (x : α β) : x.swap.isRight = x.isLeft := by cases x <;> rfl
@[simp] theorem getLeft?_swap (x : α β) : x.swap.getLeft? = x.getRight? := by cases x <;> rfl
@[simp] theorem getRight?_swap (x : α β) : x.swap.getRight? = x.getLeft? := by cases x <;> rfl
section LiftRel
theorem LiftRel.mono (hr : a b, r₁ a b r₂ a b) (hs : a b, s₁ a b s₂ a b)
(h : LiftRel r₁ s₁ x y) : LiftRel r₂ s₂ x y := by
cases h
· exact LiftRel.inl (hr _ _ _)
· exact LiftRel.inr (hs _ _ _)
theorem LiftRel.mono_left (hr : a b, r₁ a b r₂ a b) (h : LiftRel r₁ s x y) :
LiftRel r₂ s x y :=
(h.mono hr) fun _ _ => id
theorem LiftRel.mono_right (hs : a b, s₁ a b s₂ a b) (h : LiftRel r s₁ x y) :
LiftRel r s₂ x y :=
h.mono (fun _ _ => id) hs
protected theorem LiftRel.swap (h : LiftRel r s x y) : LiftRel s r x.swap y.swap := by
cases h
· exact LiftRel.inr _
· exact LiftRel.inl _
@[simp] theorem liftRel_swap_iff : LiftRel s r x.swap y.swap LiftRel r s x y :=
fun h => by rw [ swap_swap x, swap_swap y]; exact h.swap, LiftRel.swap
end LiftRel
section Lex
protected theorem LiftRel.lex {a b : α β} (h : LiftRel r s a b) : Lex r s a b := by
cases h
· exact Lex.inl _
· exact Lex.inr _
theorem liftRel_subrelation_lex : Subrelation (LiftRel r s) (Lex r s) := LiftRel.lex
theorem Lex.mono (hr : a b, r₁ a b r₂ a b) (hs : a b, s₁ a b s₂ a b) (h : Lex r₁ s₁ x y) :
Lex r₂ s₂ x y := by
cases h
· exact Lex.inl (hr _ _ _)
· exact Lex.inr (hs _ _ _)
· exact Lex.sep _ _
theorem Lex.mono_left (hr : a b, r₁ a b r₂ a b) (h : Lex r₁ s x y) : Lex r₂ s x y :=
(h.mono hr) fun _ _ => id
theorem Lex.mono_right (hs : a b, s₁ a b s₂ a b) (h : Lex r s₁ x y) : Lex r s₂ x y :=
h.mono (fun _ _ => id) hs
theorem lex_acc_inl (aca : Acc r a) : Acc (Lex r s) (inl a) := by
induction aca with
| intro _ _ IH =>
constructor
intro y h
cases h with
| inl h' => exact IH _ h'
theorem lex_acc_inr (aca : a, Acc (Lex r s) (inl a)) {b} (acb : Acc s b) :
Acc (Lex r s) (inr b) := by
induction acb with
| intro _ _ IH =>
constructor
intro y h
cases h with
| inr h' => exact IH _ h'
| sep => exact aca _
theorem lex_wf (ha : WellFounded r) (hb : WellFounded s) : WellFounded (Lex r s) :=
have aca : a, Acc (Lex r s) (inl a) := fun a => lex_acc_inl (ha.apply a)
fun x => Sum.recOn x aca fun b => lex_acc_inr aca (hb.apply b)
end Lex
theorem elim_const_const (c : γ) :
Sum.elim (const _ c : α γ) (const _ c : β γ) = const _ c := by
apply funext
rintro (_ | _) <;> rfl
@[simp] theorem elim_lam_const_lam_const (c : γ) :
Sum.elim (fun _ : α => c) (fun _ : β => c) = fun _ => c :=
Sum.elim_const_const c

View File

@@ -224,11 +224,7 @@ structure Config where
-/
index : Bool := true
/--
When `true` (default: `true`), `simp` will **not** create a proof for a rewriting rule associated
with an `rfl`-theorem.
Rewriting rules are provided by users by annotating theorems with the attribute `@[simp]`.
If the proof of the theorem is just `rfl` (reflexivity), and `implicitDefEqProofs := true`, `simp`
will **not** create a proof term which is an application of the annotated theorem.
This option does not have any effect (yet).
-/
implicitDefEqProofs : Bool := true
deriving Inhabited, BEq

View File

@@ -10,6 +10,7 @@ import Init.Data.ToString.Basic
import Init.Data.Array.Subarray
import Init.Conv
import Init.Meta
import Init.While
namespace Lean
@@ -168,9 +169,9 @@ end Lean
| _ => throw ()
@[app_unexpander sorryAx] def unexpandSorryAx : Lean.PrettyPrinter.Unexpander
| `($(_) _) => `(sorry)
| `($(_) _ _) => `(sorry)
| _ => throw ()
| `($(_) $_) => `(sorry)
| `($(_) $_ $_) => `(sorry)
| _ => throw ()
@[app_unexpander Eq.ndrec] def unexpandEqNDRec : Lean.PrettyPrinter.Unexpander
| `($(_) $m $h) => `($h $m)
@@ -344,42 +345,6 @@ syntax (name := solveTactic) "solve" withPosition((ppDedent(ppLine) colGe "| " t
macro_rules
| `(tactic| solve $[| $ts]* ) => `(tactic| focus first $[| ($ts); done]*)
/-! # `repeat` and `while` notation -/
inductive Loop where
| mk
@[inline]
partial def Loop.forIn {β : Type u} {m : Type u Type v} [Monad m] (_ : Loop) (init : β) (f : Unit β m (ForInStep β)) : m β :=
let rec @[specialize] loop (b : β) : m β := do
match f () b with
| ForInStep.done b => pure b
| ForInStep.yield b => loop b
loop init
instance : ForIn m Loop Unit where
forIn := Loop.forIn
syntax "repeat " doSeq : doElem
macro_rules
| `(doElem| repeat $seq) => `(doElem| for _ in Loop.mk do $seq)
syntax "while " ident " : " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $h : $cond do $seq) => `(doElem| repeat if $h : $cond then $seq else break)
syntax "while " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $cond do $seq) => `(doElem| repeat if $cond then $seq else break)
syntax "repeat " doSeq ppDedent(ppLine) "until " term : doElem
macro_rules
| `(doElem| repeat $seq until $cond) => `(doElem| repeat do $seq:doSeq; if $cond then break)
macro:50 e:term:51 " matches " p:sepBy1(term:51, " | ") : term =>
`(((match $e:term with | $[$p:term]|* => true | _ => false) : Bool))

View File

@@ -135,6 +135,10 @@ Both reduce to `b = false ∧ c = false` via `not_or`.
theorem not_and_of_not_or_not (h : ¬a ¬b) : ¬(a b) := h.elim (mt (·.1)) (mt (·.2))
/-! ## not equal -/
theorem ne_of_apply_ne {α β : Sort _} (f : α β) {x y : α} : f x f y x y :=
mt <| congrArg _
/-! ## Ite -/
@@ -384,6 +388,17 @@ theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬p) : (∀ h' :
end quantifiers
/-! ## membership -/
section Mem
variable [Membership α β] {s t : β} {a b : α}
theorem ne_of_mem_of_not_mem (h : a s) : b s a b := mt fun e => e h
theorem ne_of_mem_of_not_mem' (h : a s) : a t s t := mt fun e => e h
end Mem
/-! ## Nonempty -/
@[simp] theorem nonempty_prop {p : Prop} : Nonempty p p :=

View File

@@ -268,9 +268,9 @@ syntax (name := case') "case' " sepBy1(caseArg, " | ") " => " tacticSeq : tactic
`next x₁ ... xₙ => tac` additionally renames the `n` most recent hypotheses with
inaccessible names to the given names.
-/
macro "next " args:binderIdent* arrowTk:" => " tac:tacticSeq : tactic =>
macro nextTk:"next " args:binderIdent* arrowTk:" => " tac:tacticSeq : tactic =>
-- Limit ref variability for incrementality; see Note [Incremental Macros]
withRef arrowTk `(tactic| case _ $args* =>%$arrowTk $tac)
withRef arrowTk `(tactic| case%$nextTk _ $args* =>%$arrowTk $tac)
/-- `all_goals tac` runs `tac` on each goal, concatenating the resulting goals, if any. -/
syntax (name := allGoals) "all_goals " tacticSeq : tactic

51
src/Init/While.lean Normal file
View File

@@ -0,0 +1,51 @@
/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
/-!
# Notation for `while` and `repeat` loops.
-/
namespace Lean
/-! # `repeat` and `while` notation -/
inductive Loop where
| mk
@[inline]
partial def Loop.forIn {β : Type u} {m : Type u Type v} [Monad m] (_ : Loop) (init : β) (f : Unit β m (ForInStep β)) : m β :=
let rec @[specialize] loop (b : β) : m β := do
match f () b with
| ForInStep.done b => pure b
| ForInStep.yield b => loop b
loop init
instance : ForIn m Loop Unit where
forIn := Loop.forIn
syntax "repeat " doSeq : doElem
macro_rules
| `(doElem| repeat $seq) => `(doElem| for _ in Loop.mk do $seq)
syntax "while " ident " : " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $h : $cond do $seq) => `(doElem| repeat if $h : $cond then $seq else break)
syntax "while " termBeforeDo " do " doSeq : doElem
macro_rules
| `(doElem| while $cond do $seq) => `(doElem| repeat if $cond then $seq else break)
syntax "repeat " doSeq ppDedent(ppLine) "until " term : doElem
macro_rules
| `(doElem| repeat $seq until $cond) => `(doElem| repeat do $seq:doSeq; if $cond then break)
end Lean

View File

@@ -29,7 +29,6 @@ import Lean.Server
import Lean.ScopedEnvExtension
import Lean.DocString
import Lean.DeclarationRange
import Lean.LazyInitExtension
import Lean.LoadDynlib
import Lean.Widget
import Lean.Log

View File

@@ -369,8 +369,13 @@ def RecursorVal.getFirstIndexIdx (v : RecursorVal) : Nat :=
def RecursorVal.getFirstMinorIdx (v : RecursorVal) : Nat :=
v.numParams + v.numMotives
def RecursorVal.getInduct (v : RecursorVal) : Name :=
v.name.getPrefix
/-- The inductive type of the major argument of the recursor. -/
def RecursorVal.getMajorInduct (v : RecursorVal) : Name :=
go v.getMajorIdx v.type
where
go
| 0, e => e.bindingDomain!.getAppFn.constName!
| n+1, e => go n e.bindingBody!
inductive QuotKind where
| type -- `Quot`

View File

@@ -12,16 +12,18 @@ import Lean.Elab.Eval
import Lean.Elab.Command
import Lean.Elab.Open
import Lean.Elab.SetOption
import Init.System.Platform
namespace Lean.Elab.Command
@[builtin_command_elab moduleDoc] def elabModuleDoc : CommandElab := fun stx => do
match stx[1] with
| Syntax.atom _ val =>
let doc := val.extract 0 (val.endPos - 2)
let range Elab.getDeclarationRange stx
modifyEnv fun env => addMainModuleDoc env doc, range
| _ => throwErrorAt stx "unexpected module doc string{indentD stx[1]}"
match stx[1] with
| Syntax.atom _ val =>
let doc := val.extract 0 (val.endPos - 2)
let some range Elab.getDeclarationRange? stx
| return -- must be from partial syntax, ignore
modifyEnv fun env => addMainModuleDoc env doc, range
| _ => throwErrorAt stx "unexpected module doc string{indentD stx[1]}"
private def addScope (isNewNamespace : Bool) (isNoncomputable : Bool) (header : String) (newNamespace : Name) : CommandElabM Unit := do
modify fun s => { s with
@@ -403,6 +405,16 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
includedVars := sc.includedVars.filter (!omittedVars.contains ·) }
| _ => throwUnsupportedSyntax
@[builtin_command_elab version] def elabVersion : CommandElab := fun _ => do
let mut target := System.Platform.target
if target.isEmpty then target := "unknown"
-- Only one should be set, but good to know if multiple are set in error.
let platforms :=
(if System.Platform.isWindows then [" Windows"] else [])
++ (if System.Platform.isOSX then [" macOS"] else [])
++ (if System.Platform.isEmscripten then [" Emscripten"] else [])
logInfo m!"Lean {Lean.versionString}\nTarget: {target}{String.join platforms}"
@[builtin_command_elab Parser.Command.exit] def elabExit : CommandElab := fun _ =>
logWarning "using 'exit' to interrupt Lean"

View File

@@ -84,7 +84,7 @@ private def addAndCompileExprForEval (declName : Name) (value : Expr) (allowSorr
-- An alternative design would be to make `elabTermForEval` into a term elaborator and elaborate the command all at once
-- with `unsafe def _eval := term_for_eval% $t`, which we did try, but unwanted error messages
-- such as "failed to infer definition type" can surface.
let defView := mkDefViewOfDef { isUnsafe := true }
let defView := mkDefViewOfDef { isUnsafe := true, stx := .missing }
( `(Parser.Command.definition|
def $(mkIdent <| `_root_ ++ declName) := $( Term.exprToSyntax value)))
Term.elabMutualDef #[] { header := "" } #[defView]

View File

@@ -135,13 +135,21 @@ open Meta
| _ => Macro.throwUnsupported
@[builtin_macro Lean.Parser.Term.suffices] def expandSuffices : Macro
| `(suffices%$tk $x:ident : $type from $val; $body) => `(have%$tk $x : $type := $body; $val)
| `(suffices%$tk _%$x : $type from $val; $body) => `(have%$tk _%$x : $type := $body; $val)
| `(suffices%$tk $hy:hygieneInfo $type from $val; $body) => `(have%$tk $hy:hygieneInfo : $type := $body; $val)
| `(suffices%$tk $x:ident : $type by%$b $tac:tacticSeq; $body) => `(have%$tk $x : $type := $body; by%$b $tac)
| `(suffices%$tk _%$x : $type by%$b $tac:tacticSeq; $body) => `(have%$tk _%$x : $type := $body; by%$b $tac)
| `(suffices%$tk $hy:hygieneInfo $type by%$b $tac:tacticSeq; $body) => `(have%$tk $hy:hygieneInfo : $type := $body; by%$b $tac)
| _ => Macro.throwUnsupported
| `(suffices%$tk $x:ident : $type from $val; $body) => `(have%$tk $x : $type := $body; $val)
| `(suffices%$tk _%$x : $type from $val; $body) => `(have%$tk _%$x : $type := $body; $val)
| `(suffices%$tk $hy:hygieneInfo $type from $val; $body) => `(have%$tk $hy:hygieneInfo : $type := $body; $val)
| `(suffices%$tk $x:ident : $type $b:byTactic'; $body) =>
-- Pass on `SourceInfo` of `b` to `have`. This is necessary to display the goal state in the
-- trailing whitespace of `by` and sound since `byTactic` and `byTactic'` are identical.
let b := b.raw.setKind `Lean.Parser.Term.byTactic
`(have%$tk $x : $type := $body; $b:byTactic)
| `(suffices%$tk _%$x : $type $b:byTactic'; $body) =>
let b := b.raw.setKind `Lean.Parser.Term.byTactic
`(have%$tk _%$x : $type := $body; $b:byTactic)
| `(suffices%$tk $hy:hygieneInfo $type $b:byTactic'; $body) =>
let b := b.raw.setKind `Lean.Parser.Term.byTactic
`(have%$tk $hy:hygieneInfo : $type := $body; $b:byTactic)
| _ => Macro.throwUnsupported
open Lean.Parser in
private def elabParserMacroAux (prec e : Term) (withAnonymousAntiquot : Bool) : TermElabM Syntax := do

View File

@@ -57,6 +57,7 @@ inductive RecKind where
/-- Flags and data added to declarations (eg docstrings, attributes, `private`, `unsafe`, `partial`, ...). -/
structure Modifiers where
stx : TSyntax ``Parser.Command.declModifiers
docString? : Option String := none
visibility : Visibility := Visibility.regular
isNoncomputable : Bool := false
@@ -121,16 +122,16 @@ section Methods
variable [Monad m] [MonadEnv m] [MonadResolveName m] [MonadError m] [MonadMacroAdapter m] [MonadRecDepth m] [MonadTrace m] [MonadOptions m] [AddMessageContext m] [MonadLog m] [MonadInfoTree m] [MonadLiftT IO m]
/-- Elaborate declaration modifiers (i.e., attributes, `partial`, `private`, `protected`, `unsafe`, `noncomputable`, doc string)-/
def elabModifiers (stx : Syntax) : m Modifiers := do
let docCommentStx := stx[0]
let attrsStx := stx[1]
let visibilityStx := stx[2]
let noncompStx := stx[3]
let unsafeStx := stx[4]
def elabModifiers (stx : TSyntax ``Parser.Command.declModifiers) : m Modifiers := do
let docCommentStx := stx.raw[0]
let attrsStx := stx.raw[1]
let visibilityStx := stx.raw[2]
let noncompStx := stx.raw[3]
let unsafeStx := stx.raw[4]
let recKind :=
if stx[5].isNone then
if stx.raw[5].isNone then
RecKind.default
else if stx[5][0].getKind == ``Parser.Command.partial then
else if stx.raw[5][0].getKind == ``Parser.Command.partial then
RecKind.partial
else
RecKind.nonrec
@@ -148,7 +149,7 @@ def elabModifiers (stx : Syntax) : m Modifiers := do
| none => pure #[]
| some attrs => elabDeclAttrs attrs
return {
docString?, visibility, recKind, attrs,
stx, docString?, visibility, recKind, attrs,
isUnsafe := !unsafeStx.isNone
isNoncomputable := !noncompStx.isNone
}

View File

@@ -104,7 +104,7 @@ def elabAxiom (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit := do
let (binders, typeStx) := expandDeclSig stx[2]
let scopeLevelNames getLevelNames
let _, declName, allUserLevelNames expandDeclId declId modifiers
addDeclarationRanges declName stx
addDeclarationRanges declName modifiers.stx stx
runTermElabM fun vars =>
Term.withDeclName declName <| Term.withLevelNames allUserLevelNames <| Term.elabBinders binders.getArgs fun xs => do
Term.applyAttributesAt declName modifiers.attrs AttributeApplicationTime.beforeElaboration
@@ -144,10 +144,10 @@ private def inductiveSyntaxToView (modifiers : Modifiers) (decl : Syntax) : Comm
let (binders, type?) := expandOptDeclSig decl[2]
let declId := decl[1]
let name, declName, levelNames expandDeclId declId modifiers
addDeclarationRanges declName decl
addDeclarationRanges declName modifiers.stx decl
let ctors decl[4].getArgs.mapM fun ctor => withRef ctor do
-- def ctor := leading_parser optional docComment >> "\n| " >> declModifiers >> rawIdent >> optDeclSig
let mut ctorModifiers elabModifiers ctor[2]
let mut ctorModifiers elabModifiers ctor[2]
if let some leadingDocComment := ctor[0].getOptional? then
if ctorModifiers.docString?.isSome then
logErrorAt leadingDocComment "duplicate doc string"
@@ -214,17 +214,18 @@ def elabDeclaration : CommandElab := fun stx => do
-- only case implementing incrementality currently
elabMutualDef #[stx]
else withoutCommandIncrementality true do
let modifiers : TSyntax ``Parser.Command.declModifiers := stx[0]
if declKind == ``Lean.Parser.Command.«axiom» then
let modifiers elabModifiers stx[0]
let modifiers elabModifiers modifiers
elabAxiom modifiers decl
else if declKind == ``Lean.Parser.Command.«inductive» then
let modifiers elabModifiers stx[0]
let modifiers elabModifiers modifiers
elabInductive modifiers decl
else if declKind == ``Lean.Parser.Command.classInductive then
let modifiers elabModifiers stx[0]
let modifiers elabModifiers modifiers
elabClassInductive modifiers decl
else if declKind == ``Lean.Parser.Command.«structure» then
let modifiers elabModifiers stx[0]
let modifiers elabModifiers modifiers
elabStructure modifiers decl
else
throwError "unexpected declaration"
@@ -238,7 +239,7 @@ private def isMutualInductive (stx : Syntax) : Bool :=
private def elabMutualInductive (elems : Array Syntax) : CommandElabM Unit := do
let views elems.mapM fun stx => do
let modifiers elabModifiers stx[0]
let modifiers elabModifiers stx[0]
inductiveSyntaxToView modifiers stx[1]
elabInductiveViews views
@@ -399,7 +400,7 @@ def elabMutual : CommandElab := fun stx => do
-- We need to add `id`'s ranges *before* elaborating `initFn` (and then `id` itself) as
-- otherwise the info context created by `with_decl_name` will be incomplete and break the
-- call hierarchy
addDeclarationRanges fullId defStx
addDeclarationRanges fullId defStx.raw[0] defStx.raw[1]
elabCommand ( `(
$[unsafe%$unsafe?]? def initFn : IO $type := with_decl_name% $(mkIdent fullId) do $doSeq
$defStx:command))

View File

@@ -11,12 +11,14 @@ import Lean.Data.Lsp.Utf16
namespace Lean.Elab
def getDeclarationRange [Monad m] [MonadFileMap m] (stx : Syntax) : m DeclarationRange := do
def getDeclarationRange? [Monad m] [MonadFileMap m] (stx : Syntax) : m (Option DeclarationRange) := do
let some range := stx.getRange?
| return none
let fileMap getFileMap
let pos := stx.getPos?.getD 0
let endPos := stx.getTailPos?.getD pos |> fileMap.toPosition
let pos := pos |> fileMap.toPosition
return {
--let range := fileMap.utf8RangeToLspRange
let pos := fileMap.toPosition range.start
let endPos := fileMap.toPosition range.stop
return some {
pos := pos
charUtf16 := fileMap.leanPosToLspPos pos |>.character
endPos := endPos
@@ -49,23 +51,27 @@ def getDeclarationSelectionRef (stx : Syntax) : Syntax :=
/--
Store the `range` and `selectionRange` for `declName` where `stx` is the whole syntax object describing `declName`.
This method is for the builtin declarations only.
User-defined commands should use `Lean.addDeclarationRanges` to store this information for their commands. -/
def addDeclarationRanges [Monad m] [MonadEnv m] [MonadFileMap m] (declName : Name) (stx : Syntax) : m Unit := do
if stx.getKind == ``Parser.Command.«example» then
Stores the `range` and `selectionRange` for `declName` where `modsStx` is the modifier part and
`cmdStx` the remaining part of the syntax tree for `declName`.
This method is for the builtin declarations only. User-defined commands should use
`Lean.addDeclarationRanges` to store this information for their commands.
-/
def addDeclarationRanges [Monad m] [MonadEnv m] [MonadFileMap m] (declName : Name)
(modsStx : TSyntax ``Parser.Command.declModifiers) (declStx : Syntax) : m Unit := do
if declStx.getKind == ``Parser.Command.«example» then
return ()
else
Lean.addDeclarationRanges declName {
range := ( getDeclarationRange stx)
selectionRange := ( getDeclarationRange (getDeclarationSelectionRef stx))
}
let stx := mkNullNode #[modsStx, declStx]
-- may fail on partial syntax, ignore in that case
let some range getDeclarationRange? stx | return
let some selectionRange getDeclarationRange? (getDeclarationSelectionRef declStx) | return
Lean.addDeclarationRanges declName { range, selectionRange }
/-- Auxiliary method for recording ranges for auxiliary declarations (e.g., fields, nested declarations, etc. -/
def addAuxDeclarationRanges [Monad m] [MonadEnv m] [MonadFileMap m] (declName : Name) (stx : Syntax) (header : Syntax) : m Unit := do
Lean.addDeclarationRanges declName {
range := ( getDeclarationRange stx)
selectionRange := ( getDeclarationRange header)
}
-- may fail on partial syntax, ignore in that case
let some range getDeclarationRange? stx | return
let some selectionRange getDeclarationRange? header | return
Lean.addDeclarationRanges declName { range, selectionRange }
end Lean.Elab

View File

@@ -102,7 +102,7 @@ partial def IO.processCommandsIncrementally (inputCtx : Parser.InputContext)
where
go initialSnap t commands :=
let snap := t.get
let commands := commands.push snap.data.stx
let commands := commands.push snap.data
if let some next := snap.nextCmdSnap? then
go initialSnap next.task commands
else
@@ -111,13 +111,15 @@ where
let messages := toSnapshotTree initialSnap
|>.getAll.map (·.diagnostics.msgLog)
|>.foldl (· ++ ·) {}
let trees := toSnapshotTree initialSnap
|>.getAll.map (·.infoTree?) |>.filterMap id |>.toPArray'
-- In contrast to messages, we should collect info trees only from the top-level command
-- snapshots as they subsume any info trees reported incrementally by their children.
let trees := commands.map (·.finishedSnap.get.infoTree?) |>.filterMap id |>.toPArray'
return {
commandState := { snap.data.finishedSnap.get.cmdState with messages, infoState.trees := trees }
parserState := snap.data.parserState
cmdPos := snap.data.parserState.pos
inputCtx, initialSnap, commands
commands := commands.map (·.stx)
inputCtx, initialSnap
}
def IO.processCommands (inputCtx : Parser.InputContext) (parserState : Parser.ModuleParserState)

View File

@@ -90,6 +90,7 @@ private def elabLetRecDeclValues (view : LetRecView) : TermElabM (Array Expr) :=
for i in [0:view.binderIds.size] do
addLocalVarInfo view.binderIds[i]! xs[i]!
withDeclName view.declName do
withInfoContext' view.valStx (mkInfo := mkTermInfo `MutualDef.body view.valStx) do
let value elabTermEnsuringType view.valStx type
mkLambdaFVars xs value

View File

@@ -410,11 +410,15 @@ private def elabFunValues (headers : Array DefViewElabHeader) (vars : Array Expr
-- skip auto-bound prefix in `xs`
addLocalVarInfo header.binderIds[i] xs[header.numParams - header.binderIds.size + i]!
let val withReader ({ · with tacSnap? := header.tacSnap? }) do
-- synthesize mvars here to force the top-level tactic block (if any) to run
elabTermEnsuringType valStx type <* synthesizeSyntheticMVarsNoPostponing
-- NOTE: without this `instantiatedMVars`, `mkLambdaFVars` may leave around a redex that
-- leads to more section variables being included than necessary
let val instantiateMVarsProfiling val
-- Store instantiated body in info tree for the benefit of the unused variables linter
-- and other metaprograms that may want to inspect it without paying for the instantiation
-- again
withInfoContext' valStx (mkInfo := mkTermInfo `MutualDef.body valStx) do
-- synthesize mvars here to force the top-level tactic block (if any) to run
let val elabTermEnsuringType valStx type <* synthesizeSyntheticMVarsNoPostponing
-- NOTE: without this `instantiatedMVars`, `mkLambdaFVars` may leave around a redex that
-- leads to more section variables being included than necessary
instantiateMVarsProfiling val
let val mkLambdaFVars xs val
if linter.unusedSectionVars.get ( getOptions) && !header.type.hasSorry && !val.hasSorry then
let unusedVars vars.filterMapM fun var => do
@@ -883,6 +887,7 @@ def getKindForLetRecs (mainHeaders : Array DefViewElabHeader) : DefKind :=
else DefKind.«def»
def getModifiersForLetRecs (mainHeaders : Array DefViewElabHeader) : Modifiers := {
stx := mkNullNode #[] -- ignore when computing declaration range
isNoncomputable := mainHeaders.any fun h => h.modifiers.isNoncomputable
recKind := if mainHeaders.any fun h => h.modifiers.isPartial then RecKind.partial else RecKind.default
isUnsafe := mainHeaders.any fun h => h.modifiers.isUnsafe
@@ -993,7 +998,7 @@ where
for view in views, header in headers do
-- NOTE: this should be the full `ref`, and thus needs to be done after any snapshotting
-- that depends only on a part of the ref
addDeclarationRanges header.declName view.ref
addDeclarationRanges header.declName view.modifiers.stx view.ref
processDeriving (headers : Array DefViewElabHeader) := do
@@ -1017,7 +1022,7 @@ def elabMutualDef (ds : Array Syntax) : CommandElabM Unit := do
let mut reusedAllHeaders := true
for h : i in [0:ds.size], headerPromise in headerPromises do
let d := ds[i]
let modifiers elabModifiers d[0]
let modifiers elabModifiers d[0]
if ds.size > 1 && modifiers.isNonrec then
throwErrorAt d "invalid use of 'nonrec' modifier in 'mutual' block"
let mut view mkDefView modifiers d[1]

View File

@@ -221,7 +221,7 @@ def addAndCompilePartialRec (preDefs : Array PreDefinition) : TermElabM Unit :=
else
none
| _ => none
modifiers := {} }
modifiers := default }
private def containsRecFn (recFnNames : Array Name) (e : Expr) : Bool :=
(e.find? fun e => e.isConst && recFnNames.contains e.constName!).isSome

View File

@@ -212,21 +212,21 @@ def mkBRecOnMotive (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
/--
Calculates the `.brecOn` functional argument corresponding to one structural recursive function.
The `value` is the function with (only) the fixed parameters moved into the context,
The `type` is the expected type of the argument.
The `FType` is the expected type of the argument.
The `recArgInfos` is used to transform the body of the function to replace recursive calls with
uses of the `below` induction hypothesis.
-/
def mkBRecOnF (recArgInfos : Array RecArgInfo) (positions : Positions)
(recArgInfo : RecArgInfo) (value : Expr) (FType : Expr) : M Expr := do
lambdaTelescope value fun xs value => do
let (indexMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
let FType instantiateForall FType indexMajorArgs
let (indicesMajorArgs, otherArgs) := recArgInfo.pickIndicesMajor xs
let FType instantiateForall FType indicesMajorArgs
forallBoundedTelescope FType (some 1) fun below _ => do
-- TODO: `below` user name is `f`, and it will make a global `f` to be pretty printed as `_root_.f` in error messages.
-- We should add an option to `forallBoundedTelescope` to ensure fresh names are used.
let below := below[0]!
let valueNew replaceRecApps recArgInfos positions below value
mkLambdaFVars (indexMajorArgs ++ #[below] ++ otherArgs) valueNew
let valueNew replaceRecApps recArgInfos positions below value
mkLambdaFVars (indicesMajorArgs ++ #[below] ++ otherArgs) valueNew
/--
Given the `motives`, figures out whether to use `.brecOn` or `.binductionOn`, pass
@@ -264,7 +264,7 @@ def inferBRecOnFTypes (recArgInfos : Array RecArgInfo) (positions : Positions)
(brecOnConst : Nat Expr) : MetaM (Array Expr) := do
let numTypeFormers := positions.size
let recArgInfo := recArgInfos[0]! -- pick an arbitrary one
let brecOn := brecOnConst 0
let brecOn := brecOnConst recArgInfo.indIdx
check brecOn
let brecOnType inferType brecOn
-- Skip the indices and major argument

View File

@@ -77,7 +77,7 @@ def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) :
if !indIndices.all Expr.isFVar then
throwError "its type {indInfo.name} is an inductive family and indices are not variables{indentExpr xType}"
else if !indIndices.allDiff then
throwError " its type {indInfo.name} is an inductive family and indices are not pairwise distinct{indentExpr xType}"
throwError "its type {indInfo.name} is an inductive family and indices are not pairwise distinct{indentExpr xType}"
else
let indexMinPos := getIndexMinPos xs indIndices
let numFixed := if indexMinPos < numFixed then indexMinPos else numFixed

View File

@@ -107,9 +107,9 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
check valueNew
return #[{ preDef with value := valueNew }]
-- Sort the (indices of the) definitions by their position in indInfo.all
-- Groups the (indices of the) definitions by their position in indInfo.all
let positions : Positions := .groupAndSort (·.indIdx) recArgInfos (Array.range indInfo.numTypeFormers)
trace[Elab.definition.structural] "positions: {positions}"
trace[Elab.definition.structural] "assignments of type formers of {indInfo.name} to functions: {positions}"
-- Construct the common `.brecOn` arguments
let motives (Array.zip recArgInfos values).mapM fun (r, v) => mkBRecOnMotive r v
@@ -117,7 +117,7 @@ private def elimMutualRecursion (preDefs : Array PreDefinition) (xs : Array Expr
let brecOnConst mkBRecOnConst recArgInfos positions motives
let FTypes inferBRecOnFTypes recArgInfos positions brecOnConst
trace[Elab.definition.structural] "FTypes: {FTypes}"
let FArgs (recArgInfos.zip (values.zip FTypes)).mapM fun (r, (v, t)) =>
let FArgs (recArgInfos.zip (values.zip FTypes)).mapM fun (r, (v, t)) =>
mkBRecOnF recArgInfos positions r v t
trace[Elab.definition.structural] "FArgs: {FArgs}"
-- Assemble the individual `.brecOn` applications

View File

@@ -15,7 +15,7 @@ partial def addSmartUnfoldingDefAux (preDef : PreDefinition) (recArgPos : Nat) :
return { preDef with
declName := mkSmartUnfoldingNameFor preDef.declName
value := ( visit preDef.value)
modifiers := {}
modifiers := default
}
where
/--

View File

@@ -95,7 +95,7 @@ private def expandCtor (structStx : Syntax) (structModifiers : Modifiers) (struc
let declName := structDeclName ++ defaultCtorName
let ref := structStx[1].mkSynthetic
addAuxDeclarationRanges declName ref ref
pure { ref, modifiers := {}, name := defaultCtorName, declName }
pure { ref, modifiers := default, name := defaultCtorName, declName }
if structStx[5].isNone then
useDefault
else
@@ -912,7 +912,7 @@ def elabStructure (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit :=
let scopeLevelNames Term.getLevelNames
let name, declName, allUserLevelNames Elab.expandDeclId ( getCurrNamespace) scopeLevelNames declId modifiers
Term.withAutoBoundImplicitForbiddenPred (fun n => name == n) do
addDeclarationRanges declName stx
addDeclarationRanges declName modifiers.stx stx
Term.withDeclName declName do
let ctor expandCtor stx modifiers declName
let fields expandFields stx modifiers declName

View File

@@ -146,7 +146,7 @@ where
let args args.mapM fun arg => withNestedParser do process arg
mkParserSeq args
else
let args args.mapIdxM fun i arg => withReader (fun ctx => { ctx with first := ctx.first && i.val == 0 }) do process arg
let args args.mapIdxM fun i arg => withReader (fun ctx => { ctx with first := ctx.first && i == 0 }) do process arg
mkParserSeq args
ensureNoPrec (stx : Syntax) :=

View File

@@ -65,202 +65,218 @@ def getNatOrBvValue? (ty : Expr) (expr : Expr) : M (Option Nat) := do
| _ => return none
/--
Reify an `Expr` that's a `BitVec`.
Construct an uninterpreted `BitVec` atom from `x`.
-/
def bitVecAtom (x : Expr) : M (Option ReifiedBVExpr) := do
let t instantiateMVars ( whnfR ( inferType x))
let_expr BitVec widthExpr := t | return none
let some width getNatValue? widthExpr | return none
let atom mkAtom x width
return some atom
/--
Reify an `Expr` that's a constant-width `BitVec`.
Unless this function is called on something that is not a constant-width `BitVec` it is always
going to return `some`.
-/
partial def of (x : Expr) : M (Option ReifiedBVExpr) := do
match_expr x with
| BitVec.ofNat _ _ => goBvLit x
| HAnd.hAnd _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.BitVec.and_congr
| HOr.hOr _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .or ``Std.Tactic.BVDecide.Reflect.BitVec.or_congr
| HXor.hXor _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.BitVec.xor_congr
| HAdd.hAdd _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .add ``Std.Tactic.BVDecide.Reflect.BitVec.add_congr
| HMul.hMul _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .mul ``Std.Tactic.BVDecide.Reflect.BitVec.mul_congr
| HDiv.hDiv _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .udiv ``Std.Tactic.BVDecide.Reflect.BitVec.udiv_congr
| HMod.hMod _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .umod ``Std.Tactic.BVDecide.Reflect.BitVec.umod_congr
| Complement.complement _ _ innerExpr =>
unaryReflection innerExpr .not ``Std.Tactic.BVDecide.Reflect.BitVec.not_congr
| HShiftLeft.hShiftLeft _ β _ _ innerExpr distanceExpr =>
let distance? getNatOrBvValue? β distanceExpr
if distance?.isSome then
shiftConstReflection
β
distanceExpr
goOrAtom x
where
/--
Reify `x`, returns `none` if the reification procedure failed.
-/
go (x : Expr) : M (Option ReifiedBVExpr) := do
match_expr x with
| BitVec.ofNat _ _ => goBvLit x
| HAnd.hAnd _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.BitVec.and_congr
| HOr.hOr _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .or ``Std.Tactic.BVDecide.Reflect.BitVec.or_congr
| HXor.hXor _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.BitVec.xor_congr
| HAdd.hAdd _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .add ``Std.Tactic.BVDecide.Reflect.BitVec.add_congr
| HMul.hMul _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .mul ``Std.Tactic.BVDecide.Reflect.BitVec.mul_congr
| HDiv.hDiv _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .udiv ``Std.Tactic.BVDecide.Reflect.BitVec.udiv_congr
| HMod.hMod _ _ _ _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .umod ``Std.Tactic.BVDecide.Reflect.BitVec.umod_congr
| Complement.complement _ _ innerExpr =>
unaryReflection innerExpr .not ``Std.Tactic.BVDecide.Reflect.BitVec.not_congr
| HShiftLeft.hShiftLeft _ β _ _ innerExpr distanceExpr =>
let distance? getNatOrBvValue? β distanceExpr
if distance?.isSome then
shiftConstReflection
β
distanceExpr
innerExpr
.shiftLeftConst
``BVUnOp.shiftLeftConst
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeftNat_congr
else
shiftReflection
β
distanceExpr
innerExpr
.shiftLeft
``BVExpr.shiftLeft
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeft_congr
| HShiftRight.hShiftRight _ β _ _ innerExpr distanceExpr =>
let distance? getNatOrBvValue? β distanceExpr
if distance?.isSome then
shiftConstReflection
β
distanceExpr
innerExpr
.shiftRightConst
``BVUnOp.shiftRightConst
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRightNat_congr
else
shiftReflection
β
distanceExpr
innerExpr
.shiftRight
``BVExpr.shiftRight
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRight_congr
| BitVec.sshiftRight _ innerExpr distanceExpr =>
let some distance getNatValue? distanceExpr | return none
shiftConstLikeReflection
distance
innerExpr
.shiftLeftConst
``BVUnOp.shiftLeftConst
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeftNat_congr
else
shiftReflection
β
distanceExpr
innerExpr
.shiftLeft
``BVExpr.shiftLeft
``Std.Tactic.BVDecide.Reflect.BitVec.shiftLeft_congr
| HShiftRight.hShiftRight _ β _ _ innerExpr distanceExpr =>
let distance? getNatOrBvValue? β distanceExpr
if distance?.isSome then
shiftConstReflection
β
distanceExpr
innerExpr
.shiftRightConst
``BVUnOp.shiftRightConst
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRightNat_congr
else
shiftReflection
β
distanceExpr
innerExpr
.shiftRight
``BVExpr.shiftRight
``Std.Tactic.BVDecide.Reflect.BitVec.shiftRight_congr
| BitVec.sshiftRight _ innerExpr distanceExpr =>
let some distance getNatValue? distanceExpr | return ofAtom x
shiftConstLikeReflection
distance
innerExpr
.arithShiftRightConst
``BVUnOp.arithShiftRightConst
``Std.Tactic.BVDecide.Reflect.BitVec.arithShiftRight_congr
| BitVec.zeroExtend _ newWidthExpr innerExpr =>
let some newWidth getNatValue? newWidthExpr | return ofAtom x
let some inner ofOrAtom innerExpr | return none
let bvExpr := .zeroExtend newWidth inner.bvExpr
let expr :=
mkApp3
(mkConst ``BVExpr.zeroExtend)
.arithShiftRightConst
``BVUnOp.arithShiftRightConst
``Std.Tactic.BVDecide.Reflect.BitVec.arithShiftRight_congr
| BitVec.zeroExtend _ newWidthExpr innerExpr =>
let some newWidth getNatValue? newWidthExpr | return none
let some inner goOrAtom innerExpr | return none
let bvExpr := .zeroExtend newWidth inner.bvExpr
let expr :=
mkApp3
(mkConst ``BVExpr.zeroExtend)
(toExpr inner.width)
newWidthExpr
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.zeroExtend_congr)
newWidthExpr
(toExpr inner.width)
innerExpr
innerEval
innerProof
return some newWidth, bvExpr, proof, expr
| BitVec.signExtend _ newWidthExpr innerExpr =>
let some newWidth getNatValue? newWidthExpr | return none
let some inner goOrAtom innerExpr | return none
let bvExpr := .signExtend newWidth inner.bvExpr
let expr :=
mkApp3
(mkConst ``BVExpr.signExtend)
(toExpr inner.width)
newWidthExpr
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.signExtend_congr)
newWidthExpr
(toExpr inner.width)
innerExpr
innerEval
innerProof
return some newWidth, bvExpr, proof, expr
| HAppend.hAppend _ _ _ _ lhsExpr rhsExpr =>
let some lhs goOrAtom lhsExpr | return none
let some rhs goOrAtom rhsExpr | return none
let bvExpr := .append lhs.bvExpr rhs.bvExpr
let expr := mkApp4 (mkConst ``BVExpr.append)
(toExpr lhs.width)
(toExpr rhs.width)
lhs.expr rhs.expr
let proof := do
let lhsEval mkEvalExpr lhs.width lhs.expr
let lhsProof lhs.evalsAtAtoms
let rhsProof rhs.evalsAtAtoms
let rhsEval mkEvalExpr rhs.width rhs.expr
return mkApp8 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.append_congr)
(toExpr lhs.width) (toExpr rhs.width)
lhsExpr lhsEval
rhsExpr rhsEval
lhsProof rhsProof
return some lhs.width + rhs.width, bvExpr, proof, expr
| BitVec.replicate _ nExpr innerExpr =>
let some inner goOrAtom innerExpr | return none
let some n getNatValue? nExpr | return none
let bvExpr := .replicate n inner.bvExpr
let expr := mkApp3 (mkConst ``BVExpr.replicate)
(toExpr inner.width)
newWidthExpr
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.zeroExtend_congr)
newWidthExpr
(toExpr inner.width)
innerExpr
innerEval
innerProof
return some newWidth, bvExpr, proof, expr
| BitVec.signExtend _ newWidthExpr innerExpr =>
let some newWidth getNatValue? newWidthExpr | return ofAtom x
let some inner ofOrAtom innerExpr | return none
let bvExpr := .signExtend newWidth inner.bvExpr
let expr :=
mkApp3
(mkConst ``BVExpr.signExtend)
(toExpr inner.width)
newWidthExpr
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.signExtend_congr)
newWidthExpr
(toExpr inner.width)
innerExpr
innerEval
innerProof
return some newWidth, bvExpr, proof, expr
| HAppend.hAppend _ _ _ _ lhsExpr rhsExpr =>
let some lhs ofOrAtom lhsExpr | return none
let some rhs ofOrAtom rhsExpr | return none
let bvExpr := .append lhs.bvExpr rhs.bvExpr
let expr := mkApp4 (mkConst ``BVExpr.append)
(toExpr lhs.width)
(toExpr rhs.width)
lhs.expr rhs.expr
let proof := do
let lhsEval mkEvalExpr lhs.width lhs.expr
let lhsProof lhs.evalsAtAtoms
let rhsProof rhs.evalsAtAtoms
let rhsEval mkEvalExpr rhs.width rhs.expr
return mkApp8 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.append_congr)
(toExpr lhs.width) (toExpr rhs.width)
lhsExpr lhsEval
rhsExpr rhsEval
lhsProof rhsProof
return some lhs.width + rhs.width, bvExpr, proof, expr
| BitVec.replicate _ nExpr innerExpr =>
let some inner ofOrAtom innerExpr | return none
let some n getNatValue? nExpr | return ofAtom x
let bvExpr := .replicate n inner.bvExpr
let expr := mkApp3 (mkConst ``BVExpr.replicate)
(toExpr inner.width)
(toExpr n)
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.replicate_congr)
(toExpr n)
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp5 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.replicate_congr)
(toExpr n)
(toExpr inner.width)
innerExpr
innerEval
innerProof
return some inner.width * n, bvExpr, proof, expr
| BitVec.extractLsb' _ startExpr lenExpr innerExpr =>
let some start getNatValue? startExpr | return none
let some len getNatValue? lenExpr | return none
let some inner goOrAtom innerExpr | return none
let bvExpr := .extract start len inner.bvExpr
let expr := mkApp4 (mkConst ``BVExpr.extract)
(toExpr inner.width)
innerExpr
innerEval
innerProof
return some inner.width * n, bvExpr, proof, expr
| BitVec.extractLsb' _ startExpr lenExpr innerExpr =>
let some start getNatValue? startExpr | return ofAtom x
let some len getNatValue? lenExpr | return ofAtom x
let some inner ofOrAtom innerExpr | return none
let bvExpr := .extract start len inner.bvExpr
let expr := mkApp4 (mkConst ``BVExpr.extract)
(toExpr inner.width)
startExpr
lenExpr
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp6 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.extract_congr)
startExpr
lenExpr
(toExpr inner.width)
inner.expr
let proof := do
let innerEval mkEvalExpr inner.width inner.expr
let innerProof inner.evalsAtAtoms
return mkApp6 (mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.extract_congr)
startExpr
lenExpr
(toExpr inner.width)
innerExpr
innerEval
innerProof
return some len, bvExpr, proof, expr
| BitVec.rotateLeft _ innerExpr distanceExpr =>
rotateReflection
distanceExpr
innerExpr
innerEval
innerProof
return some len, bvExpr, proof, expr
| BitVec.rotateLeft _ innerExpr distanceExpr =>
rotateReflection
distanceExpr
innerExpr
.rotateLeft
``BVUnOp.rotateLeft
``Std.Tactic.BVDecide.Reflect.BitVec.rotateLeft_congr
| BitVec.rotateRight _ innerExpr distanceExpr =>
rotateReflection
distanceExpr
innerExpr
.rotateRight
``BVUnOp.rotateRight
``Std.Tactic.BVDecide.Reflect.BitVec.rotateRight_congr
| _ => ofAtom x
where
ofAtom (x : Expr) : M (Option ReifiedBVExpr) := do
let t instantiateMVars ( whnfR ( inferType x))
let_expr BitVec widthExpr := t | return none
let some width getNatValue? widthExpr | return none
let atom mkAtom x width
return some atom
.rotateLeft
``BVUnOp.rotateLeft
``Std.Tactic.BVDecide.Reflect.BitVec.rotateLeft_congr
| BitVec.rotateRight _ innerExpr distanceExpr =>
rotateReflection
distanceExpr
innerExpr
.rotateRight
``BVUnOp.rotateRight
``Std.Tactic.BVDecide.Reflect.BitVec.rotateRight_congr
| _ => return none
ofOrAtom (x : Expr) : M (Option ReifiedBVExpr) := do
let res of x
/--
Reify `x` or abstract it as an atom.
Unless this function is called on something that is not a fixed-width `BitVec` it is always going
to return `some`.
-/
goOrAtom (x : Expr) : M (Option ReifiedBVExpr) := do
let res go x
match res with
| some exp => return some exp
| none => ofAtom x
| none => bitVecAtom x
shiftConstLikeReflection (distance : Nat) (innerExpr : Expr) (shiftOp : Nat BVUnOp)
(shiftOpName : Name) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some inner ofOrAtom innerExpr | return none
let some inner goOrAtom innerExpr | return none
let bvExpr : BVExpr inner.width := .un (shiftOp distance) inner.bvExpr
let expr :=
mkApp3
@@ -278,24 +294,22 @@ where
rotateReflection (distanceExpr : Expr) (innerExpr : Expr) (rotateOp : Nat BVUnOp)
(rotateOpName : Name) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
-- Either the shift values are constant or we abstract the entire term as atoms
let some distance getNatValue? distanceExpr | return ofAtom x
let some distance getNatValue? distanceExpr | return none
shiftConstLikeReflection distance innerExpr rotateOp rotateOpName congrThm
shiftConstReflection (β : Expr) (distanceExpr : Expr) (innerExpr : Expr) (shiftOp : Nat BVUnOp)
(shiftOpName : Name) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
-- Either the shift values are constant or we abstract the entire term as atoms
let some distance getNatOrBvValue? β distanceExpr | return ofAtom x
let some distance getNatOrBvValue? β distanceExpr | return none
shiftConstLikeReflection distance innerExpr shiftOp shiftOpName congrThm
shiftReflection (β : Expr) (distanceExpr : Expr) (innerExpr : Expr)
(shiftOp : {m n : Nat} BVExpr m BVExpr n BVExpr m) (shiftOpName : Name)
(congrThm : Name) :
M (Option ReifiedBVExpr) := do
let_expr BitVec _ β | return ofAtom x
let some inner of innerExpr | return none
let some distance of distanceExpr | return none
let_expr BitVec _ β | return none
let some inner goOrAtom innerExpr | return none
let some distance goOrAtom distanceExpr | return none
let bvExpr : BVExpr inner.width := shiftOp inner.bvExpr distance.bvExpr
let expr :=
mkApp4
@@ -314,8 +328,8 @@ where
binaryReflection (lhsExpr rhsExpr : Expr) (op : BVBinOp) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some lhs ofOrAtom lhsExpr | return none
let some rhs ofOrAtom rhsExpr | return none
let some lhs goOrAtom lhsExpr | return none
let some rhs goOrAtom rhsExpr | return none
if h : rhs.width = lhs.width then
let bvExpr : BVExpr lhs.width := .bin lhs.bvExpr op (h rhs.bvExpr)
let expr := mkApp4 (mkConst ``BVExpr.bin) (toExpr lhs.width) lhs.expr (toExpr op) rhs.expr
@@ -335,7 +349,7 @@ where
unaryReflection (innerExpr : Expr) (op : BVUnOp) (congrThm : Name) :
M (Option ReifiedBVExpr) := do
let some inner ofOrAtom innerExpr | return none
let some inner goOrAtom innerExpr | return none
let bvExpr := .un op inner.bvExpr
let expr := mkApp3 (mkConst ``BVExpr.un) (toExpr inner.width) (toExpr op) inner.expr
let proof := unaryCongrProof inner innerExpr (mkConst congrThm)
@@ -347,7 +361,7 @@ where
return mkApp4 congrProof (toExpr inner.width) innerExpr innerEval innerProof
goBvLit (x : Expr) : M (Option ReifiedBVExpr) := do
let some width, bvVal getBitVecValue? x | return ofAtom x
let some width, bvVal getBitVecValue? x | return bitVecAtom x
let bvExpr : BVExpr width := .const bvVal
let expr := mkApp2 (mkConst ``BVExpr.const) (toExpr width) (toExpr bvVal)
let proof := do

View File

@@ -44,40 +44,75 @@ def mkTrans (x y z : Expr) (hxy hyz : Expr) : Expr :=
def mkEvalExpr (expr : Expr) : M Expr := do
return mkApp2 (mkConst ``BVLogicalExpr.eval) ( M.atomsAssignment) expr
/--
Construct a `ReifiedBVLogical` from `ReifiedBVPred` by wrapping it as an atom.
-/
def ofPred (bvPred : ReifiedBVPred) : M (Option ReifiedBVLogical) := do
let boolExpr := .literal bvPred.bvPred
let expr := mkApp2 (mkConst ``BoolExpr.literal) (mkConst ``BVPred) bvPred.expr
let proof := bvPred.evalsAtAtoms
return some boolExpr, proof, expr
/--
Construct an uninterrpeted `Bool` atom from `t`.
-/
def boolAtom (t : Expr) : M (Option ReifiedBVLogical) := do
let some pred ReifiedBVPred.boolAtom t | return none
ofPred pred
/--
Reify an `Expr` that is a boolean expression containing predicates about `BitVec` as atoms.
Unless this function is called on something that is not a `Bool` it is always going to return `some`.
-/
partial def of (t : Expr) : M (Option ReifiedBVLogical) := do
match_expr t with
| Bool.true =>
let boolExpr := .const true
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.true)
let proof := return mkRefl (mkConst ``Bool.true)
return some boolExpr, proof, expr
| Bool.false =>
let boolExpr := .const false
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.false)
let proof := return mkRefl (mkConst ``Bool.false)
return some boolExpr, proof, expr
| Bool.not subExpr =>
let some sub of subExpr | return none
let boolExpr := .not sub.bvExpr
let expr := mkApp2 (mkConst ``BoolExpr.not) (mkConst ``BVPred) sub.expr
let proof := do
let subEvalExpr mkEvalExpr sub.expr
let subProof sub.evalsAtAtoms
return mkApp3 (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.not_congr) subExpr subEvalExpr subProof
return some boolExpr, proof, expr
| Bool.and lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.Bool.and_congr
| Bool.xor lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.Bool.xor_congr
| BEq.beq α _ lhsExpr rhsExpr =>
match_expr α with
| Bool => gateReflection lhsExpr rhsExpr .beq ``Std.Tactic.BVDecide.Reflect.Bool.beq_congr
| BitVec _ => goPred t
| _ => return none
| _ => goPred t
goOrAtom t
where
/--
Reify `t`, returns `none` if the reification procedure failed.
-/
go (t : Expr) : M (Option ReifiedBVLogical) := do
match_expr t with
| Bool.true =>
let boolExpr := .const true
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.true)
let proof := pure <| mkRefl (mkConst ``Bool.true)
return some boolExpr, proof, expr
| Bool.false =>
let boolExpr := .const false
let expr := mkApp2 (mkConst ``BoolExpr.const) (mkConst ``BVPred) (toExpr Bool.false)
let proof := pure <| mkRefl (mkConst ``Bool.false)
return some boolExpr, proof, expr
| Bool.not subExpr =>
let some sub goOrAtom subExpr | return none
let boolExpr := .not sub.bvExpr
let expr := mkApp2 (mkConst ``BoolExpr.not) (mkConst ``BVPred) sub.expr
let proof := do
let subEvalExpr mkEvalExpr sub.expr
let subProof sub.evalsAtAtoms
return mkApp3 (mkConst ``Std.Tactic.BVDecide.Reflect.Bool.not_congr) subExpr subEvalExpr subProof
return some boolExpr, proof, expr
| Bool.and lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .and ``Std.Tactic.BVDecide.Reflect.Bool.and_congr
| Bool.xor lhsExpr rhsExpr => gateReflection lhsExpr rhsExpr .xor ``Std.Tactic.BVDecide.Reflect.Bool.xor_congr
| BEq.beq α _ lhsExpr rhsExpr =>
match_expr α with
| Bool => gateReflection lhsExpr rhsExpr .beq ``Std.Tactic.BVDecide.Reflect.Bool.beq_congr
| BitVec _ => goPred t
| _ => return none
| _ => goPred t
/--
Reify `t` or abstract it as an atom.
Unless this function is called on something that is not a `Bool` it is always going to return `some`.
-/
goOrAtom (t : Expr) : M (Option ReifiedBVLogical) := do
match go t with
| some boolExpr => return some boolExpr
| none => boolAtom t
gateReflection (lhsExpr rhsExpr : Expr) (gate : Gate) (congrThm : Name) :
M (Option ReifiedBVLogical) := do
let some lhs of lhsExpr | return none
let some rhs of rhsExpr | return none
let some lhs goOrAtom lhsExpr | return none
let some rhs goOrAtom rhsExpr | return none
let boolExpr := .gate gate lhs.bvExpr rhs.bvExpr
let expr :=
mkApp4
@@ -99,11 +134,8 @@ where
return some boolExpr, proof, expr
goPred (t : Expr) : M (Option ReifiedBVLogical) := do
let some bvPred ReifiedBVPred.of t | return none
let boolExpr := .literal bvPred.bvPred
let expr := mkApp2 (mkConst ``BoolExpr.literal) (mkConst ``BVPred) bvPred.expr
let proof := bvPred.evalsAtAtoms
return some boolExpr, proof, expr
let some pred ReifiedBVPred.of t | return none
ofPred pred
end ReifiedBVLogical

View File

@@ -37,54 +37,68 @@ structure ReifiedBVPred where
namespace ReifiedBVPred
/--
Reify an `Expr` that is a proof of a predicate about `BitVec`.
Construct an uninterpreted `Bool` atom from `t`.
-/
def of (t : Expr) : M (Option ReifiedBVPred) := do
match_expr t with
| BEq.beq α _ lhsExpr rhsExpr =>
let_expr BitVec _ := α | return none
binaryReflection lhsExpr rhsExpr .eq ``Std.Tactic.BVDecide.Reflect.BitVec.beq_congr
| BitVec.ult _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .ult ``Std.Tactic.BVDecide.Reflect.BitVec.ult_congr
| BitVec.getLsbD _ subExpr idxExpr =>
let some sub ReifiedBVExpr.of subExpr | return none
let some idx getNatValue? idxExpr | return none
let bvExpr : BVPred := .getLsbD sub.bvExpr idx
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr sub.width) sub.expr idxExpr
let proof := do
let subEval ReifiedBVExpr.mkEvalExpr sub.width sub.expr
let subProof sub.evalsAtAtoms
return mkApp5
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.getLsbD_congr)
idxExpr
(toExpr sub.width)
subExpr
subEval
subProof
return some bvExpr, proof, expr
| _ =>
/-
Idea: we have t : Bool here, let's construct:
BitVec.ofBool t : BitVec 1
as an atom. Then construct the BVPred corresponding to
BitVec.getLsb (BitVec.ofBool t) 0 : Bool
We can prove that this is equivalent to `t`. This allows us to have boolean variables in BVPred.
-/
let ty inferType t
let_expr Bool := ty | return none
let atom ReifiedBVExpr.mkAtom (mkApp (mkConst ``BitVec.ofBool) t) 1
let bvExpr : BVPred := .getLsbD atom.bvExpr 0
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr 1) atom.expr (toExpr 0)
let proof := do
let atomEval ReifiedBVExpr.mkEvalExpr atom.width atom.expr
let atomProof atom.evalsAtAtoms
return mkApp3
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.ofBool_congr)
t
atomEval
atomProof
return some bvExpr, proof, expr
def boolAtom (t : Expr) : M (Option ReifiedBVPred) := do
/-
Idea: we have t : Bool here, let's construct:
BitVec.ofBool t : BitVec 1
as an atom. Then construct the BVPred corresponding to
BitVec.getLsb (BitVec.ofBool t) 0 : Bool
We can prove that this is equivalent to `t`. This allows us to have boolean variables in BVPred.
-/
let ty inferType t
let_expr Bool := ty | return none
let atom ReifiedBVExpr.mkAtom (mkApp (mkConst ``BitVec.ofBool) t) 1
let bvExpr : BVPred := .getLsbD atom.bvExpr 0
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr 1) atom.expr (toExpr 0)
let proof := do
let atomEval ReifiedBVExpr.mkEvalExpr atom.width atom.expr
let atomProof atom.evalsAtAtoms
return mkApp3
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.ofBool_congr)
t
atomEval
atomProof
return some bvExpr, proof, expr
/--
Reify an `Expr` that is a predicate about `BitVec`.
Unless this function is called on something that is not a `Bool` it is always going to return `some`.
-/
partial def of (t : Expr) : M (Option ReifiedBVPred) := do
match go t with
| some pred => return some pred
| none => boolAtom t
where
/--
Reify `t`, returns `none` if the reification procedure failed.
-/
go (t : Expr) : M (Option ReifiedBVPred) := do
match_expr t with
| BEq.beq α _ lhsExpr rhsExpr =>
let_expr BitVec _ := α | return none
binaryReflection lhsExpr rhsExpr .eq ``Std.Tactic.BVDecide.Reflect.BitVec.beq_congr
| BitVec.ult _ lhsExpr rhsExpr =>
binaryReflection lhsExpr rhsExpr .ult ``Std.Tactic.BVDecide.Reflect.BitVec.ult_congr
| BitVec.getLsbD _ subExpr idxExpr =>
let some sub ReifiedBVExpr.of subExpr | return none
let some idx getNatValue? idxExpr | return none
let bvExpr : BVPred := .getLsbD sub.bvExpr idx
let expr := mkApp3 (mkConst ``BVPred.getLsbD) (toExpr sub.width) sub.expr idxExpr
let proof := do
let subEval ReifiedBVExpr.mkEvalExpr sub.width sub.expr
let subProof sub.evalsAtAtoms
return mkApp5
(mkConst ``Std.Tactic.BVDecide.Reflect.BitVec.getLsbD_congr)
idxExpr
(toExpr sub.width)
subExpr
subEval
subProof
return some bvExpr, proof, expr
| _ => return none
binaryReflection (lhsExpr rhsExpr : Expr) (pred : BVBinPred) (congrThm : Name) :
M (Option ReifiedBVPred) := do
let some lhs ReifiedBVExpr.of lhsExpr | return none

View File

@@ -520,7 +520,7 @@ where
@[builtin_tactic «case», builtin_incremental]
def evalCase : Tactic
| stx@`(tactic| case $[$tag $hs*]|* =>%$arr $tac:tacticSeq1Indented) =>
| stx@`(tactic| case%$caseTk $[$tag $hs*]|* =>%$arr $tac:tacticSeq1Indented) =>
-- disable incrementality if body is run multiple times
Term.withoutTacticIncrementality (tag.size > 1) do
for tag in tag, hs in hs do
@@ -528,20 +528,20 @@ def evalCase : Tactic
let g renameInaccessibles g hs
setGoals [g]
g.setTag Name.anonymous
withCaseRef arr tac <| closeUsingOrAdmit <| withTacticInfoContext stx <|
withCaseRef arr tac <| closeUsingOrAdmit <| withTacticInfoContext (mkNullNode #[caseTk, arr]) <|
Term.withNarrowedArgTacticReuse (argIdx := 3) (evalTactic ·) stx
setGoals gs
| _ => throwUnsupportedSyntax
@[builtin_tactic «case'»] def evalCase' : Tactic
| `(tactic| case' $[$tag $hs*]|* =>%$arr $tac:tacticSeq) => do
| `(tactic| case'%$caseTk $[$tag $hs*]|* =>%$arr $tac:tacticSeq) => do
let mut acc := #[]
for tag in tag, hs in hs do
let (g, gs) getCaseGoals tag
let g renameInaccessibles g hs
let mvarTag g.getTag
setGoals [g]
withCaseRef arr tac (evalTactic tac)
withCaseRef arr tac <| withTacticInfoContext (mkNullNode #[caseTk, arr]) <| evalTactic tac
let gs' getUnsolvedGoals
if let [g'] := gs' then
g'.setTag mvarTag

View File

@@ -119,7 +119,7 @@ private def pre (pattern : AbstractMVarsResult) (state : IO.Ref PatternMatchStat
let ids ids.mapIdxM fun i id =>
match id.getNat with
| 0 => throwErrorAt id "positive integer expected"
| n+1 => pure (n, i.1)
| n+1 => pure (n, i)
let ids := ids.qsort (·.1 < ·.1)
unless @Array.allDiff _ (·.1 == ·.1) ids do
throwError "occurrence list is not distinct"

View File

@@ -123,9 +123,7 @@ def realizeExtTheorem (structName : Name) (flat : Bool) : Elab.Command.CommandEl
levelParams := info.levelParams
}
modifyEnv fun env => addProtected env extName
Lean.addDeclarationRanges extName {
range := getDeclarationRange ( getRef)
selectionRange := getDeclarationRange ( getRef) }
addAuxDeclarationRanges extName ( getRef) ( getRef)
catch e =>
throwError m!"\
Failed to generate an 'ext' theorem for '{MessageData.ofConstName structName}': {e.toMessageData}"
@@ -163,9 +161,7 @@ def realizeExtIffTheorem (extName : Name) : Elab.Command.CommandElabM Name := do
-- Only declarations in a namespace can be protected:
unless extIffName.isAtomic do
modifyEnv fun env => addProtected env extIffName
Lean.addDeclarationRanges extIffName {
range := getDeclarationRange ( getRef)
selectionRange := getDeclarationRange ( getRef) }
addAuxDeclarationRanges extName ( getRef) ( getRef)
catch e =>
throwError m!"\
Failed to generate an 'ext_iff' theorem from '{MessageData.ofConstName extName}': {e.toMessageData}\n\

View File

@@ -27,8 +27,10 @@ open Meta
syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> syntheticHole <|> tacticSeq)
```
-/
private def getAltLhses (alt : Syntax) : Syntax :=
alt[0]
private def getFirstAltLhs (alt : Syntax) : Syntax :=
alt[0][0]
(getAltLhses alt)[0]
/-- Return `inductionAlt` name. It assumes `alt` does not have multiple `inductionAltLHS` -/
private def getAltName (alt : Syntax) : Name :=
let lhs := getFirstAltLhs alt
@@ -70,7 +72,9 @@ def evalAlt (mvarId : MVarId) (alt : Syntax) (addInfo : TermElabM Unit) : Tactic
let goals getGoals
try
setGoals [mvarId]
closeUsingOrAdmit (withTacticInfoContext alt (addInfo *> evalTactic rhs))
closeUsingOrAdmit <|
withTacticInfoContext (mkNullNode #[getAltLhses alt, getAltDArrow alt]) <|
(addInfo *> evalTactic rhs)
finally
setGoals goals

View File

@@ -914,7 +914,9 @@ private def applyAttributesCore
Remark: if the declaration has syntax errors, `declName` may be `.anonymous` see issue #4309
In this case, we skip attribute application.
-/
unless declName == .anonymous do
if declName == .anonymous then
return
withDeclName declName do
for attr in attrs do
withRef attr.stx do withLogging do
let env getEnv

View File

@@ -243,11 +243,16 @@ instance : ToSnapshotTree SnapshotLeaf where
structure DynamicSnapshot where
/-- Concrete snapshot value as `Dynamic`. -/
val : Dynamic
/-- Snapshot tree retrieved from `val` before erasure. -/
tree : SnapshotTree
/--
Snapshot tree retrieved from `val` before erasure. We do thunk even the first level as accessing
it too early can create some unnecessary tasks from `toSnapshotTree` that are otherwise avoided by
`(sync := true)` when accessing only after elaboration has finished. Early access can even lead to
deadlocks when later forcing these unnecessary tasks on a starved thread pool.
-/
tree : Thunk SnapshotTree
instance : ToSnapshotTree DynamicSnapshot where
toSnapshotTree s := s.tree
toSnapshotTree s := s.tree.get
/-- Creates a `DynamicSnapshot` from a typed snapshot value. -/
def DynamicSnapshot.ofTyped [TypeName α] [ToSnapshotTree α] (val : α) : DynamicSnapshot where

View File

@@ -1,42 +0,0 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.MonadEnv
namespace Lean
structure LazyInitExtension (m : Type Type) (α : Type) where
ext : EnvExtension (Option α)
fn : m α
instance [Monad m] [Inhabited α] : Inhabited (LazyInitExtension m α) where
default := {
ext := default
fn := pure default
}
/--
Register an environment extension for storing the result of `fn`.
We initialize the extension with `none`, and `fn` is executed the
first time `LazyInit.get` is executed.
This kind of extension is useful for avoiding work duplication in
scenarios where a thunk cannot be used because the computation depends
on state from the `m` monad. For example, we may want to "cache" a collection
of theorems as a `SimpLemmas` object. -/
def registerLazyInitExtension (fn : m α) : IO (LazyInitExtension m α) := do
let ext registerEnvExtension (pure none)
return { ext, fn }
def LazyInitExtension.get [MonadEnv m] [Monad m] (init : LazyInitExtension m α) : m α := do
match init.ext.getState ( getEnv) with
| some a => return a
| none =>
let a init.fn
modifyEnv fun env => init.ext.setState env (some a)
return a
end Lean

View File

@@ -37,7 +37,7 @@ def constructorNameAsVariable : Linter where
let warnings : IO.Ref (Std.HashMap String.Range (Syntax × Name × Name)) IO.mkRef {}
for tree in infoTrees do
tree.visitM' (preNode := fun ci info _ => do
tree.visitM' (postNode := fun ci info _ => do
match info with
| .ofTermInfo ti =>
match ti.expr with

View File

@@ -10,41 +10,55 @@ set_option linter.missingDocs true -- keep it documented
/-! # Unused variable Linter
This file implements the unused variable linter, which runs automatically on all commands
and reports any local variables that are never referred to, using information from the info tree.
This file implements the unused variable linter, which runs automatically on all
commands and reports any local variables that are never referred to, using
information from the info tree.
It is not immediately obvious but this is a surprisingly expensive check without some optimizations.
The main complication is that it can be difficult to determine what constitutes a "use".
For example, we would like this to be considered a use of `x`:
It is not immediately obvious but this is a surprisingly expensive check without
some optimizations. The main complication is that it can be difficult to
determine what constitutes a "use" apart from direct references to a variable
that we can easily find in the info tree. For example, we would like this to be
considered a use of `x`:
```
def foo (x : Nat) : Nat := by assumption
```
The final proof term is `fun x => x` so clearly `x` was used, but we can't make use of this because
the final proof term is after we have abstracted over the original `fvar` for `x`. If we look
further into the tactic state we can see the `fvar` show up in the instantiation to the original
goal metavariable `?m : Nat := x`, but it is not always the case that we can follow metavariable
instantiations to determine what happened after the fact, because tactics might skip the goal
metavariable and instantiate some other metavariable created prior to it instead.
The final proof term is `fun x => x` so clearly `x` was used, but we can't make
use of this because the final proof term is after we have abstracted over the
original `fvar` for `x`. Instead, we make sure to store the proof term before
abstraction but after instantiation of mvars in the info tree and retrieve it in
the linter. Using the instantiated term is very important as redoing that step
in the linter can be prohibitively expensive. The downside of special-casing the
definition body in this way is that while it works for parameters, it does not
work for local variables in the body, so we ignore them by default if any tactic
infos are present (`linter.unusedVariables.analyzeTactics`).
Instead, we use a (much more expensive) overapproximation, which is just to look through the entire
metavariable context looking for occurrences of `x`. We use caching to ensure that this is still
linear in the size of the info tree, even though there are many metavariable contexts in all the
intermediate stages of elaboration; these are highly similar and make use of `PersistentHashMap`
so there is a lot of subterm sharing we can take advantage of.
If we do turn on this option and look further into the tactic state, we can see
the `fvar` show up in the instantiation to the original goal metavariable
`?m : Nat := x`, but it is not always the case that we can follow metavariable
instantiations to determine what happened after the fact, because tactics might
skip the goal metavariable and instantiate some other metavariable created prior
to it instead. Instead, we use a (much more expensive) overapproximation, which
is just to look through the entire metavariable context looking for occurrences
of `x`. We use caching to ensure that this is still linear in the size of the
info tree, even though there are many metavariable contexts in all the
intermediate stages of elaboration; these are highly similar and make use of
`PersistentHashMap` so there is a lot of subterm sharing we can take advantage
of.
## The `@[unused_variables_ignore_fn]` attribute
Some occurrences of variables are deliberately unused, or at least we don't want to lint on unused
variables in these positions. For example:
Some occurrences of variables are deliberately unused, or at least we don't want
to lint on unused variables in these positions. For example:
```
def foo (x : Nat) : (y : Nat) → Nat := fun _ => x
-- ^ don't lint this unused variable because it is public API
```
They are generally a syntactic criterion, so we allow adding custom `IgnoreFunction`s so that
external syntax can also opt in to lint suppression, like so:
They are generally a syntactic criterion, so we allow adding custom
`IgnoreFunction`s so that external syntax can also opt in to lint suppression,
like so:
```
macro (name := foobarKind) "foobar " name:ident : command => `(def foo ($name : Nat) := 0)
@@ -77,6 +91,17 @@ register_builtin_option linter.unusedVariables.patternVars : Bool := {
defValue := true,
descr := "enable the 'unused variables' linter to mark unused pattern variables"
}
/-- Enables linting variables defined in tactic blocks, may be expensive for complex proofs -/
register_builtin_option linter.unusedVariables.analyzeTactics : Bool := {
defValue := false
descr := "enable analysis of local variables in presence of tactic proofs\
\n\
\nBy default, the linter will limit itself to linting a declaration's parameters \
whenever tactic proofs are present as these can be expensive to analyze. Enabling this \
option extends linting to local variables both inside and outside tactic proofs, \
though it can also lead to some false negatives as intermediate tactic states may \
reference some variables without the declaration ultimately depending on them."
}
/-- Gets the status of `linter.unusedVariables` -/
def getLinterUnusedVariables (o : Options) : Bool :=
@@ -356,55 +381,82 @@ structure References where
/-- Collect information from the `infoTrees` into `References`.
See `References` for more information about the return value. -/
def collectReferences (infoTrees : Array Elab.InfoTree) (cmdStxRange : String.Range) :
StateRefT References IO Unit := do
for tree in infoTrees do
tree.visitM' (preNode := fun ci info _ => do
match info with
| .ofTermInfo ti =>
match ti.expr with
| .const .. =>
if ti.isBinder then
let some range := info.range? | return
let .original .. := info.stx.getHeadInfo | return -- we are not interested in canonical syntax here
modify fun s => { s with constDecls := s.constDecls.insert range }
| .fvar id .. =>
let some range := info.range? | return
let .original .. := info.stx.getHeadInfo | return -- we are not interested in canonical syntax here
if ti.isBinder then
-- This is a local variable declaration.
let some ldecl := ti.lctx.find? id | return
-- Skip declarations which are outside the command syntax range, like `variable`s
-- (it would be confusing to lint these), or those which are macro-generated
if !cmdStxRange.contains range.start || ldecl.userName.hasMacroScopes then return
let opts := ci.options
-- we have to check for the option again here because it can be set locally
if !getLinterUnusedVariables opts then return
let stx := skipDeclIdIfPresent info.stx
if let .str _ s := stx.getId then
-- If the variable name is `_foo` then it is intentionally (possibly) unused, so skip.
-- This is the suggested way to silence the warning
if s.startsWith "_" then return
-- Record this either as a new `fvarDefs`, or an alias of an existing one
modify fun s =>
if let some ref := s.fvarDefs[range]? then
{ s with fvarDefs := s.fvarDefs.insert range { ref with aliases := ref.aliases.push id } }
else
{ s with fvarDefs := s.fvarDefs.insert range { userName := ldecl.userName, stx, opts, aliases := #[id] } }
else
-- Found a direct use, keep track of it
modify fun s => { s with fvarUses := s.fvarUses.insert id }
| _ => pure ()
| .ofTacticInfo ti =>
-- Keep track of the `MetavarContext` after a tactic for later
modify fun s => { s with assignments := s.assignments.push ti.mctxAfter.eAssignment }
| .ofFVarAliasInfo i =>
-- record any aliases we find
modify fun s =>
let id := followAliases s.fvarAliases i.baseId
{ s with fvarAliases := s.fvarAliases.insert i.id id }
| _ => pure ())
partial def collectReferences (infoTrees : Array Elab.InfoTree) (cmdStxRange : String.Range) :
StateRefT References IO Unit := ReaderT.run (r := false) <| go infoTrees none
where
go infoTrees ctx? := do
for tree in infoTrees do
tree.visitM' (ctx? := ctx?) (preNode := fun ci info children => do
-- set if `analyzeTactics` is unset, tactic infos are present, and we're inside the body
let ignored read
match info with
| .ofTermInfo ti =>
-- NOTE: we have to do this check *before* `ignored` because nested bodies (e.g. from
-- nested `let rec`s) do need to be included to find all `Expr` uses of the top-level
-- parameters
if ti.elaborator == `MutualDef.body &&
!linter.unusedVariables.analyzeTactics.get ci.options then
-- the body is the only `Expr` we will analyze in this case
-- NOTE: we include it even if no tactics are present as at least for parameters we want
-- to lint only truly unused binders
let (e, _) := instantiateMVarsCore ci.mctx ti.expr
modify fun s => { s with
assignments := s.assignments.push (.insert {} .anonymous e) }
let tacticsPresent := children.any (·.findInfo? (· matches .ofTacticInfo ..) |>.isSome)
withReader (· || tacticsPresent) do
go children.toArray ci
return false
if ignored then return true
match ti.expr with
| .const .. =>
if ti.isBinder then
let some range := info.range? | return true
let .original .. := info.stx.getHeadInfo | return true -- we are not interested in canonical syntax here
modify fun s => { s with constDecls := s.constDecls.insert range }
| .fvar id .. =>
let some range := info.range? | return true
let .original .. := info.stx.getHeadInfo | return true -- we are not interested in canonical syntax here
if ti.isBinder then
-- This is a local variable declaration.
if ignored then return true
let some ldecl := ti.lctx.find? id | return true
-- Skip declarations which are outside the command syntax range, like `variable`s
-- (it would be confusing to lint these), or those which are macro-generated
if !cmdStxRange.contains range.start || ldecl.userName.hasMacroScopes then return true
let opts := ci.options
-- we have to check for the option again here because it can be set locally
if !getLinterUnusedVariables opts then return true
let stx := skipDeclIdIfPresent info.stx
if let .str _ s := stx.getId then
-- If the variable name is `_foo` then it is intentionally (possibly) unused, so skip.
-- This is the suggested way to silence the warning
if s.startsWith "_" then return true
-- Record this either as a new `fvarDefs`, or an alias of an existing one
modify fun s =>
if let some ref := s.fvarDefs[range]? then
{ s with fvarDefs := s.fvarDefs.insert range { ref with aliases := ref.aliases.push id } }
else
{ s with fvarDefs := s.fvarDefs.insert range { userName := ldecl.userName, stx, opts, aliases := #[id] } }
else
-- Found a direct use, keep track of it
modify fun s => { s with fvarUses := s.fvarUses.insert id }
| _ => pure ()
return true
| .ofTacticInfo ti =>
-- When ignoring new binders, no need to look at intermediate tactic states either as
-- references to binders outside the body will be covered by the body `Expr`
if ignored then return true
-- Keep track of the `MetavarContext` after a tactic for later
modify fun s => { s with assignments := s.assignments.push ti.mctxAfter.eAssignment }
return true
| .ofFVarAliasInfo i =>
if ignored then return true
-- record any aliases we find
modify fun s =>
let id := followAliases s.fvarAliases i.baseId
{ s with fvarAliases := s.fvarAliases.insert i.id id }
return true
| _ => return true)
/-- Since declarations attach the declaration info to the `declId`,
we skip that to get to the `.ident` if possible. -/
skipDeclIdIfPresent (stx : Syntax) : Syntax :=
@@ -493,7 +545,7 @@ def unusedVariables : Linter where
-- collect additional `fvarUses` from tactic assignments
visitAssignments ( IO.mkRef {}) fvarUsesRef s.assignments
-- Resolve potential aliases again to preserve `fvarUsesRef` invariant
fvarUsesRef.modify fun fvarUses => fvarUses.fold (·.insert <| getCanonVar ·) {}
fvarUsesRef.modify fun fvarUses => fvarUses.toArray.map getCanonVar |> .insertMany {}
initializedMVars := true
let fvarUses fvarUsesRef.get
-- Redo the initial check because `fvarUses` could be bigger now

View File

@@ -54,7 +54,7 @@ def mkContext (declName : Name) : MetaM Context := do
let typeInfos indVal.all.toArray.mapM getConstInfoInduct
let motiveTypes typeInfos.mapM motiveType
let motives motiveTypes.mapIdxM fun j motive =>
return ( motiveName motiveTypes j.val, motive)
return ( motiveName motiveTypes j, motive)
let headers typeInfos.mapM $ mkHeader motives indVal.numParams
return {
motives := motives
@@ -214,7 +214,7 @@ def mkConstructor (ctx : Context) (i : Nat) (ctor : Name) : MetaM Constructor :=
def mkInductiveType
(ctx : Context)
(i : Fin ctx.typeInfos.size)
(i : Nat)
(indVal : InductiveVal) : MetaM InductiveType := do
return {
name := ctx.belowNames[i]!
@@ -340,11 +340,11 @@ where
mkIH
(params : Array Expr)
(motives : Array Expr)
(idx : Fin ctx.motives.size)
(idx : Nat)
(motive : Name × Expr) : MetaM $ Name × (Array Expr MetaM Expr) := do
let name :=
if ctx.motives.size > 1
then mkFreshUserName <| .mkSimple s!"ih_{idx.val.succ}"
then mkFreshUserName <| .mkSimple s!"ih_{idx + 1}"
else mkFreshUserName <| .mkSimple "ih"
let ih instantiateForall motive.2 params
let mkDomain (_ : Array Expr) : MetaM Expr :=
@@ -353,7 +353,7 @@ where
let args := params ++ motives ++ ys
let premise :=
mkAppN
(mkConst ctx.belowNames[idx.val]! levels) args
(mkConst ctx.belowNames[idx]! levels) args
let conclusion :=
mkAppN motives[idx]! ys
mkForallFVars ys (mkArrow premise conclusion)

View File

@@ -441,6 +441,8 @@ This can be used to infer the expected type of the alternatives when constructin
-/
def arrowDomainsN (n : Nat) (type : Expr) : MetaM (Array Expr) := do
forallBoundedTelescope type n fun xs _ => do
unless xs.size = n do
throwError "type {type} does not have {n} parameters"
let types xs.mapM (inferType ·)
for t in types do
if t.hasAnyFVar (fun fvar => xs.contains (.fvar fvar)) then

View File

@@ -70,7 +70,7 @@ def caseArraySizes (mvarId : MVarId) (fvarId : FVarId) (sizes : Array Nat) (xNam
let subst := subgoal.subst
let mvarId := subgoal.mvarId
let hEqSz := (subst.get hEq).fvarId!
if h : i.val < sizes.size then
if h : i < sizes.size then
let n := sizes.get i, h
let mvarId mvarId.clear subgoal.newHs[0]!
let mvarId mvarId.clear (subst.get aSizeFVarId).fvarId!

View File

@@ -545,7 +545,7 @@ private def processValue (p : Problem) : MetaM (Array Problem) := do
let subgoals caseValues p.mvarId x.fvarId! values (substNewEqs := true)
subgoals.mapIdxM fun i subgoal => do
trace[Meta.Match.match] "processValue subgoal\n{MessageData.ofGoal subgoal.mvarId}"
if h : i.val < values.size then
if h : i < values.size then
let value := values.get i, h
-- (x = value) branch
let subst := subgoal.subst
@@ -599,7 +599,7 @@ private def processArrayLit (p : Problem) : MetaM (Array Problem) := do
let sizes := collectArraySizes p
let subgoals caseArraySizes p.mvarId x.fvarId! sizes
subgoals.mapIdxM fun i subgoal => do
if i.val < sizes.size then
if i < sizes.size then
let size := sizes.get! i
let subst := subgoal.subst
let elems := subgoal.elems.toList

View File

@@ -643,7 +643,7 @@ def abstractIndependentMVars (mvars : Array MVarId) (index : Nat) (e : Expr) : M
pure mvar
trace[Meta.FunInd] "abstractIndependentMVars, reverted mvars: {mvars}"
let decls := mvars.mapIdx fun i mvar =>
(.mkSimple s!"case{i.val+1}", (fun _ => mvar.getType))
(.mkSimple s!"case{i+1}", (fun _ => mvar.getType))
Meta.withLocalDeclsD decls fun xs => do
for mvar in mvars, x in xs do
mvar.assign x
@@ -971,7 +971,7 @@ def deriveInductionStructural (names : Array Name) (numFixed : Nat) : MetaM Unit
mkForallFVars ys (.sort levelZero)
let motiveArities infos.mapM fun info => do
lambdaTelescope ( instantiateLambda info.value xs) fun ys _ => pure ys.size
let motiveDecls motiveTypes.mapIdxM fun i,_ motiveType => do
let motiveDecls motiveTypes.mapIdxM fun i motiveType => do
let n := if infos.size = 1 then .mkSimple "motive"
else .mkSimple s!"motive_{i+1}"
pure (n, fun _ => pure motiveType)

View File

@@ -4,31 +4,26 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Lean.LazyInitExtension
import Lean.Meta.Tactic.Cases
import Lean.Meta.Tactic.Simp.Main
namespace Lean.Meta
namespace SplitIf
builtin_initialize ext : LazyInitExtension MetaM Simp.Context
registerLazyInitExtension do
let mut s : SimpTheorems := {}
s s.addConst ``if_pos
s s.addConst ``if_neg
s s.addConst ``dif_pos
s s.addConst ``dif_neg
return {
simpTheorems := #[s]
congrTheorems := ( getSimpCongrTheorems)
config := { Simp.neutralConfig with dsimp := false }
}
/--
Default `Simp.Context` for `simpIf` methods. It contains all congruence theorems, but
just the rewriting rules for reducing `if` expressions. -/
def getSimpContext : MetaM Simp.Context :=
ext.get
def getSimpContext : MetaM Simp.Context := do
let mut s : SimpTheorems := {}
s s.addConst ``if_pos
s s.addConst ``if_neg
s s.addConst ``dif_pos
s s.addConst ``dif_neg
return {
simpTheorems := #[s]
congrTheorems := ( getSimpCongrTheorems)
config := { Simp.neutralConfig with dsimp := false }
}
/--
Default `discharge?` function for `simpIf` methods.

View File

@@ -95,7 +95,7 @@ private def toCtorWhenK (recVal : RecursorVal) (major : Expr) : MetaM Expr := do
let majorType inferType major
let majorType instantiateMVars ( whnf majorType)
let majorTypeI := majorType.getAppFn
if !majorTypeI.isConstOf recVal.getInduct then
if !majorTypeI.isConstOf recVal.getMajorInduct then
return major
else if majorType.hasExprMVar && majorType.getAppArgs[recVal.numParams:].any Expr.hasExprMVar then
return major
@@ -197,7 +197,7 @@ private def reduceRec (recVal : RecursorVal) (recLvls : List Level) (recArgs : A
major toCtorWhenK recVal major
major := major.toCtorIfLit
major cleanupNatOffsetMajor major
major toCtorWhenStructure recVal.getInduct major
major toCtorWhenStructure recVal.getMajorInduct major
match getRecRuleFor recVal major with
| some rule =>
let majorArgs := major.getAppArgs

View File

@@ -505,6 +505,9 @@ Displays all available tactic tags, with documentation.
-/
@[builtin_command_parser] def printTacTags := leading_parser
"#print " >> nonReservedSymbol "tactic " >> nonReservedSymbol "tags"
/-- Shows the current Lean version. Prints `Lean.versionString`. -/
@[builtin_command_parser] def version := leading_parser
"#version"
@[builtin_command_parser] def «init_quot» := leading_parser
"init_quot"
def optionValue := nonReservedSymbol "true" <|> nonReservedSymbol "false" <|> strLit <|> numLit

View File

@@ -189,7 +189,7 @@ open PrettyPrinter Syntax.MonadTraverser Formatter in
@[combinator_formatter sepByIndent]
def sepByIndent.formatter (p : Formatter) (_sep : String) (pSep : Formatter) : Formatter := do
let stx getCur
let hasNewlineSep := stx.getArgs.mapIdx (fun i, _ n =>
let hasNewlineSep := stx.getArgs.mapIdx (fun i n =>
i % 2 == 1 && n.matchesNull 0 && i != stx.getArgs.size - 1) |>.any id
visitArgs do
for i in (List.range stx.getArgs.size).reverse do

View File

@@ -1215,32 +1215,11 @@ def delabDo : Delab := whenPPOption getPPNotation do
let items elems.toArray.mapM (`(doSeqItem|$(·):doElem))
`(do $items:doSeqItem*)
def reifyName : Expr DelabM Name
| .const ``Lean.Name.anonymous _ => return Name.anonymous
| mkApp2 (.const ``Lean.Name.str _) n (.lit (.strVal s)) => return ( reifyName n).mkStr s
| mkApp2 (.const ``Lean.Name.num _) n (.lit (.natVal i)) => return ( reifyName n).mkNum i
| mkApp (.const ``Lean.Name.mkStr1 _) (.lit (.strVal a)) => return Lean.Name.mkStr1 a
| mkApp2 (.const ``Lean.Name.mkStr2 _) (.lit (.strVal a1)) (.lit (.strVal a2)) =>
return Lean.Name.mkStr2 a1 a2
| mkApp3 (.const ``Lean.Name.mkStr3 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) =>
return Lean.Name.mkStr3 a1 a2 a3
| mkApp4 (.const ``Lean.Name.mkStr4 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) =>
return Lean.Name.mkStr4 a1 a2 a3 a4
| mkApp5 (.const ``Lean.Name.mkStr5 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) =>
return Lean.Name.mkStr5 a1 a2 a3 a4 a5
| mkApp6 (.const ``Lean.Name.mkStr6 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) =>
return Lean.Name.mkStr6 a1 a2 a3 a4 a5 a6
| mkApp7 (.const ``Lean.Name.mkStr7 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) (.lit (.strVal a7)) =>
return Lean.Name.mkStr7 a1 a2 a3 a4 a5 a6 a7
| mkApp8 (.const ``Lean.Name.mkStr8 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) (.lit (.strVal a7)) (.lit (.strVal a8)) =>
return Lean.Name.mkStr8 a1 a2 a3 a4 a5 a6 a7 a8
| _ => failure
@[builtin_delab app.Lean.Name.str,
builtin_delab app.Lean.Name.mkStr1, builtin_delab app.Lean.Name.mkStr2, builtin_delab app.Lean.Name.mkStr3, builtin_delab app.Lean.Name.mkStr4,
builtin_delab app.Lean.Name.mkStr5, builtin_delab app.Lean.Name.mkStr6, builtin_delab app.Lean.Name.mkStr7, builtin_delab app.Lean.Name.mkStr8]
def delabNameMkStr : Delab := whenPPOption getPPNotation do
let n reifyName ( getExpr)
let some n := ( getExpr).name? | failure
-- not guaranteed to be a syntactically valid name, but usually more helpful than the explicit version
return mkNode ``Lean.Parser.Term.quotedName #[Syntax.mkNameLit s!"`{n}"]

View File

@@ -1004,7 +1004,7 @@ private def assignSortTexts (completions : CompletionList) : CompletionList := I
if completions.items.isEmpty then
return completions
let items := completions.items.mapIdx fun i item =>
{ item with sortText? := toString i.val }
{ item with sortText? := toString i }
let maxDigits := items[items.size - 1]!.sortText?.get!.length
let items := items.map fun item =>
let sortText := item.sortText?.get!

View File

@@ -40,27 +40,34 @@ structure InfoWithCtx where
info : Elab.Info
children : PersistentArray InfoTree
/-- Visit nodes, passing in a surrounding context (the innermost one combined with all outer ones)
and accumulating results on the way back up. -/
/--
Visit nodes, passing in a surrounding context (the innermost one combined with all outer ones) and
accumulating results on the way back up. If `preNode` returns `false`, the children of the current
node are skipped and `postNode` is invoked with an empty list of results.
-/
partial def InfoTree.visitM [Monad m]
(preNode : ContextInfo Info (children : PersistentArray InfoTree) m Unit := fun _ _ _ => pure ())
(preNode : ContextInfo Info (children : PersistentArray InfoTree) m Bool := fun _ _ _ => pure true)
(postNode : ContextInfo Info (children : PersistentArray InfoTree) List (Option α) m α)
: InfoTree m (Option α) :=
go none
(ctx? : Option ContextInfo := none) : InfoTree m (Option α) :=
go ctx?
where go
| ctx?, context ctx t => go (ctx.mergeIntoOuter? ctx?) t
| some ctx, node i cs => do
preNode ctx i cs
let as cs.toList.mapM (go <| i.updateContext? ctx)
postNode ctx i cs as
let visitChildren preNode ctx i cs
if !visitChildren then
postNode ctx i cs []
else
let as cs.toList.mapM (go <| i.updateContext? ctx)
postNode ctx i cs as
| none, node .. => panic! "unexpected context-free info tree node"
| _, hole .. => pure none
/-- `InfoTree.visitM` specialized to `Unit` return type -/
def InfoTree.visitM' [Monad m]
(preNode : ContextInfo Info (children : PersistentArray InfoTree) m Unit := fun _ _ _ => pure ())
(preNode : ContextInfo Info (children : PersistentArray InfoTree) m Bool := fun _ _ _ => pure true)
(postNode : ContextInfo Info (children : PersistentArray InfoTree) m Unit := fun _ _ _ => pure ())
(t : InfoTree) : m Unit := t.visitM preNode (fun ci i cs _ => postNode ci i cs) |> discard
(ctx? : Option ContextInfo := none) (t : InfoTree) : m Unit :=
t.visitM preNode (fun ci i cs _ => postNode ci i cs) ctx? |> discard
/--
Visit nodes bottom-up, passing in a surrounding context (the innermost one) and the union of nested results (empty at leaves). -/
@@ -410,6 +417,9 @@ where go ci?
match ci?, i with
| some ci, .ofTermInfo ti
| some ci, .ofOmissionInfo { toTermInfo := ti, .. } => do
-- NOTE: `instantiateMVars` can potentially be expensive but we rely on the elaborator
-- creating a fully instantiated `MutualDef.body` term info node which has the implicit effect
-- of making the `instantiateMVars` here a no-op and avoids further recursing into the body
let expr ti.runMetaM ci (instantiateMVars ti.expr)
return expr.hasSorry
-- we assume that `cs` are subterms of `ti.expr` and

View File

@@ -106,4 +106,29 @@ def arrayLit? (e : Expr) : Option (Expr × List Expr) :=
def prod? (e : Expr) : Option (Expr × Expr) :=
e.app2? ``Prod
/--
Checks if an expression is a `Name` literal, and if so returns the name.
-/
def name? : Expr Option Name
| .const ``Lean.Name.anonymous _ => Name.anonymous
| mkApp2 (.const ``Lean.Name.str _) n (.lit (.strVal s)) => (name? n).map (·.str s)
| mkApp2 (.const ``Lean.Name.num _) n i =>
(i.rawNatLit? <|> i.nat?).bind fun i => (name? n).map (Name.num · i)
| mkApp (.const ``Lean.Name.mkStr1 _) (.lit (.strVal a)) => Lean.Name.mkStr1 a
| mkApp2 (.const ``Lean.Name.mkStr2 _) (.lit (.strVal a1)) (.lit (.strVal a2)) =>
Lean.Name.mkStr2 a1 a2
| mkApp3 (.const ``Lean.Name.mkStr3 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) =>
Lean.Name.mkStr3 a1 a2 a3
| mkApp4 (.const ``Lean.Name.mkStr4 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) =>
Lean.Name.mkStr4 a1 a2 a3 a4
| mkApp5 (.const ``Lean.Name.mkStr5 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) =>
Lean.Name.mkStr5 a1 a2 a3 a4 a5
| mkApp6 (.const ``Lean.Name.mkStr6 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) =>
Lean.Name.mkStr6 a1 a2 a3 a4 a5 a6
| mkApp7 (.const ``Lean.Name.mkStr7 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) (.lit (.strVal a7)) =>
Lean.Name.mkStr7 a1 a2 a3 a4 a5 a6 a7
| mkApp8 (.const ``Lean.Name.mkStr8 _) (.lit (.strVal a1)) (.lit (.strVal a2)) (.lit (.strVal a3)) (.lit (.strVal a4)) (.lit (.strVal a5)) (.lit (.strVal a6)) (.lit (.strVal a7)) (.lit (.strVal a8)) =>
Lean.Name.mkStr8 a1 a2 a3 a4 a5 a6 a7 a8
| _ => none
end Lean.Expr

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Basic
import Std.Sat.AIG.LawfulOperator
import Std.Sat.AIG.Lemmas

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Data.HashMap
import Std.Data.HashSet
@@ -127,7 +128,7 @@ theorem Cache.get?_property {decls : Array (Decl α)} {idx : Nat} (c : Cache α
induction hcache generalizing decl with
| empty => simp at hfound
| push_id wf ih =>
rw [Array.get_push]
rw [Array.getElem_push]
split
· apply ih
simp [hfound]
@@ -139,7 +140,7 @@ theorem Cache.get?_property {decls : Array (Decl α)} {idx : Nat} (c : Cache α
assumption
| push_cache wf ih =>
rename_i decl'
rw [Array.get_push]
rw [Array.getElem_push]
split
· simp only [HashMap.getElem?_insert] at hfound
match heq : decl == decl' with
@@ -463,7 +464,7 @@ def mkGate (aig : AIG α) (input : GateInput aig) : Entrypoint α :=
let cache := aig.cache.noUpdate
have invariant := by
intro i lhs' rhs' linv' rinv' h1 h2
simp only [Array.get_push] at h2
simp only [Array.getElem_push] at h2
split at h2
· apply aig.invariant <;> assumption
· injections
@@ -482,7 +483,7 @@ def mkAtom (aig : AIG α) (n : α) : Entrypoint α :=
let cache := aig.cache.noUpdate
have invariant := by
intro i lhs rhs linv rinv h1 h2
simp only [Array.get_push] at h2
simp only [Array.getElem_push] at h2
split at h2
· apply aig.invariant <;> assumption
· contradiction
@@ -498,7 +499,7 @@ def mkConst (aig : AIG α) (val : Bool) : Entrypoint α :=
let cache := aig.cache.noUpdate
have invariant := by
intro i lhs rhs linv rinv h1 h2
simp only [Array.get_push] at h2
simp only [Array.getElem_push] at h2
split at h2
· apply aig.invariant <;> assumption
· contradiction

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.CNF
import Std.Sat.AIG.Basic
import Std.Sat.AIG.Lemmas

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Basic
import Std.Sat.AIG.Lemmas
@@ -35,7 +36,7 @@ def mkAtomCached (aig : AIG α) (n : α) : Entrypoint α :=
let decls := decls.push decl
have inv := by
intro i lhs rhs linv rinv h1 h2
simp only [Array.get_push] at h2
simp only [Array.getElem_push] at h2
split at h2
· apply inv <;> assumption
· contradiction
@@ -57,7 +58,7 @@ def mkConstCached (aig : AIG α) (val : Bool) : Entrypoint α :=
let decls := decls.push decl
have inv := by
intro i lhs rhs linv rinv h1 h2
simp only [Array.get_push] at h2
simp only [Array.getElem_push] at h2
split at h2
· apply inv <;> assumption
· contradiction
@@ -120,7 +121,7 @@ where
have inv := by
intro i lhs rhs linv rinv h1 h2
simp only [decls] at *
simp only [Array.get_push] at h2
simp only [Array.getElem_push] at h2
split at h2
· apply inv <;> assumption
· injections; omega

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Cached
import Std.Sat.AIG.CachedLemmas

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.CachedGates
import Std.Sat.AIG.LawfulOperator

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Cached
/-!
@@ -59,7 +60,7 @@ theorem mkAtomCached_decl_eq (aig : AIG α) (var : α) (idx : Nat) {h : idx < ai
simp [this]
| none =>
have := mkAtomCached_miss_aig aig hcache
simp only [this, Array.get_push]
simp only [this, Array.getElem_push]
split
· rfl
· contradiction
@@ -133,7 +134,7 @@ theorem mkConstCached_decl_eq (aig : AIG α) (val : Bool) (idx : Nat) {h : idx <
simp [this]
| none =>
have := mkConstCached_miss_aig aig hcache
simp only [this, Array.get_push]
simp only [this, Array.getElem_push]
split
· rfl
· contradiction
@@ -256,7 +257,7 @@ theorem mkGateCached.go_decl_eq (aig : AIG α) (input : GateInput aig) :
· rw [ hres]
dsimp only
intro idx h1 h2
rw [Array.get_push]
rw [Array.getElem_push]
simp [h2]
/--

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.CachedGatesLemmas
import Std.Sat.AIG.LawfulVecOperator

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Basic
/-!

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.LawfulOperator
import Std.Sat.AIG.RefVec

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Basic
import Std.Sat.AIG.LawfulOperator
@@ -77,7 +78,7 @@ The AIG produced by `AIG.mkGate` agrees with the input AIG on all indices that a
theorem mkGate_decl_eq idx (aig : AIG α) (input : GateInput aig) {h : idx < aig.decls.size} :
have := mkGate_le_size aig input
(aig.mkGate input).aig.decls[idx]'(by omega) = aig.decls[idx] := by
simp only [mkGate, Array.get_push]
simp only [mkGate, Array.getElem_push]
split
· rfl
· contradiction
@@ -98,13 +99,13 @@ theorem denote_mkGate {aig : AIG α} {input : GateInput aig} :
unfold denote denote.go
split
· next heq =>
rw [mkGate, Array.get_push_eq] at heq
rw [mkGate, Array.getElem_push_eq] at heq
contradiction
· next heq =>
rw [mkGate, Array.get_push_eq] at heq
rw [mkGate, Array.getElem_push_eq] at heq
contradiction
· next heq =>
rw [mkGate, Array.get_push_eq] at heq
rw [mkGate, Array.getElem_push_eq] at heq
injection heq with heq1 heq2 heq3 heq4
dsimp only
congr 2
@@ -131,7 +132,7 @@ The AIG produced by `AIG.mkAtom` agrees with the input AIG on all indices that a
-/
theorem mkAtom_decl_eq (aig : AIG α) (var : α) (idx : Nat) {h : idx < aig.decls.size} {hbound} :
(aig.mkAtom var).aig.decls[idx]'hbound = aig.decls[idx] := by
simp only [mkAtom, Array.get_push]
simp only [mkAtom, Array.getElem_push]
split
· rfl
· contradiction
@@ -148,14 +149,14 @@ theorem denote_mkAtom {aig : AIG α} :
unfold denote denote.go
split
· next heq =>
rw [mkAtom, Array.get_push_eq] at heq
rw [mkAtom, Array.getElem_push_eq] at heq
contradiction
· next heq =>
rw [mkAtom, Array.get_push_eq] at heq
rw [mkAtom, Array.getElem_push_eq] at heq
injection heq with heq
rw [heq]
· next heq =>
rw [mkAtom, Array.get_push_eq] at heq
rw [mkAtom, Array.getElem_push_eq] at heq
contradiction
/--
@@ -171,7 +172,7 @@ The AIG produced by `AIG.mkConst` agrees with the input AIG on all indices that
theorem mkConst_decl_eq (aig : AIG α) (val : Bool) (idx : Nat) {h : idx < aig.decls.size} :
have := mkConst_le_size aig val
(aig.mkConst val).aig.decls[idx]'(by omega) = aig.decls[idx] := by
simp only [mkConst, Array.get_push]
simp only [mkConst, Array.getElem_push]
split
· rfl
· contradiction
@@ -187,14 +188,14 @@ theorem denote_mkConst {aig : AIG α} : ⟦(aig.mkConst val), assign⟧ = val :=
unfold denote denote.go
split
· next heq =>
rw [mkConst, Array.get_push_eq] at heq
rw [mkConst, Array.getElem_push_eq] at heq
injection heq with heq
rw [heq]
· next heq =>
rw [mkConst, Array.get_push_eq] at heq
rw [mkConst, Array.getElem_push_eq] at heq
contradiction
· next heq =>
rw [mkConst, Array.get_push_eq] at heq
rw [mkConst, Array.getElem_push_eq] at heq
contradiction
/--

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.LawfulOperator
import Std.Sat.AIG.CachedGatesLemmas
@@ -58,7 +59,7 @@ def push (s : RefVec aig len) (ref : AIG.Ref aig) : RefVec aig (len + 1) :=
by simp [hlen],
by
intro i hi
simp only [Array.get_push]
simp only [Array.getElem_push]
split
· apply hrefs
omega
@@ -84,7 +85,7 @@ theorem get_push_ref_lt (s : RefVec aig len) (ref : AIG.Ref aig) (idx : Nat)
simp only [get, push, Ref.mk.injEq]
cases ref
simp only [Ref.mk.injEq]
rw [Array.get_push_lt]
rw [Array.getElem_push_lt]
@[simp]
theorem get_cast {aig1 aig2 : AIG α} (s : RefVec aig1 len) (idx : Nat) (hidx : idx < len)

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.RefVecOperator.Map
import Std.Sat.AIG.RefVecOperator.Zip
import Std.Sat.AIG.RefVecOperator.Fold

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.RefVec
import Std.Sat.AIG.LawfulVecOperator

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.RefVec
import Std.Sat.AIG.LawfulVecOperator

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.RefVec
import Std.Sat.AIG.LawfulVecOperator

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Basic
import Std.Sat.AIG.Lemmas

View File

@@ -3,6 +3,7 @@ Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Std.Sat.AIG.Relabel

View File

@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Init.Data.AC
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Var
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Const
import Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Impl.Operations.Not

View File

@@ -111,7 +111,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
units.size, units_size_lt_updatedUnits_size
have i_gt_zero : i.1 > 0 := by rw [i_eq_l]; exact l.1.2.1
refine mostRecentUnitIdx, l.2, i_gt_zero, ?_
simp only [insertUnit, h3, ite_false, Array.get_push_eq, i_eq_l, reduceCtorEq]
simp only [insertUnit, h3, ite_false, Array.getElem_push_eq, i_eq_l, reduceCtorEq]
constructor
· rfl
· constructor
@@ -132,7 +132,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
· intro h
simp only [ h, not_true, mostRecentUnitIdx] at hk
exact hk rfl
rw [Array.get_push_lt _ _ _ k_in_bounds]
rw [Array.getElem_push_lt _ _ _ k_in_bounds]
rw [i_eq_l] at h2
exact h2 k.1, k_in_bounds
· next i_ne_l =>
@@ -142,7 +142,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
constructor
· exact h1
· intro j
rw [Array.get_push]
rw [Array.getElem_push]
by_cases h : j.val < Array.size units
· simp only [h, dite_true]
exact h2 j.1, h
@@ -189,9 +189,9 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
exact h5 (has_add _ true)
| true, false =>
refine j.1, j_lt_updatedUnits_size, mostRecentUnitIdx, i_gt_zero, ?_
simp only [insertUnit, h5, ite_false, Array.get_push_eq, ne_eq, reduceCtorEq]
simp only [insertUnit, h5, ite_false, Array.getElem_push_eq, ne_eq, reduceCtorEq]
constructor
· rw [Array.get_push_lt units l j.1 j.2, h1]
· rw [Array.getElem_push_lt units l j.1 j.2, h1]
· constructor
· simp [i_eq_l, hl]
rfl
@@ -210,7 +210,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
simp [hasAssignment, hl, getElem!, l_in_bounds, h2, hasNegAssignment, decidableGetElem?] at h5
| both => simp (config := {decide := true}) only [h] at h3
· intro k k_ne_j k_ne_l
rw [Array.get_push]
rw [Array.getElem_push]
by_cases h : k.1 < units.size
· simp only [h, dite_true]
have k_ne_j : k.1, h j := by
@@ -226,12 +226,12 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
exact k_ne_l rfl
| false, true =>
refine mostRecentUnitIdx, j.1, j_lt_updatedUnits_size, i_gt_zero, ?_
simp [insertUnit, h5, ite_false, Array.get_push_eq, ne_eq]
simp [insertUnit, h5, ite_false, Array.getElem_push_eq, ne_eq]
constructor
· simp [i_eq_l, hl]
rfl
· constructor
· rw [Array.get_push_lt units l j.1 j.2, h1]
· rw [Array.getElem_push_lt units l j.1 j.2, h1]
· constructor
· simp only [i_eq_l]
rw [Array.getElem_modify_self]
@@ -247,7 +247,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
| neg => simp (config := {decide := true}) only [h] at h3
| both => simp (config := {decide := true}) only [h] at h3
· intro k k_ne_l k_ne_j
rw [Array.get_push]
rw [Array.getElem_push]
by_cases h : k.1 < units.size
· simp only [h, dite_true]
have k_ne_j : k.1, h j := by
@@ -275,13 +275,13 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
refine j.1, j_lt_updatedUnits_size, b,i_gt_zero, ?_
simp only [insertUnit, h5, ite_false, reduceCtorEq]
constructor
· rw [Array.get_push_lt units l j.1 j.2, h1]
· rw [Array.getElem_push_lt units l j.1 j.2, h1]
· constructor
· rw [Array.getElem_modify_of_ne (Ne.symm i_ne_l), h2]
· constructor
· exact h3
· intro k k_ne_j
rw [Array.get_push]
rw [Array.getElem_push]
by_cases h : k.val < units.size
· simp only [h, dite_true]
have k_ne_j : k.1, h j := by
@@ -307,11 +307,11 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
constructor
· split
· exact h1
· simp only [Array.get_push_lt units l j1.1 j1.2, h1]
· simp only [Array.getElem_push_lt units l j1.1 j1.2, h1]
· constructor
· split
· exact h2
· simp only [Array.get_push_lt units l j2.1 j2.2, h2]
· simp only [Array.getElem_push_lt units l j2.1 j2.2, h2]
· constructor
· split
· exact h3
@@ -336,7 +336,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
split
· exact h5 k.1, k_in_bounds k_ne_j1 k_ne_j2
· simp only [ne_eq]
rw [Array.get_push]
rw [Array.getElem_push]
simp only [k_in_bounds, dite_true]
exact h5 k.1, k_in_bounds k_ne_j1 k_ne_j2
· next k_not_lt_units_size =>
@@ -354,7 +354,7 @@ theorem insertUnitInvariant_insertUnit {n : Nat} (assignments0 : Array Assignmen
rcases Nat.lt_or_eq_of_le <| Nat.le_of_lt_succ k_property with k_lt_units_size | k_eq_units_size
· exfalso; exact k_not_lt_units_size k_lt_units_size
· exact k_eq_units_size
simp only [k_eq_units_size, Array.get_push_eq, ne_eq]
simp only [k_eq_units_size, Array.getElem_push_eq, ne_eq]
intro l_eq_i
simp [getElem!, l_eq_i, i_in_bounds, h3, has_both, decidableGetElem?] at h

View File

@@ -126,7 +126,6 @@ constructor_val::constructor_val(name const & n, names const & lparams, expr con
object_ref(lean_mk_constructor_val(n.to_obj_arg(), lparams.to_obj_arg(), type.to_obj_arg(), induct.to_obj_arg(),
nat(cidx).to_obj_arg(), nat(nparams).to_obj_arg(), nat(nfields).to_obj_arg(), is_unsafe)) {
}
bool constructor_val::is_unsafe() const { return lean_constructor_val_is_unsafe(to_obj_arg()); }
extern "C" object * lean_mk_recursor_val(object * n, object * lparams, object * type, object * all,
@@ -143,6 +142,18 @@ recursor_val::recursor_val(name const & n, names const & lparams, expr const & t
nat(nminors).to_obj_arg(), rules.to_obj_arg(), k, is_unsafe)) {
}
name const & recursor_val::get_major_induct() const {
unsigned int n = get_major_idx();
expr const * t = &(to_constant_val().get_type());
for (unsigned int i = 0; i < n; i++) {
t = &(binding_body(*t));
}
t = &(binding_domain(*t));
t = &(get_app_fn(*t));
return const_name(*t);
}
bool recursor_val::is_k() const { return lean_recursor_k(to_obj_arg()); }
bool recursor_val::is_unsafe() const { return lean_recursor_is_unsafe(to_obj_arg()); }

Some files were not shown because too many files have changed in this diff Show More