Compare commits

...

90 Commits

Author SHA1 Message Date
Kim Morrison
1739bcaa38 chore: cleanup of Array docstrings after refactor 2024-09-25 08:59:55 +10:00
Kim Morrison
a6f0112fc5 feat: refactor of Array (#5452)
This is a second attempt at #5446, first reverting parts of #5403.
2024-09-24 12:57:55 +00:00
Kim Morrison
eee0553318 chore: make some instance arguments implicit (#5454)
This was causing a few unnecessary `_` downstream.
2024-09-24 12:57:46 +00:00
Tobias Grosser
5d2c7fc1d9 feat: more of BitVec.getElem_* (#5404) 2024-09-24 08:04:39 +00:00
Kyle Miller
94de4ae964 fix: make Repr deriving instance handle explicit type parameters (#5432)
The `Repr` deriving instance was assuming that all type parameters are
implicit. However, if the parameter came from a type index that was
promoted to be a parameter, then it is explicit. The result was that
some explicit constructor arguments were not being represented.

Reported [on
Zulip](https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/.23eval.20removes.20indexes.20inductive.20.20object.20descriptions/near/472301282).
2024-09-24 05:37:36 +00:00
Kyle Miller
1129160d80 fix: make formatter use current token table (#5389)
Previously the formatter was using the builtin token table rather that
the one in the current environment. This could lead to round-tripping
failures for user-defined notations.

For an illustrative example, given the following notation
```lean
infixl:65 "+'" => Int.add
notation:65 a:65 "+'-" b:66 => Int.add a (id b)
```
then `5 +' -1` would parse as `Int.add 5 (-1)` and incorrectly pretty
print as `5+'-1`, which in turn would parse as `Int.add 5 (id 1)`. Now
it pretty prints as `5+' -1`.
2024-09-24 05:33:12 +00:00
Kyle Miller
8cc62940e0 feat: localize universe metavariable errors at let bindings and fun binders (#5402)
Modifies how the declaration command elaborator reports when there are
unassigned metavariables. The visible effects are that (1) now errors
like "don't know how to synthesize implicit argument" and "failed to
infer 'let' declaration type" take precedence over universe level
issues, (2) universe level metavariables are reported as metavariables
(rather than as `u_1`, `u_2`, etc.), and (3) if the universe level
metavariables appear in `let` binding types or `fun` binder types, the
error is localized there.

Motivation: Reporting unsolved expression metavariables is more
important than universe level issues (typically universe issues are from
unsolved expression metavariables). Furthermore, `let` and `fun` binders
can't introduce universe polymorphism, so we can "blame" such bindings
for universe metavariables, if possible.

Example 1: Now the errors are on `x` and `none` (reporting expression
metavariables) rather than on `example` (which reported universe level
metavariables).
```lean
example : IO Unit := do
  let x := none
  pure ()
```

Example 2: Now there is a "failed to infer universe levels in 'let'
declaration type" error on `PUnit`.
```lean
def foo : IO Unit := do
  let x : PUnit := PUnit.unit
  pure ()
```


In more detail:
* `elabMutualDef` used to turn all level mvars into fresh level
parameters before doing an analysis for "hidden levels". This analysis
turns out to be exactly the same as instead creating fresh parameters
for level mvars in only pre-definitions' types and then looking for
level metavariables in their bodies. With this PR, error messages refer
to the same level metavariables in the Infoview, rather than obscure
generated `u_1`, `u_2`, ... level parameters.
* This PR made it possible to push the "hidden levels" check into
`addPreDefinitions`, after the checks for unassigned expression mvars.
It used to be that if the "hidden levels" check produced an "invalid
occurrence of universe level" error it would suppress errors for
unassigned expression mvars, and now it is the other way around.
* There is now a list of `LevelMVarErrorInfo` objects in the `TermElabM`
state. These record expressions that should receive a localized error if
they still contain level metavariables. Currently `let` expressions and
binder types in general register such info. Error messages make use of a
new `exposeLevelMVars` function that adds pretty printer annotations
that try to expose all universe level metavariables.
* When there are universe level metavariables, for error recovery the
definition is still added to the environment after assigning each
metavariable to level 0.
* There's a new `Lean.Util.CollectLevelMVars` module for collecting
level metavariables from expressions.

Closes #2058
2024-09-24 05:30:42 +00:00
Kim Morrison
b612403980 chore: update copyrights (#5449) 2024-09-24 05:27:53 +00:00
Kim Morrison
6b0d4e50c0 chore: update Pi instance names (#5447)
Override instance names for nonempty / inhabited / subsingleton arrows,
per
[zulip](https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Pi.20instance.20names.20in.20Lean.204.20core/near/466248246).
2024-09-24 04:12:51 +00:00
Siddharth
0cae7165aa feat: BitVec.toNat_{add,sub,mul_of_lt} for BitVector non-overflow reasoning (#5411)
These theorems are useful when one wants to simplify the goal state,
under knowledge that the bitvector operations don't overflow. This can
produce much smaller goal states that eventually allows `bv_omega` to
quickly close the goal.

Note that the LHS of the theorem is *not* in `simp` normal form, since
e.g. `(x + y).toNat` is normalized to `(x.toNat + y.toNat) % 2^w`. It's
not immediately clear to me what should be done about this.

Co-authored-by: Kim Morrison <scott.morrison@gmail.com>
2024-09-24 03:54:50 +00:00
euprunin
ba43ce18c3 chore: remove repeated words (#5438)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
Co-authored-by: Kim Morrison <scott.morrison@gmail.com>
2024-09-24 03:40:11 +00:00
Tobias Grosser
3190be3058 feat: add LawCommIdentity + IdempotentOp for BitVec.[and|or|xor] (#5416)
As these instances seemingly require explicit arguments, this PR also
makes some arguments explicit.
2024-09-24 03:27:57 +00:00
TomasPuverle
a108644461 feat: implement To/FromJSON Empty (#5421)
Resolve cases when the `To/FromJSON` type classes are used with `Empty`,
e.g. in the following motivating example.

```
import Lean

structure Foo (α : Type) where
  y : Option α
deriving Lean.ToJson

#eval Lean.toJson (⟨none⟩ : Foo Empty) -- fails
```

This is a follow-up to this PR
https://github.com/leanprover/lean4/pull/5415, as suggested by
@eric-wieser. It expands on the original suggestion by also handling
`FromJSON`.

---------

Co-authored-by: Kyle Miller <kmill31415@gmail.com>
2024-09-24 03:27:23 +00:00
euprunin
4b47a10bef chore: fix spelling mistakes in tests (#5439)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-24 03:22:53 +00:00
euprunin
2d5ebf3705 chore: fix spelling mistakes in RELEASES.md (#5440)
---

Correct some stray spelling mistakes. I think the typo count is
asymptotically approaching zero.

Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-24 03:20:13 +00:00
Kim Morrison
5017b2bfbf chore: Mathlib's lean-pr-testing-NNNN branches should use Batteries' lean-pr-testing-NNNN branches (#5444)
The problem here was that in Mathlib's `lean-pr-testing-NNNN` branches,
we were setting Batteries to a `nightly-testing-YYYY-MM-DD` branch. This
means that when we merge or rebase a new `nightly-with-mathlib` into a
Lean PR, the corresponding Mathlib testing branch would keep using an
old version of Batteries.

We also make sure to bump Batteries if Mathlib's `lean-pr-testing-NNNN`
branch already exists.
2024-09-24 01:33:38 +00:00
euprunin
1b4ee185e8 chore: fix spelling mistakes in src/Lean/Meta/ (#5436)
---
This is the final set of fixes of this kind. Thanks for your patience!

Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 23:09:14 +00:00
euprunin
27c4c366b4 chore: remove (syntactically) duplicate imports (#5437)
---

Related: https://github.com/leanprover-community/mathlib4/pull/16384
("feat: lint on (syntactically) duplicate imports")

Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 23:07:56 +00:00
euprunin
405b5aa047 chore: fix spelling mistakes in src/Lean/Elab/ (#5435)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 21:58:16 +00:00
euprunin
edf2327229 chore: fix spelling mistakes in examples (doc/examples/) (#5434)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 21:44:55 +00:00
euprunin
cda6733f97 chore: fix spelling mistakes in non-Lean files (#5430)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 21:11:20 +00:00
euprunin
624f1b9963 chore: fix spelling mistakes in src/Init/ (#5427)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 21:09:58 +00:00
euprunin
cf94f793a2 chore: fix spelling mistakes in src/Std/ (#5431)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 20:39:34 +00:00
Henrik Böving
9185955692 feat: present the bv_decide counter example at the API (#5433) 2024-09-23 20:29:39 +00:00
Sebastian Ullrich
9d583ab4ec fix: worker: make sure to always report some recent range as progress when waiting (#5428)
On a document edit, it may be the case that the first nontrivial
snapshot is e.g. for a macro-generated tactic call that does not have
range information. In that case, instead of just displaying nothing, we
should fall back to a previous range, in this case of the original
tactic macro.
2024-09-23 15:52:52 +00:00
euprunin
50339e38d9 chore: fix spelling mistakes in src/Lean/ (#5426)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 14:56:59 +00:00
euprunin
8b61dda964 chore: fix spelling mistakes in error messages/exceptions (#5425)
Co-authored-by: euprunin <euprunin@users.noreply.github.com>
2024-09-23 13:19:05 +00:00
Leonardo de Moura
fc20b5dfb4 fix: must not reduce ite in the discriminant of match-expression when reducibility setting is .reducible (#5419)
closes #5388

See updated comment for additional details.
2024-09-23 12:26:53 +00:00
Kim Morrison
7fba7ed7b6 feat: decidable quantifers for BitVec (#5418) 2024-09-23 11:02:49 +00:00
Henrik Böving
2f2142ab37 feat: enhance the rewriting rules of bv_decide (#5423) 2024-09-23 09:22:19 +00:00
Kim Morrison
e551a366a0 feat: theorems about List.toArray (#5403) 2024-09-23 05:24:03 +00:00
Siddharth
f4afbc2f8b feat: BitVec analogues of Nat.{mul_two, two_mul, mul_succ, succ_mul} (#5410)
As requested by @hargoniX .
2024-09-23 04:37:04 +00:00
Kim Morrison
8c8585536c feat: refactor DecidableEq (Array α) (#5422) 2024-09-23 03:49:03 +00:00
Kim Morrison
c825b5a560 chore: reverse direction of List.set_map (#5405) 2024-09-23 03:44:11 +00:00
Kim Morrison
738435b90a chore: make Array functions either semireducible or use structural recursion (#5420)
Previously, it was not possible to use `decide` with most Array
functions (including `==`).

Later, we may replace some of these functions with defeqs that go via
the `List` operations, and use `csimp` lemmas for fast runtime
behaviour. In the meantime, this allows using `decide`.
2024-09-23 02:41:41 +00:00
TomasPuverle
1883c9b7eb feat: implement Repr Empty (#5415)
Given the derived `Repr` instance for types with parameters, the absence
of `Repr Empty` can cause `Repr` instance synthesis to fail. For
example, given
```lean
inductive Prim (special : Type) where
  | plus
  | other : special → Prim special
deriving Repr
```
this works:
```lean
#eval (Prim.plus : Prim Int)
```
but this fails:
```lean
#eval (Prim.plus : Prim Empty)
```

---------

Co-authored-by: Kyle Miller <kmill31415@gmail.com>
Co-authored-by: Eric Wieser <wieser.eric@gmail.com>
2024-09-23 01:11:36 +00:00
Tobias Grosser
fc52015841 feat: add _self, _zero, and _allOnes for BitVec.[and|or|xor] (#5413)
The `xor_allOnes` theorems end up in the `not` section, as the relevant
simplification lemmas are otherwise not defined.
2024-09-22 10:10:54 +00:00
Henrik Böving
a6830f90ab chore: basic cleanups for bv_decide (#5408) 2024-09-20 11:47:35 +00:00
Lean stage0 autoupdater
eceba0faf4 chore: update stage0 2024-09-20 09:14:22 +00:00
Joachim Breitner
fc963ffceb feat: apply_rfl tactic: handle Eq, HEq, better error messages (#3714)
This implements the first half of #3302: It improves the extensible
`apply_rfl` tactic (the one that looks at `refl` attributes, part of
the `rfl` macro) to

* Check itself and ahead of time that the lhs and rhs are defEq, and
give
a nice consistent error message when they don't (instead of just passing
on
  the less helpful error message from `apply Foo.refl`), and using the 
machinery that `apply` uses to elaborate expressions to highlight diffs
  in implicit arguments.

* Also handle `Eq` and `HEq` (built in) and `Iff` (using the attribute)

Care is taken that, as before, the current transparency setting affects
comparing the lhs and rhs, but not the reduction of the relation

So before we had

```lean
opaque P : Nat → Nat → Prop
@[refl] axiom P.refl (n : Nat) : P n n

/--
error: tactic 'apply' failed, failed to unify
  P ?n ?n
with
  P 42 23
⊢ P 42 23
-/
#guard_msgs in
example : P 42 23 := by apply_rfl

opaque withImplicitNat {n : Nat} : Nat

/--
error: tactic 'apply' failed, failed to unify
  P ?n ?n
with
  P withImplicitNat withImplicitNat
⊢ P withImplicitNat withImplicitNat
-/
#guard_msgs in
example : P (@withImplicitNat 42) (@withImplicitNat 23) := by apply_rfl
```

and with this PR the messages we get are

```
error: tactic 'apply_rfl' failed, The lhs
  42
is not definitionally equal to rhs
  23
⊢ P 42 23
```
resp.
```
error: tactic 'apply_rfl' failed, The lhs
  @withImplicitNat 42
is not definitionally equal to rhs
  @withImplicitNat 23
⊢ P withImplicitNat withImplicitNat
```

A test file checks the various failure modes and error messages.

I believe this `apply_rfl` can serve as the only implementation of
`rfl`, which would then complete #3302, and actually expose these
improved
error messages to the user. But as that seems to require a
non-trivial bootstrapping dance, it’ll be separate.
2024-09-20 08:25:10 +00:00
Alex Keizer
d8e0fa425b feat: instance for Inhabited (TacticM α) (#5401)
Provide an instance `Inhabited (TacticM α)`, even when `α` is not known
to be inhabited.

The default value is just the default value of `TermElabM α`, which
already has a similar instance.
2024-09-20 06:07:02 +00:00
David Thrane Christiansen
e43664c405 doc: add Verso to release checklist process (#5372)
This will help downstream users of Verso who aren't tracking Lean
`master`.
2024-09-20 06:06:09 +00:00
Kim Morrison
c50bc845c2 feat: HashSet.ofArray (unverified) (#5369)
This is being added downstream (in Batteries, and then used by Aesop).
2024-09-20 06:05:21 +00:00
Kim Morrison
b41019e8e8 feat: HashSet.partition (unverified) (#5370)
`Aesop` is depending on (a custom-rolled) `Set` data structure with
`.partition`.
2024-09-20 06:05:10 +00:00
Leonardo de Moura
0a2d121e45 fix: modify projection instance binder info (#5376)
closes #5333

This PR tries to address issue #5333.

My conjecture is that the binder annotations for `C.toB` and
`Algebra.toSMul` are not ideal. `Algebra.toSMul` is one of declarations
where the new command `set_synth_order` was used. Both classes, `C` and
`Algebra`, are parametric over instances, and in both cases, the issue
arises due to projection instances: `C.toB` and `Algebra.toSMul`. Let's
focus on the binder annotations for `C.toB`. They are as follows:

```
C.toB [inst : A 20000] [self : @C inst] : @B ...
```

As a projection, it seems odd that `inst` is an instance-implicit
argument instead of an implicit one, given that its value is fixed by
`self`. We observe the same issue in `Algebra.toSMul`:

```
Algebra.toSMul {R : Type u} {A : Type v} [inst1 : CommSemiring R] [inst2 : Semiring A]
   [self : @Algebra R A inst1 inst2] : SMul R A
```

The PR changes the binder annotations as follows:

```
C.toB {inst : A 20000} [self : @C inst] : @B ...
```

and

```
Algebra.toSMul {R : Type u} {A : Type v} {inst1 : CommSemiring R} {inst2 : Semiring A}
    [self : @Algebra R A inst1 inst2] : SMul R A
```

In both cases, the `set_synth_order` is used to force `self` to be
processed first.

In the MWE, there is no instance for `C ...`, and `C.toB` is quickly
discarded. I suspect a similar issue occurs when trying to use
`Algebra.toSMul`, where there is no `@Algebra R A ... ...`, but Lean
spends unnecessary time trying to synthesize `CommSemiring R` and
`Semiring A` instances. I believe the new binder annotations make sense,
as if there is a way to synthesize `Algebra R A ... ...`, it will tell
us how to retrieve the instance-implicit arguments.

TODO: 
- Impact on Mathlib.
- Document changes.

---------

Co-authored-by: Kim Morrison <scott.morrison@gmail.com>
Co-authored-by: Johan Commelin <johan@commelin.net>
2024-09-20 06:03:59 +00:00
Kim Morrison
152ca85fa9 chore: reorganization in Array/Basic (#5400)
Getting started on `Array`.
2024-09-20 02:01:52 +00:00
Kim Morrison
0ecf2a030a feat: List.fold relators (#5393) 2024-09-20 00:48:03 +00:00
David Thrane Christiansen
7b8f2fe54c doc: mark «tacticHave'_:=_» as an alternative form of have' (#5396)
This is to simplify the manual's cross-referencing.
2024-09-19 17:09:57 +00:00
Sebastian Ullrich
34f85bee02 fix: unused variable false positive when combining alias and non-lexical use (#5335)
We need to follow the fvar aliases registered by `match` in both
directions

Fixes #4714, fixes #2837

---------

Co-authored-by: Mario Carneiro <di.gama@gmail.com>
2024-09-19 10:51:14 +00:00
Kim Morrison
590c725943 feat: lemmas about List.maximum? (#5394) 2024-09-19 09:23:11 +00:00
Kim Morrison
9193196208 feat: List.fold / attach lemmas (#5392) 2024-09-19 08:26:06 +00:00
Kim Morrison
c3f384d6a5 feat: review of List.erase / List.find lemmas (#5391) 2024-09-19 05:37:04 +00:00
Tobias Grosser
daf24ff6aa feat: add BitVec.ofBool_[and|or|xor]_ofBool theorems (#5385)
... and use them to simplify some proofs.
2024-09-18 21:59:09 +00:00
Henrik Böving
fa6afa85df refactor: remove the last use of Lean.(HashSet|HashMap) (#5362) 2024-09-18 18:20:51 +00:00
Henrik Böving
592e1dc6c2 feat: bv_decide diagnosis (#5365)
Fixes: #5326
2024-09-18 17:55:16 +00:00
David Thrane Christiansen
c4293f04ef feat: add Nonempty instances for products (#5374)
After #5270, `partial` functions that use products of sums no longer
compile with only `Nonempty` constraints on their arguments. These
instances allow the compilation to work.
2024-09-18 16:34:45 +00:00
Kim Morrison
e417ad8a70 feat: missing Fin @[simp] lemmas (#5380) 2024-09-18 10:06:35 +00:00
Kim Morrison
ddd471223c chore: cleaning up redundant simp lemmas (#5381)
Problems reported by the simpNF linter downstream.
2024-09-18 10:06:29 +00:00
Kim Morrison
4e5e2ad311 chore: fixes spurious omega error in #5315 (#5382) 2024-09-18 09:43:09 +00:00
Kim Morrison
dcff54edb5 chore: notation ^^ for Bool.xor (#5332)
Not sure why this had been missing. Precedence is slightly higher than
`||`, matching the precedence order we have for bitwise operators.
2024-09-18 08:59:11 +00:00
Kim Morrison
30e90a4dff chore: upstream map_mergeSort (#5377)
This incorporates contributions from @eric-wieser in
https://github.com/leanprover-community/mathlib4/pull/15952 and
@fgdorais in https://github.com/leanprover-community/batteries/pull/579
2024-09-18 08:19:42 +00:00
Jeremy Tan Jie Rui
988fc7b25a chore: ensure that the rfl tactic tries Iff.rfl (#5359)
Revert the removal of the macro containing `Iff.rfl` in #5329; it was
causing errors in leanprover-community/mathlib4#16839.
2024-09-18 08:01:41 +00:00
Kim Morrison
3872027d92 chore: update stage0 2024-09-18 18:20:06 +10:00
Tobias Grosser
d38dc72a54 chore: introduce BitVec.setWidth to unify zeroExtend and truncate
incomplete deprecations

chore: complete deprecations
2024-09-18 18:20:06 +10:00
Alex Keizer
4641ed8c96 feat: add bv_decide normalization rules for ofBool (a.getLsbD i) and ofBool a[i] (#5375)
In LNSym we often use the pattern `ofBool (a.getLsbD i)` to pick out a
specific bit (`i`) from a bitvector (`a`).

By adding a rewrite to `extractLsb` to `bv_decide`s normalization set,
we can still automatically close goals that have this pattern. In the
process, I also added a simp-lemma about the value of a `Fin 1`.
2024-09-18 07:04:30 +00:00
Kim Morrison
77cd700fa8 chore: remove some @[simp]s from Fin lemmas (#5379)
These were dubious simps, barely used, that hurt confluence.
2024-09-18 05:50:11 +00:00
Kim Morrison
a6a06a620f chore: modify signature of lemmas about mergeSort (#5378)
This slightly smooths the interaction with `Prop` based reasoning in
Mathlib. Still not totally happy here.
2024-09-18 01:49:15 +00:00
Kim Morrison
21d71de481 chore: fix name of List.length_mergeSort (#5373) 2024-09-17 12:43:39 +00:00
Eric Wieser
b74f85accd fix: do not ban .. with a . on the next line (#4768)
Without this change,
```lean
example : True := by
  refine' trivial ..
  . trivial
```
is a parse error.
2024-09-17 09:57:35 +00:00
Eric Wieser
46b16b6df1 doc: explain the borrow syntax (#4305)
Obviously a link to the web docs isn't ideal, but having hovers
available on the symbol is much better than nothing.

---------

Co-authored-by: David Thrane Christiansen <david@davidchristiansen.dk>
Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2024-09-17 09:52:41 +00:00
Joachim Breitner
445c8f2ee0 feat: FunInd: more equalities in context, more careful cleanup (#5364)
A round of clean-up for the context of the functional induction
principle cases.

* Already previously, with `match e with | p => …`, functional induction
would ensure that `h : e = p` is in scope, but it wouldn’t work in
dependent cases. Now it introduces heterogeneous equality where needed
(fixes #4146)
* These equalities are now added always (previously we omitted them when
the discriminant was a variable that occurred in the goal, on the
grounds that the goal gets refined through the match, but it’s more
consistent to introduce the equality in any case)
* We no longer use `MVarId.cleanup` to clean up the goal; it was
sometimes too aggressive (fixes #5347)
* Instead, we clean up more carefully and with a custom strategy:
* First, we substitute all variables without a user-accessible name, if
we can.
  * Then, we substitute all variable, if we can, outside in.
* As we do that, we look for `HEq`s that we can turn into `Eq`s to
substitute some more
  * We substitute unused `let`s.
  
**Breaking change**: In some cases leads to a different functional
induction principle (different names and order of assumptions, for
example).
2024-09-16 12:30:12 +00:00
Kim Morrison
3f8e3e726d feat: some BitVec GetElem lemmas (#5361) 2024-09-16 11:30:05 +00:00
Kim Morrison
45af92fcd1 feat: lemmas about List.tail (#5360) 2024-09-16 09:25:24 +00:00
Tobias Grosser
7952a7f74d feat: add BitVec.getElem_truncate (#5278)
Co-authored-by: luisacicolini <luisacicolini@gmail.com>
Co-authored-by: Kim Morrison <scott@tqft.net>
2024-09-16 08:59:33 +00:00
Kim Morrison
c25d206647 chore: Fin.ofNat' uses NeZero (#5356) 2024-09-16 07:13:18 +00:00
Violeta Hernández
078e9b6d77 doc: add documentation for groupBy.loop (#5349)
We add some documentation explaining the auxiliary function in the
definition of `groupBy`. This has been moved here from Mathlib PR
[16818](https://github.com/leanprover-community/mathlib4/pull/16818) by
request of @semorrison.

---------

Co-authored-by: Kim Morrison <kim@tqft.net>
2024-09-16 05:56:44 +00:00
Kim Morrison
a745e33123 feat: BitVec.truncate lemmas (#5357)
These improve confluence of lemmas involving `truncate`.
2024-09-16 05:55:50 +00:00
Kim Morrison
7740a38a71 chore: remove @[simp] from Option.bind_map (#5354) 2024-09-16 04:44:38 +00:00
Kim Morrison
9568f305d8 chore: switch primes on List.getElem_take (#5294)
This will probably have fallout downstream, and as it is a direct name
switch I'm not going to provide any deprecations.
2024-09-16 03:40:42 +00:00
Kim Morrison
b1179d5cc3 chore: fix implicitness of List.getElem_mem (#5331) 2024-09-16 03:28:14 +00:00
Kim Morrison
e6145a6937 feat: simp lemmas for LawfulBEq (#5355) 2024-09-16 03:21:30 +00:00
Kim Morrison
d47ae99721 feat: List.head_mem_head? (#5353) 2024-09-16 03:05:17 +00:00
Kim Morrison
0aac83fe40 feat: List.attachWith lemmas (#5352) 2024-09-16 02:24:14 +00:00
Kim Morrison
8c6ac845b1 chore: cleanup after export Bool.and/or/not/xor 2024-09-16 12:45:51 +10:00
Kim Morrison
b714a96034 chore: update stage0 2024-09-16 12:45:51 +10:00
Kim Morrison
4e0f6b8b45 feat: export Bool.and/or/not/xor 2024-09-16 12:45:51 +10:00
Kim Morrison
979c5a4d6a chore: update stage0 2024-09-16 12:45:51 +10:00
Kim Morrison
2079bdcbca feat: deprecate _root_.or/and/not/xor 2024-09-16 12:45:51 +10:00
Kim Morrison
1a2217d47e feat: cleanup of List.getElem_append variants (#5303) 2024-09-16 02:01:37 +00:00
Kim Morrison
3ef67c468a feat: List.replicate lemmas (#5350) 2024-09-15 23:57:04 +00:00
469 changed files with 4956 additions and 1649 deletions

View File

@@ -25,7 +25,7 @@ Please put an X between the brackets as you perform the following steps:
### Context
[Broader context that the issue occured in. If there was any prior discussion on [the Lean Zulip](https://leanprover.zulipchat.com), link it here as well.]
[Broader context that the issue occurred in. If there was any prior discussion on [the Lean Zulip](https://leanprover.zulipchat.com), link it here as well.]
### Steps to Reproduce

View File

@@ -316,7 +316,7 @@ jobs:
git fetch --depth=1 origin ${{ github.sha }}
git checkout FETCH_HEAD flake.nix flake.lock
if: github.event_name == 'pull_request'
# (needs to be after "Checkout" so files don't get overriden)
# (needs to be after "Checkout" so files don't get overridden)
- name: Setup emsdk
uses: mymindstorm/setup-emsdk@v12
with:

View File

@@ -134,7 +134,7 @@ jobs:
MESSAGE=""
if [[ -n "$MATHLIB_REMOTE_TAGS" ]]; then
echo "... and Mathlib has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
echo "... and Mathlib has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
else
echo "... but Mathlib does not yet have a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE="- ❗ Mathlib CI can not be attempted yet, as the \`nightly-testing-$MOST_RECENT_NIGHTLY\` tag does not exist there yet. We will retry when you push more commits. If you rebase your branch onto \`nightly-with-mathlib\`, Mathlib CI should run now."
@@ -149,7 +149,7 @@ jobs:
echo "but 'git merge-base origin/master HEAD' reported: $MERGE_BASE_SHA"
git -C lean4.git log -10 origin/master
git -C lean4.git fetch origin nightly-with-mathlib
git -C lean4.git fetch origin nightly-with-mathlib
NIGHTLY_WITH_MATHLIB_SHA="$(git -C lean4.git rev-parse "origin/nightly-with-mathlib")"
MESSAGE="- ❗ Batteries/Mathlib CI will not be attempted unless your PR branches off the \`nightly-with-mathlib\` branch. Try \`git rebase $MERGE_BASE_SHA --onto $NIGHTLY_WITH_MATHLIB_SHA\`."
fi
@@ -329,16 +329,17 @@ jobs:
git switch -c lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} "$BASE"
echo "leanprover/lean4-pr-releases:pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}" > lean-toolchain
git add lean-toolchain
sed -i 's,require "leanprover-community" / "batteries" @ git ".\+",require "leanprover-community" / "batteries" @ git "nightly-testing-'"${MOST_RECENT_NIGHTLY}"'",' lakefile.lean
sed -i 's,require "leanprover-community" / "batteries" @ git ".\+",require "leanprover-community" / "batteries" @ git "lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}",' lakefile.lean
lake update batteries
git add lakefile.lean lake-manifest.json
git commit -m "Update lean-toolchain for testing https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
else
echo "Branch already exists, pushing an empty commit."
echo "Branch already exists, merging $BASE and bumping Batteries."
git switch lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}
# The Mathlib `nightly-testing` branch or `nightly-testing-YYYY-MM-DD` tag may have moved since this branch was created, so merge their changes.
# (This should no longer be possible once `nightly-testing-YYYY-MM-DD` is a tag, but it is still safe to merge.)
git merge "$BASE" --strategy-option ours --no-commit --allow-unrelated-histories
lake update batteries
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
fi

View File

@@ -381,7 +381,7 @@ v4.10.0
* **Commands**
* [#4370](https://github.com/leanprover/lean4/pull/4370) makes the `variable` command fully elaborate binders during validation, fixing an issue where some errors would be reported only at the next declaration.
* [#4408](https://github.com/leanprover/lean4/pull/4408) fixes a discrepency in universe parameter order between `theorem` and `def` declarations.
* [#4408](https://github.com/leanprover/lean4/pull/4408) fixes a discrepancy in universe parameter order between `theorem` and `def` declarations.
* [#4493](https://github.com/leanprover/lean4/pull/4493) and
[#4482](https://github.com/leanprover/lean4/pull/4482) fix a discrepancy in the elaborators for `theorem`, `def`, and `example`,
making `Prop`-valued `example`s and other definition commands elaborate like `theorem`s.
@@ -443,7 +443,7 @@ v4.10.0
* [#4454](https://github.com/leanprover/lean4/pull/4454) adds public `Name.isInternalDetail` function for filtering declarations using naming conventions for internal names.
* **Other fixes or improvements**
* [#4416](https://github.com/leanprover/lean4/pull/4416) sorts the ouput of `#print axioms` for determinism.
* [#4416](https://github.com/leanprover/lean4/pull/4416) sorts the output of `#print axioms` for determinism.
* [#4528](https://github.com/leanprover/lean4/pull/4528) fixes error message range for the cdot focusing tactic.
### Language server, widgets, and IDE extensions
@@ -479,7 +479,7 @@ v4.10.0
* [#4372](https://github.com/leanprover/lean4/pull/4372) fixes linearity in `HashMap.insert` and `HashMap.erase`, leading to a 40% speedup in a replace-heavy workload.
* `Option`
* [#4403](https://github.com/leanprover/lean4/pull/4403) generalizes type of `Option.forM` from `Unit` to `PUnit`.
* [#4504](https://github.com/leanprover/lean4/pull/4504) remove simp attribute from `Option.elim` and instead adds it to individal reduction lemmas, making unfolding less aggressive.
* [#4504](https://github.com/leanprover/lean4/pull/4504) remove simp attribute from `Option.elim` and instead adds it to individual reduction lemmas, making unfolding less aggressive.
* `Nat`
* [#4242](https://github.com/leanprover/lean4/pull/4242) adds missing theorems for `n + 1` and `n - 1` normal forms.
* [#4486](https://github.com/leanprover/lean4/pull/4486) makes `Nat.min_assoc` be a simp lemma.
@@ -940,7 +940,7 @@ While most changes could be considered to be a breaking change, this section mak
In particular, tactics embedded in the type will no longer make use of the type of `value` in expressions such as `let x : type := value; body`.
* Now functions defined by well-founded recursion are marked with `@[irreducible]` by default ([#4061](https://github.com/leanprover/lean4/pull/4061)).
Existing proofs that hold by definitional equality (e.g. `rfl`) can be
rewritten to explictly unfold the function definition (using `simp`,
rewritten to explicitly unfold the function definition (using `simp`,
`unfold`, `rw`), or the recursive function can be temporarily made
semireducible (using `unseal f in` before the command), or the function
definition itself can be marked as `@[semireducible]` to get the previous
@@ -1559,7 +1559,7 @@ v4.7.0
and `BitVec` as we begin making the APIs and simp normal forms for these types
more complete and consistent.
4. Laying the groundwork for the Std roadmap, as a library focused on
essential datatypes not provided by the core langauge (e.g. `RBMap`)
essential datatypes not provided by the core language (e.g. `RBMap`)
and utilities such as basic IO.
While we have achieved most of our initial aims in `v4.7.0-rc1`,
some upstreaming will continue over the coming months.
@@ -1570,7 +1570,7 @@ v4.7.0
There is now kernel support for these functions.
[#3376](https://github.com/leanprover/lean4/pull/3376).
* `omega`, our integer linear arithmetic tactic, is now availabe in the core langauge.
* `omega`, our integer linear arithmetic tactic, is now available in the core language.
* It is supplemented by a preprocessing tactic `bv_omega` which can solve goals about `BitVec`
which naturally translate into linear arithmetic problems.
[#3435](https://github.com/leanprover/lean4/pull/3435).
@@ -1663,11 +1663,11 @@ v4.6.0
/-
The `Step` type has three constructors: `.done`, `.visit`, `.continue`.
* The constructor `.done` instructs `simp` that the result does
not need to be simplied further.
not need to be simplified further.
* The constructor `.visit` instructs `simp` to visit the resulting expression.
* The constructor `.continue` instructs `simp` to try other simplification procedures.
All three constructors take a `Result`. The `.continue` contructor may also take `none`.
All three constructors take a `Result`. The `.continue` constructor may also take `none`.
`Result` has two fields `expr` (the new expression), and `proof?` (an optional proof).
If the new expression is definitionally equal to the input one, then `proof?` can be omitted or set to `none`.
-/
@@ -1879,7 +1879,7 @@ v4.5.0
---------
* Modify the lexical syntax of string literals to have string gaps, which are escape sequences of the form `"\" newline whitespace*`.
These have the interpetation of an empty string and allow a string to flow across multiple lines without introducing additional whitespace.
These have the interpretation of an empty string and allow a string to flow across multiple lines without introducing additional whitespace.
The following is equivalent to `"this is a string"`.
```lean
"this is \
@@ -1902,7 +1902,7 @@ v4.5.0
If the well-founded relation you want to use is not the one that the
`WellFoundedRelation` type class would infer for your termination argument,
you can use `WellFounded.wrap` from the std libarary to explicitly give one:
you can use `WellFounded.wrap` from the std library to explicitly give one:
```diff
-termination_by' ⟨r, hwf⟩
+termination_by x => hwf.wrap x

View File

@@ -73,7 +73,7 @@ update the archived C source code of the stage 0 compiler in `stage0/src`.
The github repository will automatically update stage0 on `master` once
`src/stdlib_flags.h` and `stage0/src/stdlib_flags.h` are out of sync.
If you have write access to the lean4 repository, you can also also manually
If you have write access to the lean4 repository, you can also manually
trigger that process, for example to be able to use new features in the compiler itself.
You can do that on <https://github.com/leanprover/lean4/actions/workflows/update-stage0.yml>
or using Github CLI with

View File

@@ -71,6 +71,12 @@ We'll use `v4.6.0` as the intended release version as a running example.
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [Verso](https://github.com/leanprover/verso)
- Dependencies: exist, but they're not part of the release workflow
- The `SubVerso` dependency should be compatible with _every_ Lean release simultaneously, rather than following this workflow
- Toolchain bump PR including updated Lake manifest
- Create and push the tag
- There is no `stable` branch; skip this step
- [import-graph](https://github.com/leanprover-community/import-graph)
- Toolchain bump PR including updated Lake manifest
- Create and push the tag

View File

@@ -18,7 +18,7 @@ def ctor (mvarId : MVarId) (idx : Nat) : MetaM (List MVarId) := do
else if h : idx - 1 < ctors.length then
mvarId.apply (.const ctors[idx - 1] us)
else
throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} contructors"
throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} constructors"
open Elab Tactic

View File

@@ -149,7 +149,7 @@ We now define the constant folding optimization that traverses a term if replace
/-!
The correctness of the `Term.constFold` is proved using induction, case-analysis, and the term simplifier.
We prove all cases but the one for `plus` using `simp [*]`. This tactic instructs the term simplifier to
use hypotheses such as `a = b` as rewriting/simplications rules.
use hypotheses such as `a = b` as rewriting/simplifications rules.
We use the `split` to break the nested `match` expression in the `plus` case into two cases.
The local variables `iha` and `ihb` are the induction hypotheses for `a` and `b`.
The modifier `←` in a term simplifier argument instructs the term simplifier to use the equation as a rewriting rule in

View File

@@ -225,7 +225,7 @@ We now define the constant folding optimization that traverses a term if replace
/-!
The correctness of the `constFold` is proved using induction, case-analysis, and the term simplifier.
We prove all cases but the one for `plus` using `simp [*]`. This tactic instructs the term simplifier to
use hypotheses such as `a = b` as rewriting/simplications rules.
use hypotheses such as `a = b` as rewriting/simplifications rules.
We use the `split` to break the nested `match` expression in the `plus` case into two cases.
The local variables `iha` and `ihb` are the induction hypotheses for `a` and `b`.
The modifier `←` in a term simplifier argument instructs the term simplifier to use the equation as a rewriting rule in

View File

@@ -29,7 +29,7 @@ inductive HasType : Expr → Ty → Prop
/-!
We can easily show that if `e` has type `t₁` and type `t₂`, then `t₁` and `t₂` must be equal
by using the the `cases` tactic. This tactic creates a new subgoal for every constructor,
by using the `cases` tactic. This tactic creates a new subgoal for every constructor,
and automatically discharges unreachable cases. The tactic combinator `tac₁ <;> tac₂` applies
`tac₂` to each subgoal produced by `tac₁`. Then, the tactic `rfl` is used to close all produced
goals using reflexivity.
@@ -82,7 +82,7 @@ theorem Expr.typeCheck_correct (h₁ : HasType e ty) (h₂ : e.typeCheck ≠ .un
/-!
Now, we prove that if `Expr.typeCheck e` returns `Maybe.unknown`, then forall `ty`, `HasType e ty` does not hold.
The notation `e.typeCheck` is sugar for `Expr.typeCheck e`. Lean can infer this because we explicitly said that `e` has type `Expr`.
The proof is by induction on `e` and case analysis. The tactic `rename_i` is used to to rename "inaccessible" variables.
The proof is by induction on `e` and case analysis. The tactic `rename_i` is used to rename "inaccessible" variables.
We say a variable is inaccessible if it is introduced by a tactic (e.g., `cases`) or has been shadowed by another variable introduced
by the user. Note that the tactic `simp [typeCheck]` is applied to all goal generated by the `induction` tactic, and closes
the cases corresponding to the constructors `Expr.nat` and `Expr.bool`.

View File

@@ -93,7 +93,7 @@ Meaning "Remote Procedure Call",this is a Lean function callable from widget cod
Our method will take in the `name : Name` of a constant in the environment and return its type.
By convention, we represent the input data as a `structure`.
Since it will be sent over from JavaScript,
we need `FromJson` and `ToJson` instnace.
we need `FromJson` and `ToJson` instance.
We'll see why the position field is needed later.
-/

View File

@@ -396,7 +396,7 @@ Every expression in Lean has a natural computational interpretation, unless it i
* *β-reduction* : An expression ``(λ x, t) s`` β-reduces to ``t[s/x]``, that is, the result of replacing ``x`` by ``s`` in ``t``.
* *ζ-reduction* : An expression ``let x := s in t`` ζ-reduces to ``t[s/x]``.
* *δ-reduction* : If ``c`` is a defined constant with definition ``t``, then ``c`` δ-reduces to to ``t``.
* *δ-reduction* : If ``c`` is a defined constant with definition ``t``, then ``c`` δ-reduces to ``t``.
* *ι-reduction* : When a function defined by recursion on an inductive type is applied to an element given by an explicit constructor, the result ι-reduces to the specified function value, as described in [Inductive Types](inductive.md).
The reduction relation is transitive, which is to say, is ``s`` reduces to ``s'`` and ``t`` reduces to ``t'``, then ``s t`` reduces to ``s' t'``, ``λ x, s`` reduces to ``λ x, s'``, and so on. If ``s`` and ``t`` reduce to a common term, they are said to be *definitionally equal*. Definitional equality is defined to be the smallest equivalence relation that satisfies all these properties and also includes α-equivalence and the following two relations:

View File

@@ -171,7 +171,7 @@ of data contained in the container resulting in a new container that has the sam
`u <*> pure y = pure (. y) <*> u`.
This law is is a little more complicated, so don't sweat it too much. It states that the order that
This law is a little more complicated, so don't sweat it too much. It states that the order that
you wrap things shouldn't matter. One the left, you apply any applicative `u` over a pure wrapped
object. On the right, you first wrap a function applying the object as an argument. Note that `(·
y)` is short hand for: `fun f => f y`. Then you apply this to the first applicative `u`. These

View File

@@ -17,7 +17,7 @@ for f in $(git ls-files src ':!:src/lake/*' ':!:src/Leanc.lean'); do
done
# special handling for Lake files due to its nested directory
# copy the README to ensure the `stage0/src/lake` directory is comitted
# copy the README to ensure the `stage0/src/lake` directory is committed
for f in $(git ls-files 'src/lake/Lake/*' src/lake/Lake.lean src/lake/LakeMain.lean src/lake/README.md ':!:src/lakefile.toml'); do
if [[ $f == *.lean ]]; then
f=${f#src/lake}

View File

@@ -40,21 +40,23 @@ theorem apply_ite (f : α → β) (P : Prop) [Decidable P] (x y : α) :
/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/
@[simp] theorem dite_eq_ite [Decidable P] : (dite P (fun _ => a) fun _ => b) = ite P a b := rfl
-- We don't mark this as `simp` as it is already handled by `ite_eq_right_iff`.
@[deprecated "Use `ite_eq_right_iff`" (since := "2024-09-18")]
theorem ite_some_none_eq_none [Decidable P] :
(if P then some x else none) = none ¬ P := by
simp only [ite_eq_right_iff, reduceCtorEq]
rfl
@[simp] theorem ite_some_none_eq_some [Decidable P] :
@[deprecated "Use `Option.ite_none_right_eq_some`" (since := "2024-09-18")]
theorem ite_some_none_eq_some [Decidable P] :
(if P then some x else none) = some y P x = y := by
split <;> simp_all
-- This is not marked as `simp` as it is already handled by `dite_eq_right_iff`.
@[deprecated "Use `dite_eq_right_iff" (since := "2024-09-18")]
theorem dite_some_none_eq_none [Decidable P] {x : P α} :
(if h : P then some (x h) else none) = none ¬P := by
simp
@[simp] theorem dite_some_none_eq_some [Decidable P] {x : P α} {y : α} :
@[deprecated "Use `Option.dite_none_right_eq_some`" (since := "2024-09-18")]
theorem dite_some_none_eq_some [Decidable P] {x : P α} {y : α} :
(if h : P then some (x h) else none) = some y h : P, x h = y := by
by_cases h : P <;> simp [h]

View File

@@ -121,11 +121,11 @@ theorem propComplete (a : Prop) : a = True a = False :=
| Or.inl ha => Or.inl (eq_true ha)
| Or.inr hn => Or.inr (eq_false hn)
-- this supercedes byCases in Decidable
-- this supersedes byCases in Decidable
theorem byCases {p q : Prop} (hpq : p q) (hnpq : ¬p q) : q :=
Decidable.byCases (dec := propDecidable _) hpq hnpq
-- this supercedes byContradiction in Decidable
-- this supersedes byContradiction in Decidable
theorem byContradiction {p : Prop} (h : ¬p False) : p :=
Decidable.byContradiction (dec := propDecidable _) h

View File

@@ -28,7 +28,7 @@ Important instances include
* `Option`, where `failure := none` and `<|>` returns the left-most `some`.
* Parser combinators typically provide an `Applicative` instance for error-handling and
backtracking.
Error recovery and state can interact subtly. For example, the implementation of `Alternative` for `OptionT (StateT σ Id)` keeps modifications made to the state while recovering from failure, while `StateT σ (OptionT Id)` discards them.
-/
-- NB: List instance is in mathlib. Once upstreamed, add

View File

@@ -823,6 +823,8 @@ theorem iff_iff_implies_and_implies {a b : Prop} : (a ↔ b) ↔ (a → b) ∧ (
protected theorem Iff.rfl {a : Prop} : a a :=
Iff.refl a
macro_rules | `(tactic| rfl) => `(tactic| exact Iff.rfl)
theorem Iff.of_eq (h : a = b) : a b := h Iff.rfl
theorem Iff.trans (h₁ : a b) (h₂ : b c) : a c :=
@@ -1191,6 +1193,21 @@ end
/-! # Product -/
instance [h1 : Nonempty α] [h2 : Nonempty β] : Nonempty (α × β) :=
Nonempty.elim h1 fun x =>
Nonempty.elim h2 fun y =>
(x, y)
instance [h1 : Nonempty α] [h2 : Nonempty β] : Nonempty (MProd α β) :=
Nonempty.elim h1 fun x =>
Nonempty.elim h2 fun y =>
x, y
instance [h1 : Nonempty α] [h2 : Nonempty β] : Nonempty (PProd α β) :=
Nonempty.elim h1 fun x =>
Nonempty.elim h2 fun y =>
x, y
instance [Inhabited α] [Inhabited β] : Inhabited (α × β) where
default := (default, default)
@@ -1875,7 +1892,8 @@ theorem funext {α : Sort u} {β : α → Sort v} {f g : (x : α) → β x}
show extfunApp (Quot.mk eqv f) = extfunApp (Quot.mk eqv g)
exact congrArg extfunApp (Quot.sound h)
instance {α : Sort u} {β : α Sort v} [ a, Subsingleton (β a)] : Subsingleton ( a, β a) where
instance Pi.instSubsingleton {α : Sort u} {β : α Sort v} [ a, Subsingleton (β a)] :
Subsingleton ( a, β a) where
allEq f g := funext fun a => Subsingleton.elim (f a) (g a)
/-! # Squash -/
@@ -2038,7 +2056,7 @@ class IdempotentOp (op : ααα) : Prop where
`LeftIdentify op o` indicates `o` is a left identity of `op`.
This class does not require a proof that `o` is an identity, and
is used primarily for infering the identity using class resoluton.
is used primarily for inferring the identity using class resolution.
-/
class LeftIdentity (op : α β β) (o : outParam α) : Prop
@@ -2054,7 +2072,7 @@ class LawfulLeftIdentity (op : α → β → β) (o : outParam α) extends LeftI
`RightIdentify op o` indicates `o` is a right identity `o` of `op`.
This class does not require a proof that `o` is an identity, and is used
primarily for infering the identity using class resoluton.
primarily for inferring the identity using class resolution.
-/
class RightIdentity (op : α β α) (o : outParam β) : Prop
@@ -2070,7 +2088,7 @@ class LawfulRightIdentity (op : α → β → α) (o : outParam β) extends Righ
`Identity op o` indicates `o` is a left and right identity of `op`.
This class does not require a proof that `o` is an identity, and is used
primarily for infering the identity using class resoluton.
primarily for inferring the identity using class resolution.
-/
class Identity (op : α α α) (o : outParam α) extends LeftIdentity op o, RightIdentity op o : Prop

View File

@@ -33,7 +33,6 @@ import Init.Data.Prod
import Init.Data.AC
import Init.Data.Queue
import Init.Data.Channel
import Init.Data.Cast
import Init.Data.Sum
import Init.Data.BEq
import Init.Data.Subtype

View File

@@ -15,3 +15,4 @@ import Init.Data.Array.BasicAux
import Init.Data.Array.Lemmas
import Init.Data.Array.TakeDrop
import Init.Data.Array.Bootstrap
import Init.Data.Array.GetLit

View File

@@ -13,43 +13,75 @@ import Init.Data.ToString.Basic
import Init.GetElem
universe u v w
namespace Array
/-! ### Array literal syntax -/
syntax "#[" withoutPosition(sepBy(term, ", ")) "]" : term
macro_rules
| `(#[ $elems,* ]) => `(List.toArray [ $elems,* ])
variable {α : Type u}
namespace Array
/-! ### Preliminary theorems -/
@[simp] theorem size_set (a : Array α) (i : Fin a.size) (v : α) : (set a i v).size = a.size :=
List.length_set ..
@[simp] theorem size_push (a : Array α) (v : α) : (push a v).size = a.size + 1 :=
List.length_concat ..
theorem ext (a b : Array α)
(h₁ : a.size = b.size)
(h₂ : (i : Nat) (hi₁ : i < a.size) (hi₂ : i < b.size) a[i] = b[i])
: a = b := by
let rec extAux (a b : List α)
(h₁ : a.length = b.length)
(h₂ : (i : Nat) (hi₁ : i < a.length) (hi₂ : i < b.length) a.get i, hi₁ = b.get i, hi₂)
: a = b := by
induction a generalizing b with
| nil =>
cases b with
| nil => rfl
| cons b bs => rw [List.length_cons] at h₁; injection h₁
| cons a as ih =>
cases b with
| nil => rw [List.length_cons] at h₁; injection h₁
| cons b bs =>
have hz₁ : 0 < (a::as).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
have hz₂ : 0 < (b::bs).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
have headEq : a = b := h₂ 0 hz₁ hz₂
have h₁' : as.length = bs.length := by rw [List.length_cons, List.length_cons] at h₁; injection h₁
have h₂' : (i : Nat) (hi₁ : i < as.length) (hi₂ : i < bs.length) as.get i, hi₁ = bs.get i, hi₂ := by
intro i hi₁ hi₂
have hi₁' : i+1 < (a::as).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
have hi₂' : i+1 < (b::bs).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
have : (a::as).get i+1, hi₁' = (b::bs).get i+1, hi₂' := h₂ (i+1) hi₁' hi₂'
apply this
have tailEq : as = bs := ih bs h₁' h₂'
rw [headEq, tailEq]
cases a; cases b
apply congrArg
apply extAux
assumption
assumption
theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
cases as; cases bs; simp at h; rw [h]
@[simp] theorem toArrayAux_eq (as : List α) (acc : Array α) : (as.toArrayAux acc).toList = acc.toList ++ as := by
induction as generalizing acc <;> simp [*, List.toArrayAux, Array.push, List.append_assoc, List.concat_eq_append]
@[simp] theorem toList_toArray (as : List α) : as.toArray.toList = as := rfl
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
@[deprecated toList_toArray (since := "2024-09-09")] abbrev data_toArray := @toList_toArray
@[deprecated Array.toList (since := "2024-09-10")] abbrev Array.data := @Array.toList
@[extern "lean_mk_array"]
def mkArray {α : Type u} (n : Nat) (v : α) : Array α where
toList := List.replicate n v
/--
`ofFn f` with `f : Fin n → α` returns the list whose ith element is `f i`.
```
ofFn f = #[f 0, f 1, ... , f(n - 1)]
``` -/
def ofFn {n} (f : Fin n α) : Array α := go 0 (mkEmpty n) where
/-- Auxiliary for `ofFn`. `ofFn.go f i acc = acc ++ #[f i, ..., f(n - 1)]` -/
go (i : Nat) (acc : Array α) : Array α :=
if h : i < n then go (i+1) (acc.push (f i, h)) else acc
termination_by n - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
/-- The array `#[0, 1, ..., n - 1]`. -/
def range (n : Nat) : Array Nat :=
n.fold (flip Array.push) (mkEmpty n)
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
List.length_replicate ..
instance : EmptyCollection (Array α) := Array.empty
instance : Inhabited (Array α) where
default := Array.empty
@[simp] def isEmpty (a : Array α) : Bool :=
a.size = 0
def singleton (v : α) : Array α :=
mkArray 1 v
/-! ### Externs -/
/-- Low-level version of `size` that directly queries the C array object cached size.
While this is not provable, `usize` always returns the exact size of the array since
@@ -65,29 +97,6 @@ def usize (a : @& Array α) : USize := a.size.toUSize
def uget (a : @& Array α) (i : USize) (h : i.toNat < a.size) : α :=
a[i.toNat]
instance : GetElem (Array α) USize α fun xs i => i.toNat < xs.size where
getElem xs i h := xs.uget i h
def back [Inhabited α] (a : Array α) : α :=
a.get! (a.size - 1)
def get? (a : Array α) (i : Nat) : Option α :=
if h : i < a.size then some a[i] else none
def back? (a : Array α) : Option α :=
a.get? (a.size - 1)
-- auxiliary declaration used in the equation compiler when pattern matching array literals.
abbrev getLit {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size = n) (h₂ : i < n) : α :=
have := h₁.symm h₂
a[i]
@[simp] theorem size_set (a : Array α) (i : Fin a.size) (v : α) : (set a i v).size = a.size :=
List.length_set ..
@[simp] theorem size_push (a : Array α) (v : α) : (push a v).size = a.size + 1 :=
List.length_concat ..
/-- Low-level version of `fset` which is as fast as a C array fset.
`Fin` values are represented as tag pointers in the Lean runtime. Thus,
`fset` may be slightly slower than `uset`. -/
@@ -95,6 +104,19 @@ abbrev getLit {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size =
def uset (a : Array α) (i : USize) (v : α) (h : i.toNat < a.size) : Array α :=
a.set i.toNat, h v
@[extern "lean_array_pop"]
def pop (a : Array α) : Array α where
toList := a.toList.dropLast
@[simp] theorem size_pop (a : Array α) : a.pop.size = a.size - 1 := by
match a with
| [] => rfl
| a::as => simp [pop, Nat.succ_sub_succ_eq_sub, size]
@[extern "lean_mk_array"]
def mkArray {α : Type u} (n : Nat) (v : α) : Array α where
toList := List.replicate n v
/--
Swaps two entries in an array.
@@ -108,6 +130,10 @@ def swap (a : Array α) (i j : @& Fin a.size) : Array α :=
let a' := a.set i v₂
a'.set (size_set a i v₂ j) v₁
@[simp] theorem size_swap (a : Array α) (i j : Fin a.size) : (a.swap i j).size = a.size := by
show ((a.set i (a.get j)).set (size_set a i _ j) (a.get i)).size = a.size
rw [size_set, size_set]
/--
Swaps two entries in an array, or returns the array unchanged if either index is out of bounds.
@@ -121,6 +147,64 @@ def swap! (a : Array α) (i j : @& Nat) : Array α :=
else a
else a
/-! ### GetElem instance for `USize`, backed by `uget` -/
instance : GetElem (Array α) USize α fun xs i => i.toNat < xs.size where
getElem xs i h := xs.uget i h
/-! ### Definitions -/
instance : EmptyCollection (Array α) := Array.empty
instance : Inhabited (Array α) where
default := Array.empty
@[simp] def isEmpty (a : Array α) : Bool :=
a.size = 0
@[specialize]
def isEqvAux (a b : Array α) (hsz : a.size = b.size) (p : α α Bool) :
(i : Nat) (_ : i a.size), Bool
| 0, _ => true
| i+1, h =>
p a[i] (b[i]'(hsz h)) && isEqvAux a b hsz p i (Nat.le_trans (Nat.le_add_right i 1) h)
@[inline] def isEqv (a b : Array α) (p : α α Bool) : Bool :=
if h : a.size = b.size then
isEqvAux a b h p a.size (Nat.le_refl a.size)
else
false
instance [BEq α] : BEq (Array α) :=
fun a b => isEqv a b BEq.beq
/--
`ofFn f` with `f : Fin n → α` returns the list whose ith element is `f i`.
```
ofFn f = #[f 0, f 1, ... , f(n - 1)]
``` -/
def ofFn {n} (f : Fin n α) : Array α := go 0 (mkEmpty n) where
/-- Auxiliary for `ofFn`. `ofFn.go f i acc = acc ++ #[f i, ..., f(n - 1)]` -/
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
go (i : Nat) (acc : Array α) : Array α :=
if h : i < n then go (i+1) (acc.push (f i, h)) else acc
decreasing_by simp_wf; decreasing_trivial_pre_omega
/-- The array `#[0, 1, ..., n - 1]`. -/
def range (n : Nat) : Array Nat :=
n.fold (flip Array.push) (mkEmpty n)
def singleton (v : α) : Array α :=
mkArray 1 v
def back [Inhabited α] (a : Array α) : α :=
a.get! (a.size - 1)
def get? (a : Array α) (i : Nat) : Option α :=
if h : i < a.size then some a[i] else none
def back? (a : Array α) : Option α :=
a.get? (a.size - 1)
@[inline] def swapAt (a : Array α) (i : Fin a.size) (v : α) : α × Array α :=
let e := a.get i
let a := a.set i v
@@ -134,10 +218,6 @@ def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
have : Inhabited α := v
panic! ("index " ++ toString i ++ " out of bounds")
@[extern "lean_array_pop"]
def pop (a : Array α) : Array α where
toList := a.toList.dropLast
def shrink (a : Array α) (n : Nat) : Array α :=
let rec loop
| 0, a => a
@@ -306,12 +386,12 @@ unsafe def mapMUnsafe {α : Type u} {β : Type v} {m : Type v → Type w} [Monad
def mapM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α m β) (as : Array α) : m (Array β) :=
-- Note: we cannot use `foldlM` here for the reference implementation because this calls
-- `bind` and `pure` too many times. (We are not assuming `m` is a `LawfulMonad`)
let rec map (i : Nat) (r : Array β) : m (Array β) := do
if hlt : i < as.size then
map (i+1) (r.push ( f as[i]))
else
pure r
termination_by as.size - i
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
map (i : Nat) (r : Array β) : m (Array β) := do
if hlt : i < as.size then
map (i+1) (r.push ( f as[i]))
else
pure r
decreasing_by simp_wf; decreasing_trivial_pre_omega
map 0 (mkEmpty as.size)
@@ -375,7 +455,8 @@ unsafe def anyMUnsafe {α : Type u} {m : Type → Type w} [Monad m] (p : α
@[implemented_by anyMUnsafe]
def anyM {α : Type u} {m : Type Type w} [Monad m] (p : α m Bool) (as : Array α) (start := 0) (stop := as.size) : m Bool :=
let any (stop : Nat) (h : stop as.size) :=
let rec loop (j : Nat) : m Bool := do
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (j : Nat) : m Bool := do
if hlt : j < stop then
have : j < as.size := Nat.lt_of_lt_of_le hlt h
if ( p as[j]) then
@@ -384,7 +465,6 @@ def anyM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as :
loop (j+1)
else
pure false
termination_by stop - j
decreasing_by simp_wf; decreasing_trivial_pre_omega
loop start
if h : stop as.size then
@@ -466,16 +546,28 @@ def findRev? {α : Type} (as : Array α) (p : α → Bool) : Option α :=
@[inline]
def findIdx? {α : Type u} (as : Array α) (p : α Bool) : Option Nat :=
let rec loop (j : Nat) :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (j : Nat) :=
if h : j < as.size then
if p as[j] then some j else loop (j + 1)
else none
termination_by as.size - j
decreasing_by simp_wf; decreasing_trivial_pre_omega
loop 0
def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
a.findIdx? fun a => a == v
a.findIdx? fun a => a == v
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
if h : i < a.size then
let idx : Fin a.size := i, h;
if a.get idx == v then some idx
else indexOfAux a v (i+1)
else none
decreasing_by simp_wf; decreasing_trivial_pre_omega
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
indexOfAux a v 0
@[inline]
def any (as : Array α) (p : α Bool) (start := 0) (stop := as.size) : Bool :=
@@ -491,13 +583,6 @@ def contains [BEq α] (as : Array α) (a : α) : Bool :=
def elem [BEq α] (a : α) (as : Array α) : Bool :=
as.contains a
@[inline] def getEvenElems (as : Array α) : Array α :=
(·.2) <| as.foldl (init := (true, Array.empty)) fun (even, r) a =>
if even then
(false, r.push a)
else
(true, r)
/-- Convert a `Array α` into an `List α`. This is O(n) in the size of the array. -/
-- This function is exported to C, where it is called by `Array.toList`
-- (the projection) to implement this functionality.
@@ -510,17 +595,6 @@ def toListImpl (as : Array α) : List α :=
def toListAppend (as : Array α) (l : List α) : List α :=
as.foldr List.cons l
instance {α : Type u} [Repr α] : Repr (Array α) where
reprPrec a _ :=
let _ : Std.ToFormat α := repr
if a.size == 0 then
"#[]"
else
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList a) ("," ++ Std.Format.line)) "]"
instance [ToString α] : ToString (Array α) where
toString a := "#" ++ toString a.toList
protected def append (as : Array α) (bs : Array α) : Array α :=
bs.foldl (init := as) fun r v => r.push v
@@ -546,44 +620,13 @@ def concatMap (f : α → Array β) (as : Array α) : Array β :=
def flatten (as : Array (Array α)) : Array α :=
as.foldl (init := empty) fun r a => r ++ a
end Array
export Array (mkArray)
syntax "#[" withoutPosition(sepBy(term, ", ")) "]" : term
macro_rules
| `(#[ $elems,* ]) => `(List.toArray [ $elems,* ])
namespace Array
-- TODO(Leo): cleanup
@[specialize]
def isEqvAux (a b : Array α) (hsz : a.size = b.size) (p : α α Bool) (i : Nat) : Bool :=
if h : i < a.size then
have : i < b.size := hsz h
p a[i] b[i] && isEqvAux a b hsz p (i+1)
else
true
termination_by a.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[inline] def isEqv (a b : Array α) (p : α α Bool) : Bool :=
if h : a.size = b.size then
isEqvAux a b h p 0
else
false
instance [BEq α] : BEq (Array α) :=
fun a b => isEqv a b BEq.beq
@[inline]
def filter (p : α Bool) (as : Array α) (start := 0) (stop := as.size) : Array α :=
as.foldl (init := #[]) (start := start) (stop := stop) fun r a =>
if p a then r.push a else r
@[inline]
def filterM [Monad m] (p : α m Bool) (as : Array α) (start := 0) (stop := as.size) : m (Array α) :=
def filterM {α : Type} [Monad m] (p : α m Bool) (as : Array α) (start := 0) (stop := as.size) : m (Array α) :=
as.foldlM (init := #[]) (start := start) (stop := stop) fun r a => do
if ( p a) then return r.push a else return r
@@ -618,93 +661,25 @@ def partition (p : α → Bool) (as : Array α) : Array α × Array α := Id.run
cs := cs.push a
return (bs, cs)
theorem ext (a b : Array α)
(h₁ : a.size = b.size)
(h₂ : (i : Nat) (hi₁ : i < a.size) (hi₂ : i < b.size) a[i] = b[i])
: a = b := by
let rec extAux (a b : List α)
(h₁ : a.length = b.length)
(h₂ : (i : Nat) (hi₁ : i < a.length) (hi₂ : i < b.length) a.get i, hi₁ = b.get i, hi₂)
: a = b := by
induction a generalizing b with
| nil =>
cases b with
| nil => rfl
| cons b bs => rw [List.length_cons] at h₁; injection h₁
| cons a as ih =>
cases b with
| nil => rw [List.length_cons] at h₁; injection h₁
| cons b bs =>
have hz₁ : 0 < (a::as).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
have hz₂ : 0 < (b::bs).length := by rw [List.length_cons]; apply Nat.zero_lt_succ
have headEq : a = b := h₂ 0 hz₁ hz₂
have h₁' : as.length = bs.length := by rw [List.length_cons, List.length_cons] at h₁; injection h₁
have h₂' : (i : Nat) (hi₁ : i < as.length) (hi₂ : i < bs.length) as.get i, hi₁ = bs.get i, hi₂ := by
intro i hi₁ hi₂
have hi₁' : i+1 < (a::as).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
have hi₂' : i+1 < (b::bs).length := by rw [List.length_cons]; apply Nat.succ_lt_succ; assumption
have : (a::as).get i+1, hi₁' = (b::bs).get i+1, hi₂' := h₂ (i+1) hi₁' hi₂'
apply this
have tailEq : as = bs := ih bs h₁' h₂'
rw [headEq, tailEq]
cases a; cases b
apply congrArg
apply extAux
assumption
assumption
theorem extLit {n : Nat}
(a b : Array α)
(hsz₁ : a.size = n) (hsz₂ : b.size = n)
(h : (i : Nat) (hi : i < n) a.getLit i hsz₁ hi = b.getLit i hsz₂ hi) : a = b :=
Array.ext a b (hsz₁.trans hsz₂.symm) fun i hi₁ _ => h i (hsz₁ hi₁)
end Array
-- CLEANUP the following code
namespace Array
def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
if h : i < a.size then
let idx : Fin a.size := i, h;
if a.get idx == v then some idx
else indexOfAux a v (i+1)
else none
termination_by a.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
indexOfAux a v 0
@[simp] theorem size_swap (a : Array α) (i j : Fin a.size) : (a.swap i j).size = a.size := by
show ((a.set i (a.get j)).set (size_set a i _ j) (a.get i)).size = a.size
rw [size_set, size_set]
@[simp] theorem size_pop (a : Array α) : a.pop.size = a.size - 1 := by
match a with
| [] => rfl
| a::as => simp [pop, Nat.succ_sub_succ_eq_sub, size]
theorem reverse.termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
rw [Nat.sub_sub, Nat.add_comm]
exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
def reverse (as : Array α) : Array α :=
if h : as.size 1 then
as
else
loop as 0 as.size - 1, Nat.pred_lt (mt (fun h : as.size = 0 => h by decide) h)
where
termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
rw [Nat.sub_sub, Nat.add_comm]
exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
loop (as : Array α) (i : Nat) (j : Fin as.size) :=
if h : i < j then
have := reverse.termination h
have := termination h
let as := as.swap i, Nat.lt_trans h j.2 j
have : j-1 < as.size := by rw [size_swap]; exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
loop as (i+1) j-1, this
else
as
termination_by j - i
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def popWhile (p : α Bool) (as : Array α) : Array α :=
if h : as.size > 0 then
if p (as.get as.size - 1, Nat.sub_lt h (by decide)) then
@@ -713,11 +688,11 @@ def popWhile (p : α → Bool) (as : Array α) : Array α :=
as
else
as
termination_by as.size
decreasing_by simp_wf; decreasing_trivial_pre_omega
def takeWhile (p : α Bool) (as : Array α) : Array α :=
let rec go (i : Nat) (r : Array α) : Array α :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
go (i : Nat) (r : Array α) : Array α :=
if h : i < as.size then
let a := as.get i, h
if p a then
@@ -726,7 +701,6 @@ def takeWhile (p : α → Bool) (as : Array α) : Array α :=
r
else
r
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
go 0 #[]
@@ -734,6 +708,7 @@ def takeWhile (p : α → Bool) (as : Array α) : Array α :=
This function takes worst case O(n) time because
it has to backshift all elements at positions greater than `i`.-/
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
if h : i.val + 1 < a.size then
let a' := a.swap i.val + 1, h i
@@ -744,6 +719,7 @@ def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
termination_by a.size - i.val
decreasing_by simp_wf; exact Nat.sub_succ_lt_self _ _ i.isLt
-- This is required in `Lean.Data.PersistentHashMap`.
theorem size_feraseIdx (a : Array α) (i : Fin a.size) : (a.feraseIdx i).size = a.size - 1 := by
induction a, i using Array.feraseIdx.induct with
| @case1 a i h a' _ ih =>
@@ -767,14 +743,14 @@ def erase [BEq α] (as : Array α) (a : α) : Array α :=
/-- Insert element `a` at position `i`. -/
@[inline] def insertAt (as : Array α) (i : Fin (as.size + 1)) (a : α) : Array α :=
let rec loop (as : Array α) (j : Fin as.size) :=
let rec @[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
loop (as : Array α) (j : Fin as.size) :=
if i.1 < j then
let j' := j-1, Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
let as := as.swap j' j
loop as j', by rw [size_swap]; exact j'.2
else
as
termination_by j.1
decreasing_by simp_wf; decreasing_trivial_pre_omega
let j := as.size
let as := as.push a
@@ -786,41 +762,7 @@ def insertAt! (as : Array α) (i : Nat) (a : α) : Array α :=
insertAt as i, Nat.lt_succ_of_le h a
else panic! "invalid index"
def toListLitAux (a : Array α) (n : Nat) (hsz : a.size = n) : (i : Nat), i a.size List α List α
| 0, _, acc => acc
| (i+1), hi, acc => toListLitAux a n hsz i (Nat.le_of_succ_le hi) (a.getLit i hsz (Nat.lt_of_lt_of_eq (Nat.lt_of_lt_of_le (Nat.lt_succ_self i) hi) hsz) :: acc)
def toArrayLit (a : Array α) (n : Nat) (hsz : a.size = n) : Array α :=
List.toArray <| toListLitAux a n hsz n (hsz Nat.le_refl _) []
theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
cases as; cases bs; simp at h; rw [h]
@[simp] theorem toArrayAux_eq (as : List α) (acc : Array α) : (as.toArrayAux acc).toList = acc.toList ++ as := by
induction as generalizing acc <;> simp [*, List.toArrayAux, Array.push, List.append_assoc, List.concat_eq_append]
@[simp] theorem toList_toArray (as : List α) : as.toArray.toList = as := by
simp [List.toArray, Array.mkEmpty]
@[deprecated toList_toArray (since := "2024-09-09")] abbrev data_toArray := @toList_toArray
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
theorem toArrayLit_eq (as : Array α) (n : Nat) (hsz : as.size = n) : as = toArrayLit as n hsz := by
apply ext'
simp [toArrayLit, toList_toArray]
have hle : n as.size := hsz Nat.le_refl _
have hge : as.size n := hsz Nat.le_refl _
have := go n hle
rw [List.drop_eq_nil_of_le hge] at this
rw [this]
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, *]
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size bs.size) (i : Nat) : Bool :=
if h : i < as.size then
let a := as[i]
@@ -832,7 +774,6 @@ def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size ≤ bs.size) (i : N
false
else
true
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
/-- Return true iff `as` is a prefix of `bs`.
@@ -843,24 +784,8 @@ def isPrefixOf [BEq α] (as bs : Array α) : Bool :=
else
false
private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat), i < as.size Bool
| 0, _ => true
| i+1, h =>
have : i < as.size := Nat.lt_trans (Nat.lt_succ_self _) h;
a != as[i] && allDiffAuxAux as a i this
private def allDiffAux [BEq α] (as : Array α) (i : Nat) : Bool :=
if h : i < as.size then
allDiffAuxAux as as[i] i h && allDiffAux as (i+1)
else
true
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
def allDiff [BEq α] (as : Array α) : Bool :=
allDiffAux as 0
@[specialize] def zipWithAux (f : α β γ) (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) : Array γ :=
@[semireducible, specialize] -- This is otherwise irreducible because it uses well-founded recursion.
def zipWithAux (f : α β γ) (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) : Array γ :=
if h : i < as.size then
let a := as[i]
if h : i < bs.size then
@@ -870,7 +795,6 @@ def allDiff [BEq α] (as : Array α) : Bool :=
cs
else
cs
termination_by as.size - i
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[inline] def zipWith (as : Array α) (bs : Array β) (f : α β γ) : Array γ :=
@@ -886,4 +810,48 @@ def split (as : Array α) (p : α → Bool) : Array α × Array α :=
as.foldl (init := (#[], #[])) fun (as, bs) a =>
if p a then (as.push a, bs) else (as, bs.push a)
/-! ### Auxiliary functions used in metaprogramming.
We do not intend to provide verification theorems for these functions.
-/
private def allDiffAuxAux [BEq α] (as : Array α) (a : α) : forall (i : Nat), i < as.size Bool
| 0, _ => true
| i+1, h =>
have : i < as.size := Nat.lt_trans (Nat.lt_succ_self _) h;
a != as[i] && allDiffAuxAux as a i this
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
private def allDiffAux [BEq α] (as : Array α) (i : Nat) : Bool :=
if h : i < as.size then
allDiffAuxAux as as[i] i h && allDiffAux as (i+1)
else
true
decreasing_by simp_wf; decreasing_trivial_pre_omega
def allDiff [BEq α] (as : Array α) : Bool :=
allDiffAux as 0
@[inline] def getEvenElems (as : Array α) : Array α :=
(·.2) <| as.foldl (init := (true, Array.empty)) fun (even, r) a =>
if even then
(false, r.push a)
else
(true, r)
/-! ### Repr and ToString -/
instance {α : Type u} [Repr α] : Repr (Array α) where
reprPrec a _ :=
let _ : Std.ToFormat α := repr
if a.size == 0 then
"#[]"
else
Std.Format.bracketFill "#[" (Std.Format.joinSep (toList a) ("," ++ Std.Format.line)) "]"
instance [ToString α] : ToString (Array α) where
toString a := "#" ++ toString a.toList
end Array
export Array (mkArray)

View File

@@ -34,7 +34,7 @@ private theorem List.of_toArrayAux_eq_toArrayAux {as bs : List α} {cs ds : Arra
@[simp] theorem List.toArray_eq_toArray_eq (as bs : List α) : (as.toArray = bs.toArray) = (as = bs) := by
apply propext; apply Iff.intro
· intro h; simp [toArray] at h; have := of_toArrayAux_eq_toArrayAux h rfl; exact this.1
· intro h; simpa [toArray] using h
· intro h; rw [h]
def Array.mapM' [Monad m] (f : α m β) (as : Array α) : m { bs : Array β // bs.size = as.size } :=

View File

@@ -5,43 +5,49 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Data.BEq
import Init.ByCases
namespace Array
theorem eq_of_isEqvAux [DecidableEq α] (a b : Array α) (hsz : a.size = b.size) (i : Nat) (hi : i a.size) (heqv : Array.isEqvAux a b hsz (fun x y => x = y) i) (j : Nat) (low : i j) (high : j < a.size) : a[j] = b[j]'(hsz high) := by
by_cases h : i < a.size
· unfold Array.isEqvAux at heqv
simp [h] at heqv
have hind := eq_of_isEqvAux a b hsz (i+1) (Nat.succ_le_of_lt h) heqv.2
by_cases heq : i = j
· subst heq; exact heqv.1
· exact hind j (Nat.succ_le_of_lt (Nat.lt_of_le_of_ne low heq)) high
· have heq : i = a.size := Nat.le_antisymm hi (Nat.ge_of_not_lt h)
subst heq
exact absurd (Nat.lt_of_lt_of_le high low) (Nat.lt_irrefl j)
termination_by a.size - i
decreasing_by decreasing_trivial_pre_omega
theorem rel_of_isEqvAux
(r : α α Bool) (a b : Array α) (hsz : a.size = b.size) (i : Nat) (hi : i a.size)
(heqv : Array.isEqvAux a b hsz r i hi)
(j : Nat) (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))) := by
induction i with
| zero => contradiction
| succ i ih =>
simp only [Array.isEqvAux, Bool.and_eq_true, decide_eq_true_eq] at heqv
by_cases hj' : j < i
next =>
exact ih _ heqv.right hj'
next =>
replace hj' : j = i := Nat.eq_of_le_of_lt_succ (Nat.not_lt.mp hj') hj
subst hj'
exact heqv.left
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]
split <;> rename_i h
· exact fun h' => h, rel_of_isEqvAux r a b h a.size (Nat.le_refl ..) h'
· intro; contradiction
theorem eq_of_isEqv [DecidableEq α] (a b : Array α) : Array.isEqv a b (fun x y => x = y) a = b := by
simp [Array.isEqv]
split
next hsz =>
intro h
have aux := eq_of_isEqvAux a b hsz 0 (Nat.zero_le ..) h
exact ext a b hsz fun i h _ => aux i (Nat.zero_le ..) _
next => intro; contradiction
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)
theorem isEqvAux_self [DecidableEq α] (a : Array α) (i : Nat) : Array.isEqvAux a a rfl (fun x y => x = y) i = true := by
unfold Array.isEqvAux
split
next h => simp [h, isEqvAux_self a (i+1)]
next h => simp [h]
termination_by a.size - i
decreasing_by decreasing_trivial_pre_omega
theorem isEqvAux_self (r : α α Bool) (hr : a, r a a) (a : Array α) (i : Nat) (h : i a.size) :
Array.isEqvAux a a rfl r i h = true := by
induction i with
| zero => simp [Array.isEqvAux]
| succ i ih =>
simp_all only [isEqvAux, Bool.and_self]
theorem isEqv_self [DecidableEq α] (a : Array α) : Array.isEqv a a (fun x y => x = y) = true := by
theorem isEqv_self_beq [BEq α] [ReflBEq α] (a : Array α) : Array.isEqv a a (· == ·) = true := by
simp [isEqv, isEqvAux_self]
theorem isEqv_self [DecidableEq α] (a : Array α) : Array.isEqv a a (· = ·) = true := by
simp [isEqv, isEqvAux_self]
instance [DecidableEq α] : DecidableEq (Array α) :=

View File

@@ -0,0 +1,46 @@
/-
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
namespace Array
/-! ### getLit -/
-- auxiliary declaration used in the equation compiler when pattern matching array literals.
abbrev getLit {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size = n) (h₂ : i < n) : α :=
have := h₁.symm h₂
a[i]
theorem extLit {n : Nat}
(a b : Array α)
(hsz₁ : a.size = n) (hsz₂ : b.size = n)
(h : (i : Nat) (hi : i < n) a.getLit i hsz₁ hi = b.getLit i hsz₂ hi) : a = b :=
Array.ext a b (hsz₁.trans hsz₂.symm) fun i hi₁ _ => h i (hsz₁ hi₁)
def toListLitAux (a : Array α) (n : Nat) (hsz : a.size = n) : (i : Nat), i a.size List α List α
| 0, _, acc => acc
| (i+1), hi, acc => toListLitAux a n hsz i (Nat.le_of_succ_le hi) (a.getLit i hsz (Nat.lt_of_lt_of_eq (Nat.lt_of_lt_of_le (Nat.lt_succ_self i) hi) hsz) :: acc)
def toArrayLit (a : Array α) (n : Nat) (hsz : a.size = n) : Array α :=
List.toArray <| toListLitAux a n hsz n (hsz Nat.le_refl _) []
theorem toArrayLit_eq (as : Array α) (n : Nat) (hsz : as.size = n) : as = toArrayLit as n hsz := by
apply ext'
simp [toArrayLit, toList_toArray]
have hle : n as.size := hsz Nat.le_refl _
have hge : as.size n := hsz Nat.le_refl _
have := go n hle
rw [List.drop_eq_nil_of_le hge] at this
rw [this]
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, *]
end Array

View File

@@ -19,24 +19,9 @@ This file contains some theorems about `Array` and `List` needed for `Init.Data.
namespace Array
attribute [simp] data_toArray uset
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
@[simp] theorem toArray_toList : (a : Array α) a.toList.toArray = a
| l => ext' (toList_toArray l)
@[deprecated toArray_toList (since := "2024-09-09")]
abbrev toArray_data := @toArray_toList
@[simp] theorem toList_length {l : Array α} : l.toList.length = l.size := rfl
@[deprecated toList_length (since := "2024-09-09")]
abbrev data_length := @toList_length
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl
theorem getElem_eq_toList_getElem (a : Array α) (h : i < a.size) : a[i] = a.toList[i] := by
by_cases i < a.size <;> (try simp [*]) <;> rfl
@@ -46,27 +31,7 @@ abbrev getElem_eq_data_getElem := @getElem_eq_toList_getElem
@[deprecated getElem_eq_toList_getElem (since := "2024-06-12")]
theorem getElem_eq_toList_get (a : Array α) (h : i < a.size) : a[i] = a.toList.get i, h := by
simp [getElem_eq_toList_getElem]
theorem foldrM_push [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
simp [foldrM_eq_reverse_foldlM_toList, -size_push]
@[simp] theorem foldrM_push' [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init (start := arr.size + 1) = f a init >>= arr.foldrM f := by
simp [ foldrM_push]
theorem foldr_push (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
@[simp] theorem foldr_push' (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init (start := arr.size + 1) = arr.foldr f (f a init) := foldrM_push' ..
/-- A more efficient version of `arr.toList.reverse`. -/
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
rw [toListRev, foldl_eq_foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
simp
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
@@ -84,6 +49,75 @@ theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
· simp at h
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
end Array
namespace List
open Array
/-! ### Lemmas about `List.toArray`. -/
@[simp] theorem size_toArrayAux {a : List α} {b : Array α} :
(a.toArrayAux b).size = b.size + a.length := by
simp [size]
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[deprecated toArray_toList (since := "2024-09-09")]
abbrev toArray_data := @toArray_toList
@[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 toArray_concat {as : List α} {x : α} :
(as ++ [x]).toArray = as.toArray.push x := by
apply ext'
simp
end List
namespace Array
attribute [simp] uset
@[simp] theorem singleton_def (v : α) : singleton v = #[v] := rfl
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[deprecated toArray_toList (since := "2024-09-09")]
abbrev toArray_data := @toArray_toList
@[simp] theorem toList_length {l : Array α} : l.toList.length = l.size := rfl
@[deprecated toList_length (since := "2024-09-09")]
abbrev data_length := @toList_length
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
theorem foldrM_push [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
simp [foldrM_eq_reverse_foldlM_toList, -size_push]
/-- Variant of `foldrM_push` with the `start := arr.size + 1` rather than `(arr.push a).size`. -/
@[simp] theorem foldrM_push' [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init (start := arr.size + 1) = f a init >>= arr.foldrM f := by
simp [ foldrM_push]
theorem foldr_push (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
/-- Variant of `foldr_push` with the `start := arr.size + 1` rather than `(arr.push a).size`. -/
@[simp] theorem foldr_push' (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init (start := arr.size + 1) = arr.foldr f (f a init) := foldrM_push' ..
/-- A more efficient version of `arr.toList.reverse`. -/
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
rw [toListRev, foldl_eq_foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
rw [mapM, aux, foldlM_eq_foldlM_toList]; rfl
@@ -271,6 +305,9 @@ termination_by n - i
/-- # mkArray -/
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
List.length_replicate ..
@[simp] theorem toList_mkArray (n : Nat) (v : α) : (mkArray n v).toList = List.replicate n v := rfl
@[deprecated toList_mkArray (since := "2024-09-09")]
@@ -342,7 +379,7 @@ theorem getElem_mem_toList (a : Array α) (h : i < a.size) : a[i] ∈ a.toList :
abbrev getElem_mem_data := @getElem_mem_toList
theorem getElem?_eq_toList_get? (a : Array α) (i : Nat) : a[i]? = a.toList.get? i := by
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]; rfl
by_cases i < a.size <;> simp_all [getElem?_pos, getElem?_neg, List.get?_eq_get, eq_comm]
@[deprecated getElem?_eq_toList_get? (since := "2024-09-09")]
abbrev getElem?_eq_data_get? := @getElem?_eq_toList_get?
@@ -495,7 +532,6 @@ abbrev size_eq_length_data := @size_eq_length_toList
let rec go (as : Array α) (i j) : (reverse.loop as i j).size = as.size := by
rw [reverse.loop]
if h : i < j then
have := reverse.termination h
simp [(go · (i+1) j-1, ·), h]
else simp [h]
termination_by j - i
@@ -527,9 +563,8 @@ set_option linter.deprecated false in
(H : k, as.toList.get? k = if i k k j then a.toList.get? k else a.toList.reverse.get? k)
(k) : (reverse.loop as i j, hj).toList.get? k = a.toList.reverse.get? k := by
rw [reverse.loop]; dsimp; split <;> rename_i h₁
· have p := reverse.termination h₁
match j with | j+1 => ?_
simp only [Nat.add_sub_cancel] at p
· match j with | j+1 => ?_
simp only [Nat.add_sub_cancel]
rw [(go · (i+1) j)]
· rwa [Nat.add_right_comm i]
· simp [size_swap, h₂]
@@ -608,8 +643,8 @@ theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α → m β) (arr : A
rw [mapM_eq_foldlM, foldlM_eq_foldlM_toList, List.foldrM_reverse]
conv => rhs; rw [ List.reverse_reverse arr.toList]
induction arr.toList.reverse with
| nil => simp; rfl
| cons a l ih => simp [ih]; simp [map_eq_pure_bind, push]
| nil => simp
| cons a l ih => simp [ih]; simp [map_eq_pure_bind]
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
@@ -828,7 +863,7 @@ theorem get_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.
(as ++ bs)[i] = bs[i - as.size] := by
simp only [getElem_eq_toList_getElem]
have h' : i < (as.toList ++ bs.toList).length := by rwa [ toList_length, append_toList] at h
conv => rhs; rw [ List.getElem_append_right (h' := h') (h := Nat.not_lt_of_ge hle)]
conv => rhs; rw [ List.getElem_append_right (h := hle) (h := h')]
apply List.get_of_eq; rw [append_toList]
@[simp] theorem append_nil (as : Array α) : as ++ #[] = as := by
@@ -1113,5 +1148,4 @@ theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i :=
· split <;> simp_all
· split <;> simp_all
end Array

View File

@@ -12,6 +12,7 @@ namespace Array
theorem exists_of_uset (self : Array α) (i d h) :
l₁ l₂, self.toList = l₁ ++ self[i] :: l₂ List.length l₁ = i.toNat
(self.uset i d h).toList = l₁ ++ d :: l₂ := by
simpa [Array.getElem_eq_toList_getElem] using List.exists_of_set _
simpa only [ugetElem_eq_getElem, getElem_eq_toList_getElem, uset, toList_set] using
List.exists_of_set _
end Array

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Data.BitVec.Basic

View File

@@ -64,7 +64,7 @@ protected def ofNatLt {n : Nat} (i : Nat) (p : i < 2^n) : BitVec n where
/-- The `BitVec` with value `i mod 2^n`. -/
@[match_pattern]
protected def ofNat (n : Nat) (i : Nat) : BitVec n where
toFin := Fin.ofNat' i (Nat.two_pow_pos n)
toFin := Fin.ofNat' (2^n) i
instance instOfNat : OfNat (BitVec n) i where ofNat := .ofNat n i
instance natCastInst : NatCast (BitVec w) := BitVec.ofNat w
@@ -173,6 +173,9 @@ instance : GetElem (BitVec w) Nat Bool fun _ i => i < w where
theorem getElem_eq_testBit_toNat (x : BitVec w) (i : Nat) (h : i < w) :
x[i] = x.toNat.testBit i := rfl
theorem getLsbD_eq_getElem {x : BitVec w} {i : Nat} (h : i < w) :
x.getLsbD i = x[i] := rfl
end getElem
section Int
@@ -450,13 +453,15 @@ SMT-Lib name: `extract`.
def extractLsb (hi lo : Nat) (x : BitVec n) : BitVec (hi - lo + 1) := extractLsb' lo _ x
/--
A version of `zeroExtend` that requires a proof, but is a noop.
A version of `setWidth` that requires a proof, but is a noop.
-/
def zeroExtend' {n w : Nat} (le : n w) (x : BitVec n) : BitVec w :=
def setWidth' {n w : Nat} (le : n w) (x : BitVec n) : BitVec w :=
x.toNat#'(by
apply Nat.lt_of_lt_of_le x.isLt
exact Nat.pow_le_pow_of_le_right (by trivial) le)
@[deprecated setWidth' (since := "2024-09-18"), inherit_doc setWidth'] abbrev zeroExtend' := @setWidth'
/--
`shiftLeftZeroExtend x n` returns `zeroExtend (w+n) x <<< n` without
needing to compute `x % 2^(2+n)`.
@@ -469,22 +474,35 @@ def shiftLeftZeroExtend (msbs : BitVec w) (m : Nat) : BitVec (w + m) :=
(msbs.toNat <<< m)#'(shiftLeftLt msbs.isLt m)
/--
Zero extend vector `x` of length `w` by adding zeros in the high bits until it has length `v`.
If `v < w` then it truncates the high bits instead.
Transform `x` of length `w` into a bitvector of length `v`, by either:
- zero extending, that is, adding zeros in the high bits until it has length `v`, if `v > w`, or
- truncating the high bits, if `v < w`.
SMT-Lib name: `zero_extend`.
-/
def zeroExtend (v : Nat) (x : BitVec w) : BitVec v :=
def setWidth (v : Nat) (x : BitVec w) : BitVec v :=
if h : w v then
zeroExtend' h x
setWidth' h x
else
.ofNat v x.toNat
/--
Truncate the high bits of bitvector `x` of length `w`, resulting in a vector of length `v`.
If `v > w` then it zero-extends the vector instead.
Transform `x` of length `w` into a bitvector of length `v`, by either:
- zero extending, that is, adding zeros in the high bits until it has length `v`, if `v > w`, or
- truncating the high bits, if `v < w`.
SMT-Lib name: `zero_extend`.
-/
abbrev truncate := @zeroExtend
abbrev zeroExtend := @setWidth
/--
Transform `x` of length `w` into a bitvector of length `v`, by either:
- zero extending, that is, adding zeros in the high bits until it has length `v`, if `v > w`, or
- truncating the high bits, if `v < w`.
SMT-Lib name: `zero_extend`.
-/
abbrev truncate := @setWidth
/--
Sign extend a vector of length `w`, extending with `i` additional copies of the most significant
@@ -635,7 +653,7 @@ input is on the left, so `0xAB#8 ++ 0xCD#8 = 0xABCD#16`.
SMT-Lib name: `concat`.
-/
def append (msbs : BitVec n) (lsbs : BitVec m) : BitVec (n+m) :=
shiftLeftZeroExtend msbs m ||| zeroExtend' (Nat.le_add_left m n) lsbs
shiftLeftZeroExtend msbs m ||| setWidth' (Nat.le_add_left m n) lsbs
instance : HAppend (BitVec w) (BitVec v) (BitVec (w + v)) := .append

View File

@@ -132,18 +132,18 @@ theorem toNat_add_of_and_eq_zero {x y : BitVec w} (h : x &&& y = 0#w) :
simp [not_eq_true, carry_of_and_eq_zero h]
/-- Carry function for bitwise addition. -/
def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, Bool.xor x (Bool.xor y c))
def adcb (x y c : Bool) : Bool × Bool := (atLeastTwo x y c, x ^^ (y ^^ c))
/-- Bitwise addition implemented via a ripple carry adder. -/
def adc (x y : BitVec w) : Bool Bool × BitVec w :=
iunfoldr fun (i : Fin w) c => adcb (x.getLsbD i) (y.getLsbD i) c
theorem getLsbD_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool) :
getLsbD (x + y + zeroExtend w (ofBool c)) i =
Bool.xor (getLsbD x i) (Bool.xor (getLsbD y i) (carry i x y c)) := by
getLsbD (x + y + setWidth w (ofBool c)) i =
(getLsbD x i ^^ (getLsbD y i ^^ carry i x y c)) := by
let x, x_lt := x
let y, y_lt := y
simp only [getLsbD, toNat_add, toNat_zeroExtend, i_lt, toNat_ofFin, toNat_ofBool,
simp only [getLsbD, toNat_add, toNat_setWidth, i_lt, toNat_ofFin, toNat_ofBool,
Nat.mod_add_mod, Nat.add_mod_mod]
apply Eq.trans
rw [ Nat.div_add_mod x (2^i), Nat.div_add_mod y (2^i)]
@@ -161,15 +161,15 @@ theorem getLsbD_add_add_bool {i : Nat} (i_lt : i < w) (x y : BitVec w) (c : Bool
theorem getLsbD_add {i : Nat} (i_lt : i < w) (x y : BitVec w) :
getLsbD (x + y) i =
Bool.xor (getLsbD x i) (Bool.xor (getLsbD y i) (carry i x y false)) := by
(getLsbD x i ^^ (getLsbD y i ^^ carry i x y false)) := by
simpa using getLsbD_add_add_bool i_lt x y false
theorem adc_spec (x y : BitVec w) (c : Bool) :
adc x y c = (carry w x y c, x + y + zeroExtend w (ofBool c)) := by
adc x y c = (carry w x y c, x + y + setWidth w (ofBool c)) := by
simp only [adc]
apply iunfoldr_replace
(fun i => carry i x y c)
(x + y + zeroExtend w (ofBool c))
(x + y + setWidth w (ofBool c))
c
case init =>
simp [carry, Nat.mod_one]
@@ -306,12 +306,12 @@ theorem mulRec_succ_eq (x y : BitVec w) (s : Nat) :
Recurrence lemma: truncating to `i+1` bits and then zero extending to `w`
equals truncating upto `i` bits `[0..i-1]`, and then adding the `i`th bit of `x`.
-/
theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow (x : BitVec w) (i : Nat) :
zeroExtend w (x.truncate (i + 1)) =
zeroExtend w (x.truncate i) + (x &&& twoPow w i) := by
theorem setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow (x : BitVec w) (i : Nat) :
setWidth w (x.setWidth (i + 1)) =
setWidth w (x.setWidth i) + (x &&& twoPow w i) := by
rw [add_eq_or_of_and_eq_zero]
· ext k
simp only [getLsbD_zeroExtend, Fin.is_lt, decide_True, Bool.true_and, getLsbD_or, getLsbD_and]
simp only [getLsbD_setWidth, Fin.is_lt, decide_True, Bool.true_and, getLsbD_or, getLsbD_and]
by_cases hik : i = k
· subst hik
simp
@@ -322,27 +322,32 @@ theorem zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow (x : BitVec w
· have hik'' : ¬ (k < i) := by omega
simp [hik', hik'']
· ext k
simp only [and_twoPow, getLsbD_and, getLsbD_zeroExtend, Fin.is_lt, decide_True, Bool.true_and,
simp only [and_twoPow, getLsbD_and, getLsbD_setWidth, Fin.is_lt, decide_True, Bool.true_and,
getLsbD_zero, and_eq_false_imp, and_eq_true, decide_eq_true_eq, and_imp]
by_cases hi : x.getLsbD i <;> simp [hi] <;> omega
@[deprecated setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow (since := "2024-09-18"),
inherit_doc setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow]
abbrev zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow :=
@setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow
/--
Recurrence lemma: multiplying `x` with the first `s` bits of `y` is the
same as truncating `y` to `s` bits, then zero extending to the original length,
and performing the multplication. -/
theorem mulRec_eq_mul_signExtend_truncate (x y : BitVec w) (s : Nat) :
mulRec x y s = x * ((y.truncate (s + 1)).zeroExtend w) := by
theorem mulRec_eq_mul_signExtend_setWidth (x y : BitVec w) (s : Nat) :
mulRec x y s = x * ((y.setWidth (s + 1)).setWidth w) := by
induction s
case zero =>
simp only [mulRec_zero_eq, ofNat_eq_ofNat, Nat.reduceAdd]
by_cases y.getLsbD 0
case pos hy =>
simp only [hy, reduceIte, truncate, zeroExtend_one_eq_ofBool_getLsb_zero,
simp only [hy, reduceIte, setWidth_one_eq_ofBool_getLsb_zero,
ofBool_true, ofNat_eq_ofNat]
rw [zeroExtend_ofNat_one_eq_ofNat_one_of_lt (by omega)]
rw [setWidth_ofNat_one_eq_ofNat_one_of_lt (by omega)]
simp
case neg hy =>
simp [hy, zeroExtend_one_eq_ofBool_getLsb_zero]
simp [hy, setWidth_one_eq_ofBool_getLsb_zero]
case succ s' hs =>
rw [mulRec_succ_eq, hs]
have heq :
@@ -350,13 +355,16 @@ theorem mulRec_eq_mul_signExtend_truncate (x y : BitVec w) (s : Nat) :
(x * (y &&& (BitVec.twoPow w (s' + 1)))) := by
simp only [ofNat_eq_ofNat, and_twoPow]
by_cases hy : y.getLsbD (s' + 1) <;> simp [hy]
rw [heq, BitVec.mul_add, zeroExtend_truncate_succ_eq_zeroExtend_truncate_add_twoPow]
rw [heq, BitVec.mul_add, setWidth_setWidth_succ_eq_setWidth_setWidth_add_twoPow]
@[deprecated mulRec_eq_mul_signExtend_setWidth (since := "2024-09-18"),
inherit_doc mulRec_eq_mul_signExtend_setWidth]
abbrev mulRec_eq_mul_signExtend_truncate := @mulRec_eq_mul_signExtend_setWidth
theorem getLsbD_mul (x y : BitVec w) (i : Nat) :
(x * y).getLsbD i = (mulRec x y w).getLsbD i := by
simp only [mulRec_eq_mul_signExtend_truncate]
rw [truncate, truncate_eq_zeroExtend, truncate_eq_zeroExtend,
truncate_truncate_of_le]
simp only [mulRec_eq_mul_signExtend_setWidth]
rw [setWidth_setWidth_of_le]
· simp
· omega
@@ -402,22 +410,22 @@ theorem shiftLeft_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
`shiftLeftRec x y n` shifts `x` to the left by the first `n` bits of `y`.
-/
theorem shiftLeftRec_eq {x : BitVec w₁} {y : BitVec w₂} {n : Nat} :
shiftLeftRec x y n = x <<< (y.truncate (n + 1)).zeroExtend w₂ := by
shiftLeftRec x y n = x <<< (y.setWidth (n + 1)).setWidth w₂ := by
induction n generalizing x y
case zero =>
ext i
simp only [shiftLeftRec_zero, twoPow_zero, Nat.reduceAdd, truncate_one,
and_one_eq_zeroExtend_ofBool_getLsbD]
simp only [shiftLeftRec_zero, twoPow_zero, Nat.reduceAdd, setWidth_one,
and_one_eq_setWidth_ofBool_getLsbD]
case succ n ih =>
simp only [shiftLeftRec_succ, and_twoPow]
rw [ih]
by_cases h : y.getLsbD (n + 1)
· simp only [h, reduceIte]
rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
shiftLeft_or_of_and_eq_zero]
simp [and_twoPow]
· simp only [h, false_eq_true, reduceIte, shiftLeft_zero']
rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false (i := n + 1)]
rw [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false (i := n + 1)]
simp [h]
/--
@@ -466,18 +474,18 @@ theorem sshiftRight'_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
toNat_add_of_and_eq_zero h, sshiftRight_add]
theorem sshiftRightRec_eq (x : BitVec w₁) (y : BitVec w₂) (n : Nat) :
sshiftRightRec x y n = x.sshiftRight' ((y.truncate (n + 1)).zeroExtend w₂) := by
sshiftRightRec x y n = x.sshiftRight' ((y.setWidth (n + 1)).setWidth w₂) := by
induction n generalizing x y
case zero =>
ext i
simp [twoPow_zero, Nat.reduceAdd, and_one_eq_zeroExtend_ofBool_getLsbD, truncate_one]
simp [twoPow_zero, Nat.reduceAdd, and_one_eq_setWidth_ofBool_getLsbD, setWidth_one]
case succ n ih =>
simp only [sshiftRightRec_succ_eq, and_twoPow, ih]
by_cases h : y.getLsbD (n + 1)
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
sshiftRight'_or_of_and_eq_zero (by simp [and_twoPow]), h]
simp
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false (i := n + 1)
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false (i := n + 1)
(by simp [h])]
simp [h]
@@ -529,20 +537,20 @@ theorem ushiftRight'_or_of_and_eq_zero {x : BitVec w₁} {y z : BitVec w₂}
simp [ add_eq_or_of_and_eq_zero _ _ h, toNat_add_of_and_eq_zero h, shiftRight_add]
theorem ushiftRightRec_eq (x : BitVec w₁) (y : BitVec w₂) (n : Nat) :
ushiftRightRec x y n = x >>> (y.truncate (n + 1)).zeroExtend w₂ := by
ushiftRightRec x y n = x >>> (y.setWidth (n + 1)).setWidth w₂ := by
induction n generalizing x y
case zero =>
ext i
simp only [ushiftRightRec_zero, twoPow_zero, Nat.reduceAdd,
and_one_eq_zeroExtend_ofBool_getLsbD, truncate_one]
and_one_eq_setWidth_ofBool_getLsbD, setWidth_one]
case succ n ih =>
simp only [ushiftRightRec_succ, and_twoPow]
rw [ih]
by_cases h : y.getLsbD (n + 1) <;> simp only [h, reduceIte]
· rw [zeroExtend_truncate_succ_eq_zeroExtend_truncate_or_twoPow_of_getLsbD_true h,
· rw [setWidth_setWidth_succ_eq_setWidth_setWidth_or_twoPow_of_getLsbD_true h,
ushiftRight'_or_of_and_eq_zero]
simp [and_twoPow]
· simp [zeroExtend_truncate_succ_eq_zeroExtend_truncate_of_getLsbD_false, h]
· simp [setWidth_setWidth_succ_eq_setWidth_setWidth_of_getLsbD_false, h]
/--
Show that `x >>> y` can be written in terms of `ushiftRightRec`.

View File

@@ -48,7 +48,7 @@ private theorem iunfoldr.eq_test
simp only [init, eq_nil]
case step =>
intro i
simp_all [truncate_succ]
simp_all [setWidth_succ]
theorem iunfoldr_getLsbD' {f : Fin w α α × Bool} (state : Nat α)
(ind : (i : Fin w), (f i (state i.val)).fst = state (i.val+1)) :

File diff suppressed because it is too large Load Diff

View File

@@ -6,16 +6,13 @@ Authors: F. G. Dorais
prelude
import Init.NotationExtra
/-- Boolean exclusive or -/
abbrev xor : Bool Bool Bool := bne
namespace Bool
/- Namespaced versions that can be used instead of prefixing `_root_` -/
@[inherit_doc not] protected abbrev not := not
@[inherit_doc or] protected abbrev or := or
@[inherit_doc and] protected abbrev and := and
@[inherit_doc xor] protected abbrev xor := xor
/-- Boolean exclusive or -/
abbrev xor : Bool Bool Bool := bne
@[inherit_doc] infixl:33 " ^^ " => xor
instance (p : Bool Prop) [inst : DecidablePred p] : Decidable ( x, p x) :=
match inst true, inst false with
@@ -150,8 +147,8 @@ theorem and_or_distrib_right : ∀ (x y z : Bool), ((x || y) && z) = (x && z ||
theorem or_and_distrib_left : (x y z : Bool), (x || y && z) = ((x || y) && (x || z)) := by decide
theorem or_and_distrib_right : (x y z : Bool), (x && y || z) = ((x || z) && (y || z)) := by decide
theorem and_xor_distrib_left : (x y z : Bool), (x && xor y z) = xor (x && y) (x && z) := by decide
theorem and_xor_distrib_right : (x y z : Bool), (xor x y && z) = xor (x && z) (y && z) := by decide
theorem and_xor_distrib_left : (x y z : Bool), (x && (y ^^ z)) = ((x && y) ^^ (x && z)) := by decide
theorem and_xor_distrib_right : (x y z : Bool), ((x ^^ y) && z) = ((x && z) ^^ (y && z)) := by decide
/-- De Morgan's law for boolean and -/
@[simp] theorem not_and : (x y : Bool), (!(x && y)) = (!x || !y) := by decide
@@ -257,15 +254,6 @@ theorem beq_eq_decide_eq [BEq α] [LawfulBEq α] [DecidableEq α] (a b : α) :
theorem eq_not : {a b : Bool}, (a = (!b)) (a b) := by decide
theorem not_eq : {a b : Bool}, ((!a) = b) (a b) := by decide
@[simp] theorem not_eq_not : {a b : Bool}, ¬a = !b a = b := by decide
@[simp] theorem not_not_eq : {a b : Bool}, ¬(!a) = b a = b := by decide
/--
We move `!` from the left hand side of an equality to the right hand side.
This helps confluence, and also helps combining pairs of `!`s.
-/
@[simp] theorem not_eq_eq_eq_not : {a b : Bool}, ((!a) = b) (a = !b) := by decide
@[simp] theorem coe_iff_coe : {a b : Bool}, (a b) a = b := by decide
@[simp] theorem coe_true_iff_false : {a b : Bool}, (a b = false) a = (!b) := by decide
@@ -279,37 +267,37 @@ theorem beq_comm {α} [BEq α] [LawfulBEq α] {a b : α} : (a == b) = (b == a) :
/-! ### xor -/
theorem false_xor : (x : Bool), xor false x = x := false_bne
theorem false_xor : (x : Bool), (false ^^ x) = x := false_bne
theorem xor_false : (x : Bool), xor x false = x := bne_false
theorem xor_false : (x : Bool), (x ^^ false) = x := bne_false
theorem true_xor : (x : Bool), xor true x = !x := true_bne
theorem true_xor : (x : Bool), (true ^^ x) = !x := true_bne
theorem xor_true : (x : Bool), xor x true = !x := bne_true
theorem xor_true : (x : Bool), (x ^^ true) = !x := bne_true
theorem not_xor_self : (x : Bool), xor (!x) x = true := not_bne_self
theorem not_xor_self : (x : Bool), (!x ^^ x) = true := not_bne_self
theorem xor_not_self : (x : Bool), xor x (!x) = true := bne_not_self
theorem xor_not_self : (x : Bool), (x ^^ !x) = true := bne_not_self
theorem not_xor : (x y : Bool), xor (!x) y = !(xor x y) := by decide
theorem not_xor : (x y : Bool), (!x ^^ y) = !(x ^^ y) := by decide
theorem xor_not : (x y : Bool), xor x (!y) = !(xor x y) := by decide
theorem xor_not : (x y : Bool), (x ^^ !y) = !(x ^^ y) := by decide
theorem not_xor_not : (x y : Bool), xor (!x) (!y) = (xor x y) := not_bne_not
theorem not_xor_not : (x y : Bool), (!x ^^ !y) = (x ^^ y) := not_bne_not
theorem xor_self : (x : Bool), xor x x = false := by decide
theorem xor_self : (x : Bool), (x ^^ x) = false := by decide
theorem xor_comm : (x y : Bool), xor x y = xor y x := by decide
theorem xor_comm : (x y : Bool), (x ^^ y) = (y ^^ x) := by decide
theorem xor_left_comm : (x y z : Bool), xor x (xor y z) = xor y (xor x z) := by decide
theorem xor_left_comm : (x y z : Bool), (x ^^ (y ^^ z)) = (y ^^ (x ^^ z)) := by decide
theorem xor_right_comm : (x y z : Bool), xor (xor x y) z = xor (xor x z) y := by decide
theorem xor_right_comm : (x y z : Bool), ((x ^^ y) ^^ z) = ((x ^^ z) ^^ y) := by decide
theorem xor_assoc : (x y z : Bool), xor (xor x y) z = xor x (xor y z) := bne_assoc
theorem xor_assoc : (x y z : Bool), ((x ^^ y) ^^ z) = (x ^^ (y ^^ z)) := bne_assoc
theorem xor_left_inj : {x y z : Bool}, xor x y = xor x z y = z := bne_left_inj
theorem xor_left_inj : {x y z : Bool}, (x ^^ y) = (x ^^ z) y = z := bne_left_inj
theorem xor_right_inj : {x y z : Bool}, xor x z = xor y z x = y := bne_right_inj
theorem xor_right_inj : {x y z : Bool}, (x ^^ z) = (y ^^ z) x = y := bne_right_inj
/-! ### le/lt -/
@@ -597,7 +585,7 @@ theorem decide_beq_decide (p q : Prop) [dpq : Decidable (p ↔ q)] [dp : Decidab
end Bool
export Bool (cond_eq_if)
export Bool (cond_eq_if xor and or not)
/-! ### decide -/

View File

@@ -14,7 +14,7 @@ instance coeToNat : CoeOut (Fin n) Nat :=
fun v => v.val
/--
From the empty type `Fin 0`, any desired result `α` can be derived. This is simlar to `Empty.elim`.
From the empty type `Fin 0`, any desired result `α` can be derived. This is similar to `Empty.elim`.
-/
def elim0.{u} {α : Sort u} : Fin 0 α
| _, h => absurd h (not_lt_zero _)
@@ -31,7 +31,7 @@ This differs from addition, which wraps around:
(2 : Fin 3) + 1 = (0 : Fin 3)
```
-/
def succ : Fin n Fin n.succ
def succ : Fin n Fin (n + 1)
| i, h => i+1, Nat.succ_lt_succ h
variable {n : Nat}
@@ -39,16 +39,20 @@ variable {n : Nat}
/--
Returns `a` modulo `n + 1` as a `Fin n.succ`.
-/
protected def ofNat {n : Nat} (a : Nat) : Fin n.succ :=
protected def ofNat {n : Nat} (a : Nat) : Fin (n + 1) :=
a % (n+1), Nat.mod_lt _ (Nat.zero_lt_succ _)
/--
Returns `a` modulo `n` as a `Fin n`.
The assumption `n > 0` ensures that `Fin n` is nonempty.
The assumption `NeZero n` ensures that `Fin n` is nonempty.
-/
protected def ofNat' {n : Nat} (a : Nat) (h : n > 0) : Fin n :=
a % n, Nat.mod_lt _ h
protected def ofNat' (n : Nat) [NeZero n] (a : Nat) : Fin n :=
a % n, Nat.mod_lt _ (pos_of_neZero n)
-- We intend to deprecate `Fin.ofNat` in favor of `Fin.ofNat'` (and later rename).
-- This is waiting on https://github.com/leanprover/lean4/pull/5323
-- attribute [deprecated Fin.ofNat' (since := "2024-09-16")] Fin.ofNat
private theorem mlt {b : Nat} : {a : Nat} a < n b % n < n
| 0, h => Nat.mod_lt _ h
@@ -141,10 +145,10 @@ instance : ShiftLeft (Fin n) where
instance : ShiftRight (Fin n) where
shiftRight := Fin.shiftRight
instance instOfNat {n : Nat} [NeZero n] {i : Nat} : OfNat (Fin (no_index n)) i where
ofNat := Fin.ofNat' i (pos_of_neZero _)
instance instOfNat {n : Nat} [NeZero n] {i : Nat} : OfNat (Fin n) i where
ofNat := Fin.ofNat' n i
instance : Inhabited (Fin (no_index (n+1))) where
instance instInhabited {n : Nat} [NeZero n] : Inhabited (Fin n) where
default := 0
@[simp] theorem zero_eta : (0, Nat.zero_lt_succ _ : Fin (n + 1)) = 0 := rfl

View File

@@ -26,7 +26,7 @@ def hIterateFrom (P : Nat → Sort _) {n} (f : ∀(i : Fin n), P i.val → P (i.
decreasing_by decreasing_trivial_pre_omega
/--
`hIterate` is a heterogenous iterative operation that applies a
`hIterate` is a heterogeneous iterative operation that applies a
index-dependent function `f` to a value `init : P start` a total of
`stop - start` times to produce a value of type `P stop`.
@@ -35,7 +35,7 @@ Concretely, `hIterate start stop f init` is equal to
init |> f start _ |> f (start+1) _ ... |> f (end-1) _
```
Because it is heterogenous and must return a value of type `P stop`,
Because it is heterogeneous and must return a value of type `P stop`,
`hIterate` requires proof that `start ≤ stop`.
One can prove properties of `hIterate` using the general theorem
@@ -70,7 +70,7 @@ private theorem hIterateFrom_elim {P : Nat → Sort _}(Q : ∀(i : Nat), P i →
/-
`hIterate_elim` provides a mechanism for showing that the result of
`hIterate` satisifies a property `Q stop` by showing that the states
`hIterate` satisfies a property `Q stop` by showing that the states
at the intermediate indices `i : start ≤ i < stop` satisfy `Q i`.
-/
theorem hIterate_elim {P : Nat Sort _} (Q : (i : Nat), P i Prop)

View File

@@ -51,10 +51,15 @@ theorem eq_mk_iff_val_eq {a : Fin n} {k : Nat} {hk : k < n} :
theorem mk_val (i : Fin n) : (i, i.isLt : Fin n) = i := Fin.eta ..
@[simp] theorem val_ofNat' (a : Nat) (is_pos : n > 0) :
(Fin.ofNat' a is_pos).val = a % n := rfl
@[simp] theorem val_ofNat' (n : Nat) [NeZero n] (a : Nat) :
(Fin.ofNat' n a).val = a % n := rfl
@[simp] theorem ofNat'_val_eq_self (x : Fin n) (h) : (Fin.ofNat' x h) = x := by
@[simp] theorem ofNat'_self {n : Nat} [NeZero n] : Fin.ofNat' n n = 0 := by
ext
simp
congr
@[simp] theorem ofNat'_val_eq_self [NeZero n] (x : Fin n) : (Fin.ofNat' n x) = x := by
ext
rw [val_ofNat', Nat.mod_eq_of_lt]
exact x.2
@@ -68,6 +73,9 @@ theorem mk_val (i : Fin n) : (⟨i, i.isLt⟩ : Fin n) = i := Fin.eta ..
@[simp] theorem modn_val (a : Fin n) (b : Nat) : (a.modn b).val = a.val % b :=
rfl
@[simp] theorem val_eq_zero (a : Fin 1) : a.val = 0 :=
Nat.eq_zero_of_le_zero <| Nat.le_of_lt_succ a.isLt
theorem ite_val {n : Nat} {c : Prop} [Decidable c] {x : c Fin n} (y : ¬c Fin n) :
(if h : c then x h else y h).val = if h : c then (x h).val else (y h).val := by
by_cases c <;> simp [*]
@@ -120,7 +128,7 @@ theorem mk_le_of_le_val {b : Fin n} {a : Nat} (h : a ≤ b) :
@[simp] theorem mk_lt_mk {x y : Nat} {hx hy} : (x, hx : Fin n) < y, hy x < y := .rfl
@[simp] theorem val_zero (n : Nat) : (0 : Fin (n + 1)).1 = 0 := rfl
@[simp] theorem val_zero (n : Nat) [NeZero n] : ((0 : Fin n) : Nat) = 0 := rfl
@[simp] theorem mk_zero : (0, Nat.succ_pos n : Fin (n + 1)) = 0 := rfl
@@ -167,8 +175,24 @@ theorem rev_eq {n a : Nat} (i : Fin (n + 1)) (h : n = a + i) :
@[simp] theorem rev_lt_rev {i j : Fin n} : rev i < rev j j < i := by
rw [ Fin.not_le, Fin.not_le, rev_le_rev]
/-! ### last -/
@[simp] theorem val_last (n : Nat) : last n = n := rfl
@[simp] theorem last_zero : (Fin.last 0 : Fin 1) = 0 := by
ext
simp
@[simp] theorem zero_eq_last_iff {n : Nat} : (0 : Fin (n + 1)) = last n n = 0 := by
constructor
· intro h
simp_all [Fin.ext_iff]
· rintro rfl
simp
@[simp] theorem last_eq_zero_iff {n : Nat} : Fin.last n = 0 n = 0 := by
simp [eq_comm (a := Fin.last n)]
theorem le_last (i : Fin (n + 1)) : i last n := Nat.le_of_lt_succ i.is_lt
theorem last_pos : (0 : Fin (n + 2)) < last (n + 1) := Nat.succ_pos _
@@ -202,10 +226,28 @@ instance subsingleton_one : Subsingleton (Fin 1) := subsingleton_iff_le_one.2 (b
theorem fin_one_eq_zero (a : Fin 1) : a = 0 := Subsingleton.elim a 0
@[simp] theorem zero_eq_one_iff {n : Nat} [NeZero n] : (0 : Fin n) = 1 n = 1 := by
constructor
· intro h
simp [Fin.ext_iff] at h
change 0 % n = 1 % n at h
rw [eq_comm] at h
simpa using h
· rintro rfl
simp
@[simp] theorem one_eq_zero_iff {n : Nat} [NeZero n] : (1 : Fin n) = 0 n = 1 := by
rw [eq_comm]
simp
theorem add_def (a b : Fin n) : a + b = Fin.mk ((a + b) % n) (Nat.mod_lt _ a.size_pos) := rfl
theorem val_add (a b : Fin n) : (a + b).val = (a.val + b.val) % n := rfl
@[simp] protected theorem zero_add {n : Nat} [NeZero n] (i : Fin n) : (0 : Fin n) + i = i := by
ext
simp [Fin.add_def, Nat.mod_eq_of_lt i.2]
theorem val_add_one_of_lt {n : Nat} {i : Fin n.succ} (h : i < last _) : (i + 1).1 = i + 1 := by
match n with
| 0 => cases h
@@ -329,6 +371,10 @@ theorem succ_succ_ne_one (a : Fin n) : Fin.succ (Fin.succ a) ≠ 1 :=
@[simp] theorem cast_mk (h : n = m) (i : Nat) (hn : i < n) : cast h i, hn = i, h hn := rfl
@[simp] theorem cast_refl (n : Nat) (h : n = n) : cast h = id := by
ext
simp
@[simp] theorem cast_trans {k : Nat} (h : n = m) (h' : m = k) {i : Fin n} :
cast h' (cast h i) = cast (Eq.trans h h') i := rfl
@@ -437,6 +483,10 @@ theorem succ_castSucc {n : Nat} (i : Fin n) : i.castSucc.succ = castSucc i.succ
@[simp] theorem coe_addNat (m : Nat) (i : Fin n) : (addNat i m : Nat) = i + m := rfl
@[simp] theorem addNat_zero (n : Nat) (i : Fin n) : addNat i 0 = i := by
ext
simp
@[simp] theorem addNat_one {i : Fin n} : addNat i 1 = i.succ := rfl
theorem le_coe_addNat (m : Nat) (i : Fin n) : m addNat i m :=
@@ -466,7 +516,7 @@ theorem cast_addNat_left {n n' m : Nat} (i : Fin n') (h : n' + m = n + m) :
theorem le_coe_natAdd (m : Nat) (i : Fin n) : m natAdd m i := Nat.le_add_right ..
theorem natAdd_zero {n : Nat} : natAdd 0 = cast (Nat.zero_add n).symm := by ext; simp
@[simp] theorem natAdd_zero {n : Nat} : natAdd 0 = cast (Nat.zero_add n).symm := by ext; simp
/-- For rewriting in the reverse direction, see `Fin.cast_natAdd_right`. -/
theorem natAdd_cast {n n' : Nat} (m : Nat) (i : Fin n') (h : n' = n) :
@@ -504,9 +554,19 @@ theorem cast_addNat {n : Nat} (m : Nat) (i : Fin n) :
@[simp] theorem natAdd_last {m n : Nat} : natAdd n (last m) = last (n + m) := rfl
@[simp] theorem addNat_last (n : Nat) :
addNat (last n) m = cast (by omega) (last (n + m)) := by
ext
simp
theorem natAdd_castSucc {m n : Nat} {i : Fin m} : natAdd n (castSucc i) = castSucc (natAdd n i) :=
rfl
@[simp] theorem natAdd_eq_addNat (n : Nat) (i : Fin n) : Fin.natAdd n i = i.addNat n := by
ext
simp
omega
theorem rev_castAdd (k : Fin n) (m : Nat) : rev (castAdd m k) = addNat (rev k) m := Fin.ext <| by
rw [val_rev, coe_castAdd, coe_addNat, val_rev, Nat.sub_add_comm (Nat.succ_le_of_lt k.is_lt)]
@@ -572,6 +632,15 @@ theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) :
@[simp] theorem subNat_mk {i : Nat} (h₁ : i < n + m) (h₂ : m i) :
subNat m i, h₁ h₂ = i - m, Nat.sub_lt_right_of_lt_add h₂ h₁ := rfl
@[simp] theorem subNat_zero (i : Fin n) (h : 0 (i : Nat)): Fin.subNat 0 i h = i := by
ext
simp
@[simp] theorem subNat_one_succ (i : Fin (n + 1)) (h : 1 i) : (subNat 1 i h).succ = i := by
ext
simp
omega
@[simp] theorem pred_castSucc_succ (i : Fin n) :
pred (castSucc i.succ) (Fin.ne_of_gt (castSucc_pos i.succ_pos)) = castSucc i := rfl
@@ -582,7 +651,7 @@ theorem pred_add_one (i : Fin (n + 2)) (h : (i : Nat) < n + 1) :
subNat m (addNat i m) h = i := Fin.ext <| Nat.add_sub_cancel i m
@[simp] theorem natAdd_subNat_cast {i : Fin (n + m)} (h : n i) :
natAdd n (subNat n (cast (Nat.add_comm ..) i) h) = i := by simp [ cast_addNat]; rfl
natAdd n (subNat n (cast (Nat.add_comm ..) i) h) = i := by simp [ cast_addNat]
/-! ### recursion and induction principles -/
@@ -750,13 +819,13 @@ theorem addCases_right {m n : Nat} {motive : Fin (m + n) → Sort _} {left right
/-! ### add -/
@[simp] theorem ofNat'_add (x : Nat) (lt : 0 < n) (y : Fin n) :
Fin.ofNat' x lt + y = Fin.ofNat' (x + y.val) lt := by
theorem ofNat'_add [NeZero n] (x : Nat) (y : Fin n) :
Fin.ofNat' n x + y = Fin.ofNat' n (x + y.val) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.add_def]
@[simp] theorem add_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) :
x + Fin.ofNat' y lt = Fin.ofNat' (x.val + y) lt := by
theorem add_ofNat' [NeZero n] (x : Fin n) (y : Nat) :
x + Fin.ofNat' n y = Fin.ofNat' n (x.val + y) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.add_def]
@@ -765,16 +834,21 @@ theorem addCases_right {m n : Nat} {motive : Fin (m + n) → Sort _} {left right
protected theorem coe_sub (a b : Fin n) : ((a - b : Fin n) : Nat) = ((n - b) + a) % n := by
cases a; cases b; rfl
@[simp] theorem ofNat'_sub (x : Nat) (lt : 0 < n) (y : Fin n) :
Fin.ofNat' x lt - y = Fin.ofNat' ((n - y.val) + x) lt := by
theorem ofNat'_sub [NeZero n] (x : Nat) (y : Fin n) :
Fin.ofNat' n x - y = Fin.ofNat' n ((n - y.val) + x) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.sub_def]
@[simp] theorem sub_ofNat' (x : Fin n) (y : Nat) (lt : 0 < n) :
x - Fin.ofNat' y lt = Fin.ofNat' ((n - y % n) + x.val) lt := by
theorem sub_ofNat' [NeZero n] (x : Fin n) (y : Nat) :
x - Fin.ofNat' n y = Fin.ofNat' n ((n - y % n) + x.val) := by
apply Fin.eq_of_val_eq
simp [Fin.ofNat', Fin.sub_def]
@[simp] protected theorem sub_self [NeZero n] {x : Fin n} : x - x = 0 := by
ext
rw [Fin.sub_def]
simp
private theorem _root_.Nat.mod_eq_sub_of_lt_two_mul {x n} (h₁ : n x) (h₂ : x < 2 * n) :
x % n = x - n := by
rw [Nat.mod_eq, if_pos (by omega), Nat.mod_eq_of_lt (by omega)]

View File

@@ -194,7 +194,7 @@ theorem fdiv_eq_tdiv {a b : Int} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : fdiv a b = tdiv
@[simp, norm_cast] theorem ofNat_emod (m n : Nat) : ((m % n) : Int) = m % n := rfl
/-! ### mod definitiions -/
/-! ### mod definitions -/
theorem emod_add_ediv : a b : Int, a % b + b * (a / b) = a
| ofNat _, ofNat _ => congrArg ofNat <| Nat.mod_add_div ..

View File

@@ -48,6 +48,8 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
@[simp] theorem attach_nil : ([] : List α).attach = [] := rfl
@[simp] theorem attachWith_nil : ([] : List α).attachWith P H = [] := rfl
@[simp]
theorem pmap_eq_map (p : α Prop) (f : α β) (l : List α) (H) :
@pmap _ _ p (fun a _ => f a) l H = map f l := by
@@ -81,7 +83,12 @@ theorem attach_congr {l₁ l₂ : List α} (h : l₁ = l₂) :
subst h
simp
@[simp] theorem attach_cons (x : α) (xs : List α) :
theorem attachWith_congr {l₁ l₂ : List α} (w : l₁ = l₂) {P : α Prop} {H : x l₁, P x} :
l₁.attachWith P H = l₂.attachWith P fun x h => H _ (w h) := by
subst w
simp
@[simp] theorem attach_cons {x : α} {xs : List α} :
(x :: xs).attach =
x, mem_cons_self x xs :: xs.attach.map fun y, h => y, mem_cons_of_mem x h := by
simp only [attach, attachWith, pmap, map_pmap, cons.injEq, true_and]
@@ -89,6 +96,12 @@ theorem attach_congr {l₁ l₂ : List α} (h : l₁ = l₂) :
intros a _ m' _
rfl
@[simp]
theorem attachWith_cons {x : α} {xs : List α} {p : α Prop} (h : a x :: xs, p a) :
(x :: xs).attachWith p h = x, h x (mem_cons_self x xs) ::
xs.attachWith p (fun a ha h a (mem_cons_of_mem x ha)) :=
rfl
theorem pmap_eq_map_attach {p : α Prop} (f : a, p a β) (l H) :
pmap f l H = l.attach.map fun x => f x.1 (H _ x.2) := by
rw [attach, attachWith, map_pmap]; exact pmap_congr_left l fun _ _ _ _ => rfl
@@ -104,14 +117,18 @@ theorem attach_map_val (l : List α) (f : α → β) : (l.attach.map fun i => f
theorem attach_map_subtype_val (l : List α) : l.attach.map Subtype.val = l :=
(attach_map_coe _ _).trans (List.map_id _)
theorem countP_attach (l : List α) (p : α Bool) :
l.attach.countP (fun a : {x // x l} => p a) = l.countP p := by
simp only [ Function.comp_apply (g := Subtype.val), countP_map, attach_map_subtype_val]
theorem attachWith_map_coe {p : α Prop} (f : α β) (l : List α) (H : a l, p a) :
((l.attachWith p H).map fun (i : { i // p i}) => f i) = l.map f := by
rw [attachWith, map_pmap]; exact pmap_eq_map _ _ _ _
theorem attachWith_map_val {p : α Prop} (f : α β) (l : List α) (H : a l, p a) :
((l.attachWith p H).map fun i => f i.val) = l.map f :=
attachWith_map_coe _ _ _
@[simp]
theorem count_attach [DecidableEq α] (l : List α) (a : {x // x l}) :
l.attach.count a = l.count a :=
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attach _ _
theorem attachWith_map_subtype_val {p : α Prop} (l : List α) (H : a l, p a) :
(l.attachWith p H).map Subtype.val = l :=
(attachWith_map_coe _ _ _).trans (List.map_id _)
@[simp]
theorem mem_attach (l : List α) : x, x l.attach
@@ -137,7 +154,11 @@ theorem length_pmap {p : α → Prop} {f : ∀ a, p a → β} {l H} : length (pm
· simp only [*, pmap, length]
@[simp]
theorem length_attach (L : List α) : L.attach.length = L.length :=
theorem length_attach {L : List α} : L.attach.length = L.length :=
length_pmap
@[simp]
theorem length_attachWith {p : α Prop} {l H} : length (l.attachWith p H) = length l :=
length_pmap
@[simp]
@@ -155,6 +176,15 @@ theorem attach_eq_nil_iff {l : List α} : l.attach = [] ↔ l = [] :=
theorem attach_ne_nil_iff {l : List α} : l.attach [] l [] :=
pmap_ne_nil_iff _ _
@[simp]
theorem attachWith_eq_nil_iff {l : List α} {P : α Prop} {H : a l, P a} :
l.attachWith P H = [] l = [] :=
pmap_eq_nil_iff
theorem attachWith_ne_nil_iff {l : List α} {P : α Prop} {H : a l, P a} :
l.attachWith P H [] l [] :=
pmap_ne_nil_iff _ _
@[deprecated pmap_eq_nil_iff (since := "2024-09-06")] abbrev pmap_eq_nil := @pmap_eq_nil_iff
@[deprecated pmap_ne_nil_iff (since := "2024-09-06")] abbrev pmap_ne_nil := @pmap_ne_nil_iff
@[deprecated attach_eq_nil_iff (since := "2024-09-06")] abbrev attach_eq_nil := @attach_eq_nil_iff
@@ -187,7 +217,7 @@ theorem getElem_pmap {p : α → Prop} (f : ∀ a, p a → β) {l : List α} (h
(hn : n < (pmap f l h).length) :
(pmap f l h)[n] =
f (l[n]'(@length_pmap _ _ p f l h hn))
(h _ (getElem_mem l n (@length_pmap _ _ p f l h hn))) := by
(h _ (getElem_mem (@length_pmap _ _ p f l h hn))) := by
induction l generalizing n with
| nil =>
simp only [length, pmap] at hn
@@ -205,34 +235,26 @@ theorem get_pmap {p : α → Prop} (f : ∀ a, p a → β) {l : List α} (h :
simp only [get_eq_getElem]
simp [getElem_pmap]
@[simp]
theorem getElem?_attachWith {xs : List α} {i : Nat} {P : α Prop} {H : a xs, P a} :
(xs.attachWith P H)[i]? = xs[i]?.pmap Subtype.mk (fun _ a => H _ (getElem?_mem a)) :=
getElem?_pmap ..
@[simp]
theorem getElem?_attach {xs : List α} {i : Nat} :
xs.attach[i]? = xs[i]?.pmap Subtype.mk (fun _ a => getElem?_mem a) := by
induction xs generalizing i with
| nil => simp
| cons x xs ih =>
rcases i with i
· simp only [attach_cons, Option.pmap]
split <;> simp_all
· simp only [attach_cons, getElem?_cons_succ, getElem?_map, ih]
simp only [Option.pmap]
split <;> split <;> simp_all
xs.attach[i]? = xs[i]?.pmap Subtype.mk (fun _ a => getElem?_mem a) :=
getElem?_attachWith
@[simp]
theorem getElem_attachWith {xs : List α} {P : α Prop} {H : a xs, P a}
{i : Nat} (h : i < (xs.attachWith P H).length) :
(xs.attachWith P H)[i] = xs[i]'(by simpa using h), H _ (getElem_mem (by simpa using h)) :=
getElem_pmap ..
@[simp]
theorem getElem_attach {xs : List α} {i : Nat} (h : i < xs.attach.length) :
xs.attach[i] = xs[i]'(by simpa using h), getElem_mem xs i (by simpa using h) := by
apply Option.some.inj
rw [ getElem?_eq_getElem]
rw [getElem?_attach]
simp only [Option.pmap]
split <;> rename_i h' _
· simp at h
simp at h'
exfalso
exact Nat.lt_irrefl _ (Nat.lt_of_le_of_lt h' h)
· simp only [Option.some.injEq, Subtype.mk.injEq]
apply Option.some.inj
rw [ getElem?_eq_getElem, h']
xs.attach[i] = xs[i]'(by simpa using h), getElem_mem (by simpa using h) :=
getElem_attachWith h
@[simp] theorem head?_pmap {P : α Prop} (f : (a : α) P a β) (xs : List α)
(H : (a : α), a xs P a) :
@@ -250,20 +272,112 @@ theorem getElem_attach {xs : List α} {i : Nat} (h : i < xs.attach.length) :
| nil => simp at h
| cons x xs ih => simp [head_pmap, ih]
@[simp] theorem head?_attachWith {P : α Prop} {xs : List α}
(H : (a : α), a xs P a) :
(xs.attachWith P H).head? = xs.head?.pbind (fun a h => some a, H _ (mem_of_mem_head? h)) := by
cases xs <;> simp_all
@[simp] theorem head_attachWith {P : α Prop} {xs : List α}
{H : (a : α), a xs P a} (h : xs.attachWith P H []) :
(xs.attachWith P H).head h = xs.head (by simpa using h), H _ (head_mem _) := by
cases xs with
| nil => simp at h
| cons x xs => simp [head_attachWith, h]
@[simp] theorem head?_attach (xs : List α) :
xs.attach.head? = xs.head?.pbind (fun a h => some a, mem_of_mem_head? h) := by
cases xs <;> simp_all
theorem head_attach {xs : List α} (h) :
@[simp] theorem head_attach {xs : List α} (h) :
xs.attach.head h = xs.head (by simpa using h), head_mem (by simpa using h) := by
cases xs with
| nil => simp at h
| cons x xs => simp [head_attach, h]
@[simp] theorem tail_pmap {P : α Prop} (f : (a : α) P a β) (xs : List α)
(H : (a : α), a xs P a) :
(xs.pmap f H).tail = xs.tail.pmap f (fun a h => H a (mem_of_mem_tail h)) := by
cases xs <;> simp
@[simp] theorem tail_attachWith {P : α Prop} {xs : List α}
{H : (a : α), a xs P a} :
(xs.attachWith P H).tail = xs.tail.attachWith P (fun a h => H a (mem_of_mem_tail h)) := by
cases xs <;> simp
@[simp] theorem tail_attach (xs : List α) :
xs.attach.tail = xs.tail.attach.map (fun x, h => x, mem_of_mem_tail h) := by
cases xs <;> simp
theorem foldl_pmap (l : List α) {P : α Prop} (f : (a : α) P a β)
(H : (a : α), a l P a) (g : γ β γ) (x : γ) :
(l.pmap f H).foldl g x = l.attach.foldl (fun acc a => g acc (f a.1 (H _ a.2))) x := by
rw [pmap_eq_map_attach, foldl_map]
theorem foldr_pmap (l : List α) {P : α Prop} (f : (a : α) P a β)
(H : (a : α), a l P a) (g : β γ γ) (x : γ) :
(l.pmap f H).foldr g x = l.attach.foldr (fun a acc => g (f a.1 (H _ a.2)) acc) x := by
rw [pmap_eq_map_attach, foldr_map]
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
-/
theorem foldl_attach (l : List α) (f : β α β) (b : β) :
l.attach.foldl (fun acc t => f acc t.1) b = l.foldl f b := by
induction l generalizing b with
| nil => simp
| cons a l ih => rw [foldl_cons, attach_cons, foldl_cons, foldl_map, ih]
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
This is useful when we need to use `attach` to show termination.
Unfortunately this can't be applied by `simp` because of the higher order unification problem,
and even when rewriting we need to specify the function explicitly.
-/
theorem foldr_attach (l : List α) (f : α β β) (b : β) :
l.attach.foldr (fun t acc => f t.1 acc) b = l.foldr f b := by
induction l generalizing b with
| nil => simp
| cons a l ih => rw [foldr_cons, attach_cons, foldr_cons, foldr_map, ih]
theorem attach_map {l : List α} (f : α β) :
(l.map f).attach = l.attach.map (fun x, h => f x, mem_map_of_mem f h) := by
induction l <;> simp [*]
theorem attachWith_map {l : List α} (f : α β) {P : β Prop} {H : (b : β), b l.map f P b} :
(l.map f).attachWith P H = (l.attachWith (P f) (fun a h => H _ (mem_map_of_mem f h))).map
fun x, h => f x, h := by
induction l <;> simp [*]
theorem map_attachWith {l : List α} {P : α Prop} {H : (a : α), a l P a}
(f : { x // P x } β) :
(l.attachWith P H).map f =
l.pmap (fun a (h : a l P a) => f a, H _ h.1) (fun a h => h, H a h) := by
induction l with
| nil => rfl
| cons x xs ih =>
simp only [attachWith_cons, map_cons, ih, pmap, cons.injEq, true_and]
apply pmap_congr_left
simp
/-- See also `pmap_eq_map_attach` for writing `pmap` in terms of `map` and `attach`. -/
theorem map_attach {l : List α} (f : { x // x l } β) :
l.attach.map f = l.pmap (fun a h => f a, h) (fun _ => id) := by
induction l with
| nil => rfl
| cons x xs ih =>
simp only [attach_cons, map_cons, map_map, Function.comp_apply, pmap, cons.injEq, true_and, ih]
apply pmap_congr_left
simp
theorem attach_filterMap {l : List α} {f : α Option β} :
(l.filterMap f).attach = l.attach.filterMap
fun x, h => (f x).pbind (fun b m => some b, mem_filterMap.mpr x, h, m) := by
@@ -304,6 +418,9 @@ theorem attach_filter {l : List α} (p : α → Bool) :
ext1
split <;> simp
-- We are still missing here `attachWith_filterMap` and `attachWith_filter`.
-- Also missing are `filterMap_attach`, `filter_attach`, `filterMap_attachWith` and `filter_attachWith`.
theorem pmap_pmap {p : α Prop} {q : β Prop} (g : a, p a β) (f : b, q b γ) (l H₁ H₂) :
pmap f (pmap g l H₁) H₂ =
pmap (α := { x // x l }) (fun a h => f (g a h) (H₂ (g a h) (mem_pmap_of_mem a.2))) l.attach
@@ -334,6 +451,12 @@ theorem pmap_append' {p : α → Prop} (f : ∀ a : α, p a → β) (l₁ l₂ :
congr 1 <;>
exact pmap_congr_left _ fun _ _ _ _ => rfl
@[simp] theorem attachWith_append {P : α Prop} {xs ys : List α}
{H : (a : α), a xs ++ ys P a} :
(xs ++ ys).attachWith P H = xs.attachWith P (fun a h => H a (mem_append_of_mem_left ys h)) ++
ys.attachWith P (fun a h => H a (mem_append_of_mem_right xs h)) := by
simp only [attachWith, attach_append, map_pmap, pmap_append]
@[simp] theorem pmap_reverse {P : α Prop} (f : (a : α) P a β) (xs : List α)
(H : (a : α), a xs.reverse P a) :
xs.reverse.pmap f H = (xs.pmap f (fun a h => H a (by simpa using h))).reverse := by
@@ -344,6 +467,17 @@ theorem reverse_pmap {P : α → Prop} (f : (a : α) → P a → β) (xs : List
(xs.pmap f H).reverse = xs.reverse.pmap f (fun a h => H a (by simpa using h)) := by
rw [pmap_reverse]
@[simp] theorem attachWith_reverse {P : α Prop} {xs : List α}
{H : (a : α), a xs.reverse P a} :
xs.reverse.attachWith P H =
(xs.attachWith P (fun a h => H a (by simpa using h))).reverse :=
pmap_reverse ..
theorem reverse_attachWith {P : α Prop} {xs : List α}
{H : (a : α), a xs P a} :
(xs.attachWith P H).reverse = (xs.reverse.attachWith P (fun a h => H a (by simpa using h))) :=
reverse_pmap ..
@[simp] theorem attach_reverse (xs : List α) :
xs.reverse.attach = xs.attach.reverse.map fun x, h => x, by simpa using h := by
simp only [attach, attachWith, reverse_pmap, map_pmap]
@@ -358,17 +492,6 @@ theorem reverse_attach (xs : List α) :
intros
rfl
@[simp]
theorem getLast?_attach {xs : List α} :
xs.attach.getLast? = xs.getLast?.pbind fun a h => some a, mem_of_getLast?_eq_some h := by
rw [getLast?_eq_head?_reverse, reverse_attach, head?_map, head?_attach]
simp
@[simp]
theorem getLast_attach {xs : List α} (h : xs.attach []) :
xs.attach.getLast h = xs.getLast (by simpa using h), getLast_mem (by simpa using h) := by
simp only [getLast_eq_head_reverse, reverse_attach, head_map, head_attach]
@[simp] theorem getLast?_pmap {P : α Prop} (f : (a : α) P a β) (xs : List α)
(H : (a : α), a xs P a) :
(xs.pmap f H).getLast? = xs.attach.getLast?.map fun a, m => f a (H a m) := by
@@ -383,4 +506,46 @@ theorem getLast_attach {xs : List α} (h : xs.attach ≠ []) :
simp only [getLast_eq_head_reverse]
simp only [reverse_pmap, head_pmap, head_reverse]
@[simp] theorem getLast?_attachWith {P : α Prop} {xs : List α}
{H : (a : α), a xs P a} :
(xs.attachWith P H).getLast? = xs.getLast?.pbind (fun a h => some a, H _ (mem_of_getLast?_eq_some h)) := by
rw [getLast?_eq_head?_reverse, reverse_attachWith, head?_attachWith]
simp
@[simp] theorem getLast_attachWith {P : α Prop} {xs : List α}
{H : (a : α), a xs P a} (h : xs.attachWith P H []) :
(xs.attachWith P H).getLast h = xs.getLast (by simpa using h), H _ (getLast_mem _) := by
simp only [getLast_eq_head_reverse, reverse_attachWith, head_attachWith, head_map]
@[simp]
theorem getLast?_attach {xs : List α} :
xs.attach.getLast? = xs.getLast?.pbind fun a h => some a, mem_of_getLast?_eq_some h := by
rw [getLast?_eq_head?_reverse, reverse_attach, head?_map, head?_attach]
simp
@[simp]
theorem getLast_attach {xs : List α} (h : xs.attach []) :
xs.attach.getLast h = xs.getLast (by simpa using h), getLast_mem (by simpa using h) := by
simp only [getLast_eq_head_reverse, reverse_attach, head_map, head_attach]
@[simp]
theorem countP_attach (l : List α) (p : α Bool) :
l.attach.countP (fun a : {x // x l} => p a) = l.countP p := by
simp only [ Function.comp_apply (g := Subtype.val), countP_map, attach_map_subtype_val]
@[simp]
theorem countP_attachWith {p : α Prop} (l : List α) (H : a l, p a) (q : α Bool) :
(l.attachWith p H).countP (fun a : {x // p x} => q a) = l.countP q := by
simp only [ Function.comp_apply (g := Subtype.val), countP_map, attachWith_map_subtype_val]
@[simp]
theorem count_attach [DecidableEq α] (l : List α) (a : {x // x l}) :
l.attach.count a = l.count a :=
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attach _ _
@[simp]
theorem count_attachWith [DecidableEq α] {p : α Prop} (l : List α) (H : a l, p a) (a : {x // p x}) :
(l.attachWith p H).count a = l.count a :=
Eq.trans (countP_congr fun _ _ => by simp [Subtype.ext_iff]) <| countP_attachWith _ _ _
end List

View File

@@ -1588,6 +1588,14 @@ such that adjacent elements are related by `R`.
| [] => []
| a::as => loop as a [] []
where
/--
The arguments of `groupBy.loop l ag g gs` represent the following:
- `l : List α` are the elements which we still need to group.
- `ag : α` is the previous element for which a comparison was performed.
- `g : List α` is the group currently being assembled, in **reverse order**.
- `gs : List (List α)` is all of the groups that have been completed, in **reverse order**.
-/
@[specialize] loop : List α α List α List (List α) List (List α)
| a::as, ag, g, gs => match R ag a with
| true => loop as a (ag::g) gs

View File

@@ -155,7 +155,7 @@ def mapMono (as : List α) (f : αα) : List α :=
/-! ## Additional lemmas required for bootstrapping `Array`. -/
theorem getElem_append_left (as bs : List α) (h : i < as.length) {h'} : (as ++ bs)[i] = as[i] := by
theorem getElem_append_left {as bs : List α} (h : i < as.length) {h'} : (as ++ bs)[i] = as[i] := by
induction as generalizing i with
| nil => trivial
| cons a as ih =>
@@ -163,12 +163,14 @@ theorem getElem_append_left (as bs : List α) (h : i < as.length) {h'} : (as ++
| zero => rfl
| succ i => apply ih
theorem getElem_append_right (as bs : List α) (h : ¬ i < as.length) {h' h''} : (as ++ bs)[i]'h' = bs[i - as.length]'h'' := by
theorem getElem_append_right {as bs : List α} {i : Nat} (h₁ : as.length i) {h₂} :
(as ++ bs)[i]'h₂ =
bs[i - as.length]'(by rw [length_append] at h₂; exact Nat.sub_lt_left_of_lt_add h₁ h₂) := by
induction as generalizing i with
| nil => trivial
| cons a as ih =>
cases i with simp [get, Nat.succ_sub_succ] <;> simp [Nat.succ_sub_succ] at h
| succ i => apply ih; simp [h]
cases i with simp [get, Nat.succ_sub_succ] <;> simp [Nat.succ_sub_succ] at h
| succ i => apply ih; simp [h]
theorem get_last {as : List α} {i : Fin (length (as ++ [a]))} (h : ¬ i.1 < as.length) : (as ++ [a] : List _).get i = a := by
cases i; rename_i i h'

View File

@@ -115,6 +115,13 @@ theorem IsPrefix.countP_le (s : l₁ <+: l₂) : countP p l₁ ≤ countP p l₂
theorem IsSuffix.countP_le (s : l₁ <:+ l₂) : countP p l₁ countP p l₂ := s.sublist.countP_le _
theorem IsInfix.countP_le (s : l₁ <:+: l₂) : countP p l₁ countP p l₂ := s.sublist.countP_le _
-- See `Init.Data.List.Nat.Count` for `Sublist.le_countP : countP p l₂ - (l₂.length - l₁.length) ≤ countP p l₁`.
theorem countP_tail_le (l) : countP p l.tail countP p l :=
(tail_sublist l).countP_le _
-- See `Init.Data.List.Nat.Count` for `le_countP_tail : countP p l - 1 ≤ countP p l.tail`.
theorem countP_filter (l : List α) :
countP p (filter q l) = countP (fun a => p a && q a) l := by
simp only [countP_eq_length_filter, filter_filter]
@@ -207,6 +214,13 @@ theorem IsPrefix.count_le (h : l₁ <+: l₂) (a : α) : count a l₁ ≤ count
theorem IsSuffix.count_le (h : l₁ <:+ l₂) (a : α) : count a l₁ count a l₂ := h.sublist.count_le _
theorem IsInfix.count_le (h : l₁ <:+: l₂) (a : α) : count a l₁ count a l₂ := h.sublist.count_le _
-- See `Init.Data.List.Nat.Count` for `Sublist.le_count : count a l₂ - (l₂.length - l₁.length) ≤ countP a l₁`.
theorem count_tail_le (a : α) (l) : count a l.tail count a l :=
(tail_sublist l).count_le _
-- See `Init.Data.List.Nat.Count` for `le_count_tail : count a l - 1 ≤ count a l.tail`.
theorem count_le_count_cons (a b : α) (l : List α) : count a l count a (b :: l) :=
(sublist_cons_self _ _).count_le _

View File

@@ -109,6 +109,10 @@ protected theorem Sublist.eraseP : l₁ <+ l₂ → l₁.eraseP p <+ l₂.eraseP
theorem length_eraseP_le (l : List α) : (l.eraseP p).length l.length :=
l.eraseP_sublist.length_le
theorem le_length_eraseP (l : List α) : l.length - 1 (l.eraseP p).length := by
rw [length_eraseP]
split <;> simp
theorem mem_of_mem_eraseP {l : List α} : a l.eraseP p a l := (eraseP_subset _ ·)
@[simp] theorem mem_eraseP_of_neg {l : List α} (pa : ¬p a) : a l.eraseP p a l := by
@@ -332,6 +336,10 @@ theorem IsPrefix.erase (a : α) {l₁ l₂ : List α} (h : l₁ <+: l₂) : l₁
theorem length_erase_le (a : α) (l : List α) : (l.erase a).length l.length :=
(erase_sublist a l).length_le
theorem le_length_erase [LawfulBEq α] (a : α) (l : List α) : l.length - 1 (l.erase a).length := by
rw [length_erase]
split <;> simp
theorem mem_of_mem_erase {a b : α} {l : List α} (h : a l.erase b) : a l := erase_subset _ _ h
@[simp] theorem mem_erase_of_ne [LawfulBEq α] {a b : α} {l : List α} (ab : a b) :
@@ -452,13 +460,22 @@ end erase
/-! ### eraseIdx -/
theorem length_eraseIdx : {l i}, i < length l length (@eraseIdx α l i) = length l - 1
| [], _, _ => rfl
| _::_, 0, _ => by simp [eraseIdx]
| x::xs, i+1, h => by
have : i < length xs := Nat.lt_of_succ_lt_succ h
simp [eraseIdx, Nat.add_one]
rw [length_eraseIdx this, Nat.sub_add_cancel (Nat.lt_of_le_of_lt (Nat.zero_le _) this)]
theorem length_eraseIdx (l : List α) (i : Nat) :
(l.eraseIdx i).length = if i < l.length then l.length - 1 else l.length := by
induction l generalizing i with
| nil => simp
| cons x l ih =>
cases i with
| zero => simp
| succ i =>
simp only [eraseIdx, length_cons, ih, add_one_lt_add_one_iff, Nat.add_one_sub_one]
split
· cases l <;> simp_all
· rfl
theorem length_eraseIdx_of_lt {l : List α} {i} (h : i < length l) :
(l.eraseIdx i).length = length l - 1 := by
simp [length_eraseIdx, h]
@[simp] theorem eraseIdx_zero (l : List α) : eraseIdx l 0 = tail l := by cases l <;> rfl
@@ -468,6 +485,8 @@ theorem eraseIdx_eq_take_drop_succ :
| a::l, 0 => by simp
| a::l, i + 1 => by simp [eraseIdx_eq_take_drop_succ l i]
-- See `Init.Data.List.Nat.Erase` for `getElem?_eraseIdx` and `getElem_eraseIdx`.
@[simp] theorem eraseIdx_eq_nil {l : List α} {i : Nat} : eraseIdx l i = [] l = [] (length l = 1 i = 0) := by
match l, i with
| [], _
@@ -499,6 +518,13 @@ theorem eraseIdx_eq_self : ∀ {l : List α} {k : Nat}, eraseIdx l k = l ↔ len
theorem eraseIdx_of_length_le {l : List α} {k : Nat} (h : length l k) : eraseIdx l k = l := by
rw [eraseIdx_eq_self.2 h]
theorem length_eraseIdx_le (l : List α) (i : Nat) : length (l.eraseIdx i) length l :=
(eraseIdx_sublist l i).length_le
theorem le_length_eraseIdx (l : List α) (i : Nat) : length l - 1 length (l.eraseIdx i) := by
rw [length_eraseIdx]
split <;> simp
theorem eraseIdx_append_of_lt_length {l : List α} {k : Nat} (hk : k < length l) (l' : List α) :
eraseIdx (l ++ l') k = eraseIdx l k ++ l' := by
induction l generalizing k with
@@ -520,7 +546,7 @@ theorem eraseIdx_append_of_length_le {l : List α} {k : Nat} (hk : length l ≤
theorem eraseIdx_replicate {n : Nat} {a : α} {k : Nat} :
(replicate n a).eraseIdx k = if k < n then replicate (n - 1) a else replicate n a := by
split <;> rename_i h
· rw [eq_replicate_iff, length_eraseIdx (by simpa using h)]
· rw [eq_replicate_iff, length_eraseIdx_of_lt (by simpa using h)]
simp only [length_replicate, true_and]
intro b m
replace m := mem_of_mem_eraseIdx m

View File

@@ -224,7 +224,7 @@ theorem find?_eq_some : xs.find? p = some b ↔ p b ∧ ∃ as bs, xs = as ++ b
simp only [cons_append] at h₁
obtain rfl, - := h₁
simp_all
· simp only [ih, Bool.not_eq_true', exists_and_right, and_congr_right_iff]
· simp only [ih, Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
intro pb
constructor
· rintro as, bs, rfl, h₁
@@ -620,6 +620,18 @@ theorem IsPrefix.findIdx_eq_of_findIdx_lt_length {l₁ l₂ : List α} {p : α
· rfl
· simp_all
theorem findIdx_le_findIdx {l : List α} {p q : α Bool} (h : x l, p x q x) : l.findIdx q l.findIdx p := by
induction l with
| nil => simp
| cons x xs ih =>
simp only [findIdx_cons, cond_eq_if]
split
· simp
· split
· simp_all
· simp only [Nat.add_le_add_iff_right]
exact ih fun _ m w => h _ (mem_cons_of_mem x m) w
/-! ### findIdx? -/
@[simp] theorem findIdx?_nil : ([] : List α).findIdx? p i = none := rfl
@@ -803,7 +815,7 @@ theorem findIdx?_join {l : List (List α)} {p : α → Bool} :
simp only [replicate, findIdx?_cons, Nat.zero_add, findIdx?_succ, zero_lt_succ, true_and]
split <;> simp_all
theorem findIdx?_eq_enum_findSome? {xs : List α} {p : α Bool} :
theorem findIdx?_eq_findSome?_enum {xs : List α} {p : α Bool} :
xs.findIdx? p = xs.enum.findSome? fun i, a => if p a then some i else none := by
induction xs with
| nil => simp
@@ -814,6 +826,30 @@ theorem findIdx?_eq_enum_findSome? {xs : List α} {p : α → Bool} :
· simp_all only [enumFrom_cons, ite_false, Option.isNone_none, findSome?_cons_of_isNone, reduceCtorEq]
simp [Function.comp_def, map_fst_add_enum_eq_enumFrom, findSome?_map]
theorem findIdx?_eq_fst_find?_enum {xs : List α} {p : α Bool} :
xs.findIdx? p = (xs.enum.find? fun _, x => p x).map (·.1) := by
induction xs with
| nil => simp
| cons x xs ih =>
simp only [findIdx?_cons, Nat.zero_add, findIdx?_start_succ, enum_cons]
split
· simp_all
· simp only [Option.map_map, enumFrom_eq_map_enum, Bool.false_eq_true, not_false_eq_true,
find?_cons_of_neg, find?_map, *]
congr
-- See also `findIdx_le_findIdx`.
theorem findIdx?_eq_none_of_findIdx?_eq_none {xs : List α} {p q : α Bool} (w : x xs, p x q x) :
xs.findIdx? q = none xs.findIdx? p = none := by
simp only [findIdx?_eq_none_iff]
intro h x m
cases z : p x
· rfl
· exfalso
specialize w x m z
specialize h x m
simp_all
theorem Sublist.findIdx?_isSome {l₁ l₂ : List α} (h : l₁ <+ l₂) :
(l₁.findIdx? p).isSome (l₂.findIdx? p).isSome := by
simp only [List.findIdx?_isSome, any_eq_true]
@@ -878,7 +914,7 @@ theorem lookup_eq_some_iff {l : List (α × β)} {k : α} {b : β} :
simp only [lookup_eq_findSome?, findSome?_eq_some_iff]
constructor
· rintro l₁, a, l₂, rfl, h₁, h₂
simp only [beq_iff_eq, ite_some_none_eq_some] at h₁
simp only [beq_iff_eq, Option.ite_none_right_eq_some, Option.some.injEq] at h₁
obtain rfl, rfl := h₁
simp at h₂
exact l₁, l₂, rfl, by simpa using h₂

View File

@@ -109,6 +109,9 @@ theorem cons_eq_cons {a b : α} {l l' : List α} : a :: l = b :: l' ↔ a = b
theorem exists_cons_of_ne_nil : {l : List α}, l [] b L, l = b :: L
| c :: l', _ => c, l', rfl
theorem singleton_inj {α : Type _} {a b : α} : [a] = [b] a = b := by
simp
/-! ### length -/
theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
@@ -263,9 +266,15 @@ theorem get!_len_le [Inhabited α] : ∀ {l : List α} {n}, length l ≤ n → l
theorem getElem?_eq_some_iff {l : List α} : l[n]? = some a h : n < l.length, l[n] = a := by
simp only [ get?_eq_getElem?, get?_eq_some, get_eq_getElem]
theorem some_eq_getElem?_iff {l : List α} : some a = l[n]? h : n < l.length, l[n] = a := by
rw [eq_comm, getElem?_eq_some_iff]
@[simp] theorem getElem?_eq_none_iff : l[n]? = none length l n := by
simp only [ get?_eq_getElem?, get?_eq_none]
@[simp] theorem none_eq_getElem?_iff {l : List α} {n : Nat} : none = l[n]? length l n := by
simp [eq_comm (a := none)]
theorem getElem?_eq_none (h : length l n) : l[n]? = none := getElem?_eq_none_iff.mpr h
theorem getElem?_eq (l : List α) (i : Nat) :
@@ -480,9 +489,9 @@ theorem getElem?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ n : Nat, l[n]? = s
theorem get?_of_mem {a} {l : List α} (h : a l) : n, l.get? n = some a :=
let n, _, e := get_of_mem h; n, e get?_eq_get _
theorem getElem_mem : (l : List α) n (h : n < l.length), l[n]'h l
theorem getElem_mem : {l : List α} {n} (h : n < l.length), l[n]'h l
| _ :: _, 0, _ => .head ..
| _ :: l, _+1, _ => .tail _ (getElem_mem l ..)
| _ :: l, _+1, _ => .tail _ (getElem_mem (l := l) ..)
theorem get_mem : (l : List α) n h, get l n, h l
| _ :: _, 0, _ => .head ..
@@ -524,7 +533,7 @@ theorem forall_getElem {l : List α} {p : α → Prop} :
· simpa
· apply w
simp only [getElem_cons_succ]
exact getElem_mem l n (lt_of_succ_lt_succ h)
exact getElem_mem (lt_of_succ_lt_succ h)
@[simp] theorem decide_mem_cons [BEq α] [LawfulBEq α] {l : List α} :
decide (y a :: l) = (y == a || decide (y l)) := by
@@ -729,6 +738,45 @@ theorem mem_or_eq_of_mem_set : ∀ {l : List α} {n : Nat} {a b : α}, a ∈ l.s
-- See also `set_eq_take_append_cons_drop` in `Init.Data.List.TakeDrop`.
/-! ### BEq -/
@[simp] theorem reflBEq_iff [BEq α] : ReflBEq (List α) ReflBEq α := by
constructor
· intro h
constructor
intro a
suffices ([a] == [a]) = true by
simpa only [List.instBEq, List.beq, Bool.and_true]
simp
· intro h
constructor
intro a
induction a with
| nil => simp only [List.instBEq, List.beq]
| cons a as ih =>
simp [List.instBEq, List.beq]
exact ih
@[simp] theorem lawfulBEq_iff [BEq α] : LawfulBEq (List α) LawfulBEq α := by
constructor
· intro h
constructor
· intro a b h
apply singleton_inj.1
apply eq_of_beq
simp only [List.instBEq, List.beq]
simpa
· intro a
suffices ([a] == [a]) = true by
simpa only [List.instBEq, List.beq, Bool.and_true]
simp
· intro h
constructor
· intro a b h
simpa using h
· intro a
simp
/-! ### Lexicographic ordering -/
protected theorem lt_irrefl [LT α] (lt_irrefl : x : α, ¬x < x) (l : List α) : ¬l < l := by
@@ -890,6 +938,38 @@ def foldrRecOn {motive : β → Sort _} : ∀ (l : List α) (op : α → β →
x (mem_cons_self x l) :=
rfl
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldl_rel {l : List α} {f g : β α β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f c a) (g c' a)) :
r (l.foldl (fun acc a => f acc a) a) (l.foldl (fun acc a => g acc a) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldl_cons]
apply ih
· simp_all
· exact fun a m c c' h => h' _ (by simp_all) _ _ h
/--
We can prove that two folds over the same list are related (by some arbitrary relation)
if we know that the initial elements are related and the folding function, for each element of the list,
preserves the relation.
-/
theorem foldr_rel {l : List α} {f g : α β β} {a b : β} (r : β β Prop)
(h : r a b) (h' : (a : α), a l (c c' : β), r c c' r (f a c) (g a c')) :
r (l.foldr (fun a acc => f a acc) a) (l.foldr (fun a acc => g a acc) b) := by
induction l generalizing a b with
| nil => simp_all
| cons a l ih =>
simp only [foldr_cons]
apply h'
· simp
· exact ih h fun a m c c' h => h' _ (by simp_all) _ _ h
/-! ### getLast -/
theorem getLast_eq_getElem : (l : List α) (h : l []),
@@ -929,6 +1009,10 @@ theorem getLast_mem : ∀ {l : List α} (h : l ≠ []), getLast l h ∈ l
| [_], _ => .head ..
| _::a::l, _ => .tail _ <| getLast_mem (cons_ne_nil a l)
theorem getLast_mem_getLast? : {l : List α} (h : l []), getLast l h getLast? l
| [], h => by contradiction
| a :: l, _ => rfl
theorem getLastD_mem_cons : (l : List α) (a : α), getLastD l a a::l
| [], _ => .head ..
| _::_, _ => .tail _ <| getLast_mem _
@@ -999,6 +1083,11 @@ theorem head?_eq_getElem? : ∀ l : List α, head? l = l[0]?
| [] => rfl
| a :: l => by simp
theorem head_eq_getElem (l : List α) (h : l []) : head l h = l[0]'(length_pos.mpr h) := by
cases l with
| nil => simp at h
| cons _ _ => simp
theorem head_eq_iff_head?_eq_some {xs : List α} (h) : xs.head h = a xs.head? = some a := by
cases xs with
| nil => simp at h
@@ -1026,6 +1115,10 @@ theorem mem_of_mem_head? : ∀ {l : List α} {a : α}, a ∈ l.head? → a ∈ l
cases h
exact mem_cons_self a l
theorem head_mem_head? : {l : List α} (h : l []), head l h head? l
| [], h => by contradiction
| a :: l, _ => rfl
theorem head?_concat {a : α} : (l ++ [a]).head? = l.head?.getD a := by
cases l <;> simp
@@ -1055,6 +1148,55 @@ theorem tail_eq_tail? (l) : @tail α l = (tail? l).getD [] := by simp [tail_eq_t
theorem mem_of_mem_tail {a : α} {l : List α} (h : a tail l) : a l := by
induction l <;> simp_all
theorem ne_nil_of_tail_ne_nil {l : List α} : l.tail [] l [] := by
cases l <;> simp
@[simp] theorem getElem_tail (l : List α) (i : Nat) (h : i < l.tail.length) :
(tail l)[i] = l[i + 1]'(add_lt_of_lt_sub (by simpa using h)) := by
cases l with
| nil => simp at h
| cons _ l => simp
@[simp] theorem getElem?_tail (l : List α) (i : Nat) :
(tail l)[i]? = l[i + 1]? := by
cases l <;> simp
@[simp] theorem set_tail (l : List α) (i : Nat) (a : α) :
l.tail.set i a = (l.set (i + 1) a).tail := by
cases l <;> simp
theorem one_lt_length_of_tail_ne_nil {l : List α} (h : l.tail []) : 1 < l.length := by
cases l with
| nil => simp at h
| cons _ l =>
simp only [tail_cons, ne_eq] at h
exact Nat.lt_add_of_pos_left (length_pos.mpr h)
@[simp] theorem head_tail (l : List α) (h : l.tail []) :
(tail l).head h = l[1]'(one_lt_length_of_tail_ne_nil h) := by
cases l with
| nil => simp at h
| cons _ l => simp [head_eq_getElem]
@[simp] theorem head?_tail (l : List α) : (tail l).head? = l[1]? := by
simp [head?_eq_getElem?]
@[simp] theorem getLast_tail (l : List α) (h : l.tail []) :
(tail l).getLast h = l.getLast (ne_nil_of_tail_ne_nil h) := by
simp only [getLast_eq_getElem, length_tail, getElem_tail]
congr
match l with
| _ :: _ :: l => simp
theorem getLast?_tail (l : List α) : (tail l).getLast? = if l.length = 1 then none else l.getLast? := by
match l with
| [] => simp
| [a] => simp
| _ :: _ :: l =>
simp only [tail_cons, length_cons, getLast?_cons_cons]
rw [if_neg]
rintro
/-! ## Basic operations -/
/-! ### map -/
@@ -1172,11 +1314,16 @@ theorem map_eq_iff : map f l = l' ↔ ∀ i : Nat, l'[i]? = l[i]?.map f := by
theorem map_eq_foldr (f : α β) (l : List α) : map f l = foldr (fun a bs => f a :: bs) [] l := by
induction l <;> simp [*]
@[simp] theorem set_map {f : α β} {l : List α} {n : Nat} {a : α} :
(map f l).set n (f a) = map f (l.set n a) := by
induction l generalizing n with
@[simp] theorem map_set {f : α β} {l : List α} {i : Nat} {a : α} :
(l.set i a).map f = (l.map f).set i (f a) := by
induction l generalizing i with
| nil => simp
| cons b l ih => cases n <;> simp_all
| cons b l ih => cases i <;> simp_all
@[deprecated "Use the reverse direction of `map_set`." (since := "2024-09-20")]
theorem set_map {f : α β} {l : List α} {n : Nat} {a : α} :
(map f l).set n (f a) = map f (l.set n a) := by
simp
@[simp] theorem head_map (f : α β) (l : List α) (w) :
head (map f l) w = f (head l (by simpa using w)) := by
@@ -1507,10 +1654,11 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
/-! ### append -/
theorem getElem_append : {l₁ l₂ : List α} (n : Nat) (h : n < l₁.length),
(l₁ ++ l₂)[n]'(length_append .. Nat.lt_add_right _ h) = l₁[n]
| a :: l, _, 0, h => rfl
| a :: l, _, n+1, h => by simp only [get, cons_append]; apply getElem_append
theorem getElem_append {l₁ l₂ : List α} (n : Nat) (h) :
(l₁ ++ l₂)[n] = if h' : n < l₁.length then l₁[n] else l₂[n - l₁.length]'(by simp at h h'; exact Nat.sub_lt_left_of_lt_add h' h) := by
split <;> rename_i h'
· rw [getElem_append_left h']
· rw [getElem_append_right (by simpa using h')]
theorem getElem?_append_left {l₁ l₂ : List α} {n : Nat} (hn : n < l₁.length) :
(l₁ ++ l₂)[n]? = l₁[n]? := by
@@ -1536,12 +1684,13 @@ theorem get?_append_right {l₁ l₂ : List α} {n : Nat} (h : l₁.length ≤ n
(l₁ ++ l₂).get? n = l₂.get? (n - l₁.length) := by
simp [getElem?_append_right, h]
theorem getElem_append_right' {l₁ l₂ : List α} {n : Nat} (h₁ : l₁.length n) (h₂) :
(l₁ ++ l₂)[n]'h₂ =
l[n - l₁.length]'(by rw [length_append] at h₂; exact Nat.sub_lt_left_of_lt_add h₁ h) :=
Option.some.inj <| by rw [ getElem?_eq_getElem, getElem?_eq_getElem, getElem?_append_right h₁]
/-- Variant of `getElem_append_left` useful for rewriting from the small list to the big list. -/
theorem getElem_append_left' (l₂ : List α) {l₁ : List α} {n : Nat} (hn : n < l₁.length) :
l[n] = (l₁ ++ l₂)[n]'(by simpa using Nat.lt_add_right l₂.length hn) := by
rw [getElem_append_left] <;> simp
theorem getElem_append_right'' (l₁ : List α) {l₂ : List α} {n : Nat} (hn : n < l₂.length) :
/-- Variant of `getElem_append_right` useful for rewriting from the small list to the big list. -/
theorem getElem_append_right' (l₁ : List α) {l₂ : List α} {n : Nat} (hn : n < l₂.length) :
l₂[n] = (l₁ ++ l₂)[n + l₁.length]'(by simpa [Nat.add_comm] using Nat.add_lt_add_left hn _) := by
rw [getElem_append_right] <;> simp [*, le_add_left]
@@ -1552,7 +1701,7 @@ theorem get_append_right_aux {l₁ l₂ : List α} {n : Nat}
exact Nat.sub_lt_left_of_lt_add h₁ h₂
set_option linter.deprecated false in
@[deprecated getElem_append_right' (since := "2024-06-12")]
@[deprecated getElem_append_right (since := "2024-06-12")]
theorem get_append_right' {l₁ l₂ : List α} {n : Nat} (h₁ : l₁.length n) (h₂) :
(l₁ ++ l₂).get n, h₂ = l₂.get n - l₁.length, get_append_right_aux h₁ h₂ :=
Option.some.inj <| by rw [ get?_eq_get, get?_eq_get, get?_append_right h₁]
@@ -1644,7 +1793,7 @@ theorem get_append_left (as bs : List α) (h : i < as.length) {h'} :
simp [getElem_append_left, h, h']
@[deprecated getElem_append_right (since := "2024-06-12")]
theorem get_append_right (as bs : List α) (h : ¬ i < as.length) {h' h''} :
theorem get_append_right (as bs : List α) (h : as.length i) {h' h''} :
(as ++ bs).get i, h' = bs.get i - as.length, h'' := by
simp [getElem_append_right, h, h', h'']
@@ -1840,7 +1989,7 @@ theorem map_eq_append_iff {f : α → β} :
map f l = L₁ ++ L₂ l₁ l₂, l = l₁ ++ l₂ map f l₁ = L₁ map f l₂ = L₂ := by
rw [ filterMap_eq_map, filterMap_eq_append_iff]
theorem append_eq_map_iff (f : α β) :
theorem append_eq_map_iff {f : α β} :
L₁ ++ L₂ = map f l l₁ l₂, l = l₁ ++ l₂ map f l₁ = L₁ map f l₂ = L₂ := by
rw [eq_comm, map_eq_append_iff]
@@ -2323,6 +2472,47 @@ theorem bind_replicate {β} (f : α → List β) : (replicate n a).bind f = (rep
@[simp] theorem isEmpty_replicate : (replicate n a).isEmpty = decide (n = 0) := by
cases n <;> simp [replicate_succ]
/-- Every list is either empty, a non-empty `replicate`, or begins with a non-empty `replicate`
followed by a different element. -/
theorem eq_replicate_or_eq_replicate_append_cons {α : Type _} (l : List α) :
(l = []) ( n a, l = replicate n a 0 < n)
( n a b l', l = replicate n a ++ b :: l' 0 < n a b) := by
induction l with
| nil => simp
| cons x l ih =>
right
rcases ih with rfl | n, a, rfl, h | n, a, b, l', rfl, h
· left
exact 1, x, rfl, by decide
· by_cases h' : x = a
· subst h'
left
exact n + 1, x, rfl, by simp
· right
refine 1, x, a, replicate (n - 1) a, ?_, by decide, h'
match n with | n + 1 => simp [replicate_succ]
· right
by_cases h' : x = a
· subst h'
refine n + 1, x, b, l', by simp [replicate_succ], by simp, h.2
· refine 1, x, a, replicate (n - 1) a ++ b :: l', ?_, by decide, h'
match n with | n + 1 => simp [replicate_succ]
/-- An induction principle for lists based on contiguous runs of identical elements. -/
-- A `Sort _` valued version would require a different design. (And associated `@[simp]` lemmas.)
theorem replicateRecOn {α : Type _} {p : List α Prop} (m : List α)
(h0 : p []) (hr : a n, 0 < n p (replicate n a))
(hi : a b n l, a b 0 < n p (b :: l) p (replicate n a ++ b :: l)) : p m := by
rcases eq_replicate_or_eq_replicate_append_cons m with
rfl | n, a, rfl, hn | n, a, b, l', w, hn, h
· exact h0
· exact hr _ _ hn
· have : (b :: l').length < m.length := by
simpa [w] using Nat.lt_add_of_pos_left hn
subst w
exact hi _ _ _ _ h hn (replicateRecOn (b :: l') h0 hr hi)
termination_by m.length
/-! ### reverse -/
@[simp] theorem length_reverse (as : List α) : (as.reverse).length = as.length := by
@@ -2754,6 +2944,12 @@ theorem dropLast_append_cons : dropLast (l₁ ++ b :: l₂) = l₁ ++ dropLast (
dropLast (a :: replicate n a) = replicate n a := by
rw [ replicate_succ, dropLast_replicate, Nat.add_sub_cancel]
@[simp] theorem tail_reverse (l : List α) : l.reverse.tail = l.dropLast.reverse := by
apply ext_getElem
· simp
· intro i h₁ h₂
simp [Nat.add_comm i, Nat.sub_add_eq]
/-!
### splitAt

View File

@@ -10,3 +10,5 @@ import Init.Data.List.Nat.Range
import Init.Data.List.Nat.Sublist
import Init.Data.List.Nat.TakeDrop
import Init.Data.List.Nat.Count
import Init.Data.List.Nat.Erase
import Init.Data.List.Nat.Find

View File

@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
-/
prelude
import Init.Data.List.Count
import Init.Data.List.Find
import Init.Data.List.MinMax
import Init.Data.Nat.Lemmas
@@ -18,6 +19,26 @@ open Nat
namespace List
/-! ### dropLast -/
theorem tail_dropLast (l : List α) : tail (dropLast l) = dropLast (tail l) := by
ext1
simp only [getElem?_tail, getElem?_dropLast, length_tail]
split <;> split
· rfl
· omega
· omega
· rfl
@[simp] theorem dropLast_reverse (l : List α) : l.reverse.dropLast = l.tail.reverse := by
apply ext_getElem
· simp
· intro i h₁ h₂
simp only [getElem_dropLast, getElem_reverse, length_tail, getElem_tail]
congr
simp only [length_dropLast, length_reverse, length_tail] at h₁ h₂
omega
/-! ### filter -/
theorem length_filter_lt_length_iff_exists {l} :
@@ -37,7 +58,8 @@ theorem getElem_eq_getElem_reverse {l : List α} {i} (h : i < l.length) :
/-- The length of the List returned by `List.leftpad n a l` is equal
to the larger of `n` and `l.length` -/
@[simp]
-- We don't mark this as a `@[simp]` lemma since we allow `simp` to unfold `leftpad`,
-- so the left hand side simplifies directly to `n - l.length + l.length`.
theorem leftpad_length (n : Nat) (a : α) (l : List α) :
(leftpad n a l).length = max n l.length := by
simp only [leftpad, length_append, length_replicate, Nat.sub_add_eq_max]
@@ -97,6 +119,53 @@ theorem minimum?_cons' {a : Nat} {l : List Nat} :
specialize le b h
split <;> omega
theorem foldl_min
{α : Type _} [Min α] [Std.IdempotentOp (min : α α α)] [Std.Associative (min : α α α)]
{l : List α} {a : α} :
l.foldl (init := a) min = min a (l.minimum?.getD a) := by
cases l with
| nil => simp [Std.IdempotentOp.idempotent]
| cons b l =>
simp only [minimum?]
induction l generalizing a b with
| nil => simp
| cons c l ih => simp [ih, Std.Associative.assoc]
theorem foldl_min_right {α β : Type _}
[Min β] [Std.IdempotentOp (min : β β β)] [Std.Associative (min : β β β)]
{l : List α} {b : β} {f : α β} :
(l.foldl (init := b) fun acc a => min acc (f a)) = min b ((l.map f).minimum?.getD b) := by
rw [ foldl_map, foldl_min]
theorem foldl_min_le {l : List Nat} {a : Nat} : l.foldl (init := a) min a := by
induction l generalizing a with
| nil => simp
| cons c l ih =>
simp only [foldl_cons]
exact Nat.le_trans ih (Nat.min_le_left _ _)
theorem foldl_min_min_of_le {l : List Nat} {a b : Nat} (h : a b) :
l.foldl (init := a) min b :=
Nat.le_trans (foldl_min_le) h
theorem minimum?_getD_le_of_mem {l : List Nat} {a k : Nat} (h : a l) :
l.minimum?.getD k a := by
cases l with
| nil => simp at h
| cons b l =>
simp [minimum?_cons]
simp at h
rcases h with (rfl | h)
· exact foldl_min_le
· induction l generalizing b with
| nil => simp_all
| cons c l ih =>
simp only [foldl_cons]
simp at h
rcases h with (rfl | h)
· exact foldl_min_min_of_le (Nat.min_le_right _ _)
· exact ih _ h
/-! ### maximum? -/
-- A specialization of `maximum?_eq_some_iff` to Nat.
@@ -130,4 +199,51 @@ theorem maximum?_cons' {a : Nat} {l : List Nat} :
specialize le b h
split <;> omega
theorem foldl_max
{α : Type _} [Max α] [Std.IdempotentOp (max : α α α)] [Std.Associative (max : α α α)]
{l : List α} {a : α} :
l.foldl (init := a) max = max a (l.maximum?.getD a) := by
cases l with
| nil => simp [Std.IdempotentOp.idempotent]
| cons b l =>
simp only [maximum?]
induction l generalizing a b with
| nil => simp
| cons c l ih => simp [ih, Std.Associative.assoc]
theorem foldl_max_right {α β : Type _}
[Max β] [Std.IdempotentOp (max : β β β)] [Std.Associative (max : β β β)]
{l : List α} {b : β} {f : α β} :
(l.foldl (init := b) fun acc a => max acc (f a)) = max b ((l.map f).maximum?.getD b) := by
rw [ foldl_map, foldl_max]
theorem le_foldl_max {l : List Nat} {a : Nat} : a l.foldl (init := a) max := by
induction l generalizing a with
| nil => simp
| cons c l ih =>
simp only [foldl_cons]
exact Nat.le_trans (Nat.le_max_left _ _) ih
theorem le_foldl_max_of_le {l : List Nat} {a b : Nat} (h : a b) :
a l.foldl (init := b) max :=
Nat.le_trans h (le_foldl_max)
theorem le_maximum?_getD_of_mem {l : List Nat} {a k : Nat} (h : a l) :
a l.maximum?.getD k := by
cases l with
| nil => simp at h
| cons b l =>
simp [maximum?_cons]
simp at h
rcases h with (rfl | h)
· exact le_foldl_max
· induction l generalizing b with
| nil => simp_all
| cons c l ih =>
simp only [foldl_cons]
simp at h
rcases h with (rfl | h)
· exact le_foldl_max_of_le (Nat.le_max_right b a)
· exact ih _ h
end List

View File

@@ -28,4 +28,59 @@ theorem count_set [BEq α] (a b : α) (l : List α) (i : Nat) (h : i < l.length)
(l.set i a).count b = l.count b - (if l[i] == b then 1 else 0) + (if a == b then 1 else 0) := by
simp [count_eq_countP, countP_set, h]
/--
The number of elements satisfying a predicate in a sublist is at least the number of elements satisfying the predicate in the list,
minus the difference in the lengths.
-/
theorem Sublist.le_countP (s : l₁ <+ l₂) (p) : countP p l₂ - (l₂.length - l₁.length) countP p l₁ := by
match s with
| .slnil => simp
| .cons a s =>
rename_i l
simp only [countP_cons, length_cons]
have := s.le_countP p
have := s.length_le
split <;> omega
| .cons₂ a s =>
rename_i l₁ l₂
simp only [countP_cons, length_cons]
have := s.le_countP p
have := s.length_le
split <;> omega
theorem IsPrefix.le_countP (s : l₁ <+: l₂) : countP p l₂ - (l₂.length - l₁.length) countP p l₁ :=
s.sublist.le_countP _
theorem IsSuffix.le_countP (s : l₁ <:+ l₂) : countP p l₂ - (l₂.length - l₁.length) countP p l₁ :=
s.sublist.le_countP _
theorem IsInfix.le_countP (s : l₁ <:+: l₂) : countP p l₂ - (l₂.length - l₁.length) countP p l₁ :=
s.sublist.le_countP _
/--
The number of elements satisfying a predicate in the tail of a list is
at least one less than the number of elements satisfying the predicate in the list.
-/
theorem le_countP_tail (l) : countP p l - 1 countP p l.tail := by
have := (tail_sublist l).le_countP p
simp only [length_tail] at this
omega
variable [BEq α]
theorem Sublist.le_count (s : l₁ <+ l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) count a l₁ :=
s.le_countP _
theorem IsPrefix.le_count (s : l₁ <+: l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) count a l₁ :=
s.sublist.le_count _
theorem IsSuffix.le_count (s : l₁ <:+ l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) count a l₁ :=
s.sublist.le_count _
theorem IsInfix.le_count (s : l₁ <:+: l₂) (a : α) : count a l₂ - (l₂.length - l₁.length) count a l₁ :=
s.sublist.le_count _
theorem le_count_tail (a : α) (l) : count a l - 1 count a l.tail :=
le_countP_tail _
end List

View File

@@ -0,0 +1,66 @@
/-
Copyright (c) 2024 Kim Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Nat.TakeDrop
import Init.Data.List.Erase
namespace List
theorem getElem?_eraseIdx (l : List α) (i : Nat) (j : Nat) :
(l.eraseIdx i)[j]? = if h : j < i then l[j]? else l[j + 1]? := by
rw [eraseIdx_eq_take_drop_succ, getElem?_append]
split <;> rename_i h
· rw [getElem?_take]
split
· rfl
· simp_all
omega
· rw [getElem?_drop]
split <;> rename_i h'
· simp only [length_take, Nat.min_def, Nat.not_lt] at h
split at h
· omega
· simp_all [getElem?_eq_none]
omega
· simp only [length_take]
simp only [length_take, Nat.min_def, Nat.not_lt] at h
split at h
· congr 1
omega
· rw [getElem?_eq_none, getElem?_eq_none] <;> omega
theorem getElem?_eraseIdx_of_lt (l : List α) (i : Nat) (j : Nat) (h : j < i) :
(l.eraseIdx i)[j]? = l[j]? := by
rw [getElem?_eraseIdx]
simp [h]
theorem getElem?_eraseIdx_of_ge (l : List α) (i : Nat) (j : Nat) (h : i j) :
(l.eraseIdx i)[j]? = l[j + 1]? := by
rw [getElem?_eraseIdx]
simp only [dite_eq_ite, ite_eq_right_iff]
intro h'
omega
theorem getElem_eraseIdx (l : List α) (i : Nat) (j : Nat) (h : j < (l.eraseIdx i).length) :
(l.eraseIdx i)[j] = if h' : j < i then
l[j]'(by have := length_eraseIdx_le l i; omega)
else
l[j + 1]'(by rw [length_eraseIdx] at h; split at h <;> omega) := by
apply Option.some.inj
rw [ getElem?_eq_getElem, getElem?_eraseIdx]
split <;> simp
theorem getElem_eraseIdx_of_lt (l : List α) (i : Nat) (j : Nat) (h : j < (l.eraseIdx i).length) (h' : j < i) :
(l.eraseIdx i)[j] = l[j]'(by have := length_eraseIdx_le l i; omega) := by
rw [getElem_eraseIdx]
simp only [dite_eq_left_iff, Nat.not_lt]
intro h'
omega
theorem getElem_eraseIdx_of_ge (l : List α) (i : Nat) (j : Nat) (h : j < (l.eraseIdx i).length) (h' : i j) :
(l.eraseIdx i)[j] = l[j + 1]'(by rw [length_eraseIdx] at h; split at h <;> omega) := by
rw [getElem_eraseIdx, dif_neg]
omega

View File

@@ -0,0 +1,32 @@
/-
Copyright (c) 2024 Kim Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Nat.Range
import Init.Data.List.Find
namespace List
theorem findIdx?_eq_some_le_of_findIdx?_eq_some {xs : List α} {p q : α Bool} (w : x xs, p x q x) {i : Nat}
(h : xs.findIdx? p = some i) : j, j i xs.findIdx? q = some j := by
simp only [findIdx?_eq_findSome?_enum] at h
rw [findSome?_eq_some_iff] at h
simp only [Option.ite_none_right_eq_some, Option.some.injEq, ite_eq_right_iff, reduceCtorEq,
imp_false, Bool.not_eq_true, Prod.forall, exists_and_right, Prod.exists] at h
obtain h, h₁, b, es, h₂, hb, rfl, h₃ := h
rw [enum_eq_enumFrom, enumFrom_eq_append_iff] at h₂
obtain l₁', l₂', rfl, rfl, h₂ := h₂
rw [eq_comm, enumFrom_eq_cons_iff] at h₂
obtain a, as, rfl, h₂, rfl := h₂
simp only [Nat.zero_add, Prod.mk.injEq] at h₂
obtain rfl, rfl := h₂
simp only [findIdx?_append]
match h : findIdx? q l₁' with
| some j =>
refine j, ?_, by simp
rw [findIdx?_eq_some_iff_findIdx_eq] at h
omega
| none =>
refine l₁'.length, by simp, by simp_all

View File

@@ -109,7 +109,8 @@ theorem range'_eq_append_iff : range' s n = xs ++ ys ↔ ∃ k, k ≤ n ∧ xs =
@[simp] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat Bool} :
(range' s n).find? p = some i p i i range' s n j, s j j < i !p j := by
rw [find?_eq_some]
simp only [Bool.not_eq_true', exists_and_right, mem_range'_1, and_congr_right_iff]
simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, mem_range'_1,
and_congr_right_iff]
simp only [range'_eq_append_iff, eq_comm (a := i :: _), range'_eq_cons_iff]
intro h
constructor
@@ -176,7 +177,7 @@ theorem pairwise_le_range (n : Nat) : Pairwise (· ≤ ·) (range n) :=
theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
apply List.ext_getElem
· simp
· simp (config := { contextual := true }) [ getElem_take, Nat.lt_min]
· simp (config := { contextual := true }) [getElem_take, Nat.lt_min]
theorem nodup_range (n : Nat) : Nodup (range n) := by
simp (config := {decide := true}) only [range_eq_range', nodup_range']
@@ -258,6 +259,9 @@ theorem nodup_iota (n : Nat) : Nodup (iota n) :=
| zero => simp at h
| succ n => simp
@[simp] theorem tail_iota (n : Nat) : (iota n).tail = iota (n - 1) := by
cases n <;> simp
@[simp] theorem reverse_iota : reverse (iota n) = range' 1 n := by
induction n with
| zero => simp
@@ -272,15 +276,15 @@ theorem nodup_iota (n : Nat) : Nodup (iota n) :=
rw [getLast_eq_head_reverse]
simp
theorem find?_iota_eq_none {n : Nat} (p : Nat Bool) :
theorem find?_iota_eq_none {n : Nat} {p : Nat Bool} :
(iota n).find? p = none i, 0 < i i n !p i := by
simp
@[simp] theorem find?_iota_eq_some {n : Nat} {i : Nat} {p : Nat Bool} :
(iota n).find? p = some i p i i iota n j, i < j j n !p j := by
rw [find?_eq_some]
simp only [iota_eq_reverse_range', reverse_eq_append_iff, reverse_cons, append_assoc,
singleton_append, Bool.not_eq_true', exists_and_right, mem_reverse, mem_range'_1,
simp only [iota_eq_reverse_range', reverse_eq_append_iff, reverse_cons, append_assoc, cons_append,
nil_append, Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, mem_reverse, mem_range'_1,
and_congr_right_iff]
intro h
constructor
@@ -354,17 +358,6 @@ theorem map_enumFrom (f : α → β) (n : Nat) (l : List α) :
map (Prod.map id f) (enumFrom n l) = enumFrom n (map f l) := by
induction l generalizing n <;> simp_all
@[simp]
theorem enumFrom_map_fst (n) :
(l : List α), map Prod.fst (enumFrom n l) = range' n l.length
| [] => rfl
| _ :: _ => congrArg (cons _) (enumFrom_map_fst _ _)
@[simp]
theorem enumFrom_map_snd : (n) (l : List α), map Prod.snd (enumFrom n l) = l
| _, [] => rfl
| _, _ :: _ => congrArg (cons _) (enumFrom_map_snd _ _)
theorem snd_mem_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x enumFrom n l) : x.2 l :=
enumFrom_map_snd n l mem_map_of_mem _ h
@@ -387,10 +380,6 @@ theorem mem_enumFrom {x : α} {i j : Nat} {xs : List α} (h : (i, x) ∈ xs.enum
x = xs[i - j]'(by have := le_fst_of_mem_enumFrom h; have := fst_lt_add_of_mem_enumFrom h; omega) :=
le_fst_of_mem_enumFrom h, fst_lt_add_of_mem_enumFrom h, snd_eq_of_mem_enumFrom h
theorem enumFrom_cons' (n : Nat) (x : α) (xs : List α) :
enumFrom n (x :: xs) = (n, x) :: (enumFrom n xs).map (Prod.map (· + 1) id) := by
rw [enumFrom_cons, Nat.add_comm, map_fst_add_enumFrom_eq_enumFrom]
theorem enumFrom_map (n : Nat) (l : List α) (f : α β) :
enumFrom n (l.map f) = (enumFrom n l).map (Prod.map id f) := by
induction l with
@@ -407,22 +396,39 @@ theorem enumFrom_append (xs ys : List α) (n : Nat) :
rw [cons_append, enumFrom_cons, IH, cons_append, enumFrom_cons, length, Nat.add_right_comm,
Nat.add_assoc]
theorem enumFrom_eq_zip_range' (l : List α) {n : Nat} : l.enumFrom n = (range' n l.length).zip l :=
zip_of_prod (enumFrom_map_fst _ _) (enumFrom_map_snd _ _)
theorem enumFrom_eq_cons_iff {l : List α} {n : Nat} :
l.enumFrom n = x :: l' a as, l = a :: as x = (n, a) l' = enumFrom (n + 1) as := by
rw [enumFrom_eq_zip_range', zip_eq_cons_iff]
constructor
· rintro l₁, l₂, h, rfl, rfl
rw [range'_eq_cons_iff] at h
obtain rfl, -, rfl := h
exact x.2, l₂, by simp [enumFrom_eq_zip_range']
· rintro a, as, rfl, rfl, rfl
refine range' (n+1) as.length, as, ?_
simp [enumFrom_eq_zip_range', range'_succ]
@[simp]
theorem unzip_enumFrom_eq_prod (l : List α) {n : Nat} :
(l.enumFrom n).unzip = (range' n l.length, l) := by
simp only [enumFrom_eq_zip_range', unzip_zip, length_range']
theorem enumFrom_eq_append_iff {l : List α} {n : Nat} :
l.enumFrom n = l₁ ++ l₂
l₁' l₂', l = l₁' ++ l₂' l₁ = l₁'.enumFrom n l₂ = l₂'.enumFrom (n + l₁'.length) := by
rw [enumFrom_eq_zip_range', zip_eq_append_iff]
constructor
· rintro w, x, y, z, h, h', rfl, rfl, rfl
rw [range'_eq_append_iff] at h'
obtain k, -, rfl, rfl := h'
simp only [length_range'] at h
obtain rfl := h
refine y, z, rfl, ?_
simp only [enumFrom_eq_zip_range', length_append, true_and]
congr
omega
· rintro l₁', l₂', rfl, rfl, rfl
simp only [enumFrom_eq_zip_range']
refine range' n l₁'.length, range' (n + l₁'.length) l₂'.length, l₁', l₂', ?_
simp [Nat.add_comm]
/-! ### enum -/
theorem enum_cons : (a::as).enum = (0, a) :: as.enumFrom 1 := rfl
theorem enum_cons' (x : α) (xs : List α) :
enum (x :: xs) = (0, x) :: (enum xs).map (Prod.map (· + 1) id) :=
enumFrom_cons' _ _ _
@[simp]
theorem enum_eq_nil {l : List α} : List.enum l = [] l = [] := enumFrom_eq_nil
@@ -448,6 +454,9 @@ theorem getElem_enum (l : List α) (i : Nat) (h : i < l.enum.length) :
l.enum.getLast? = l.getLast?.map fun a => (l.length - 1, a) := by
simp [getLast?_eq_getElem?]
@[simp] theorem tail_enum (l : List α) : (enum l).tail = enumFrom 1 l.tail := by
simp [enum]
theorem mk_mem_enum_iff_getElem? {i : Nat} {x : α} {l : List α} : (i, x) enum l l[i]? = x := by
simp [enum, mk_mem_enumFrom_iff_le_and_getElem?_sub]

View File

@@ -36,23 +36,23 @@ theorem length_take_of_le (h : n ≤ length l) : length (take n l) = n := by sim
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the big list to the small list. -/
theorem getElem_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
theorem getElem_take' (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
L[i] = (L.take j)[i]'(length_take .. Nat.lt_min.mpr hj, hi) :=
getElem_of_eq (take_append_drop j L).symm _ getElem_append ..
getElem_of_eq (take_append_drop j L).symm _ getElem_append_left ..
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the small list to the big list. -/
theorem getElem_take' (L : List α) {j i : Nat} {h : i < (L.take j).length} :
theorem getElem_take (L : List α) {j i : Nat} {h : i < (L.take j).length} :
(L.take j)[i] =
L[i]'(Nat.lt_of_lt_of_le h (length_take_le' _ _)) := by
rw [length_take, Nat.lt_min] at h; rw [getElem_take L _ h.1]
rw [length_take, Nat.lt_min] at h; rw [getElem_take' L _ h.1]
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the big list to the small list. -/
@[deprecated getElem_take (since := "2024-06-12")]
@[deprecated getElem_take' (since := "2024-06-12")]
theorem get_take (L : List α) {i j : Nat} (hi : i < L.length) (hj : i < j) :
get L i, hi = get (L.take j) i, length_take .. Nat.lt_min.mpr hj, hi := by
simp [getElem_take _ hi hj]
simp [getElem_take' _ hi hj]
/-- The `i`-th element of a list coincides with the `i`-th element of any of its prefixes of
length `> i`. Version designed to rewrite from the small list to the big list. -/
@@ -60,7 +60,7 @@ length `> i`. Version designed to rewrite from the small list to the big list. -
theorem get_take' (L : List α) {j i} :
get (L.take j) i =
get L i.1, Nat.lt_of_lt_of_le i.2 (length_take_le' _ _) := by
simp [getElem_take']
simp [getElem_take]
theorem getElem?_take_eq_none {l : List α} {n m : Nat} (h : n m) :
(l.take n)[m]? = none :=
@@ -110,7 +110,7 @@ theorem getLast?_take {l : List α} : (l.take n).getLast? = if n = 0 then none e
theorem getLast_take {l : List α} (h : l.take n []) :
(l.take n).getLast h = l[n - 1]?.getD (l.getLast (by simp_all)) := by
rw [getLast_eq_getElem, getElem_take']
rw [getLast_eq_getElem, getElem_take]
simp [length_take, Nat.min_def]
simp at h
split
@@ -196,7 +196,7 @@ theorem dropLast_take {n : Nat} {l : List α} (h : n < l.length) :
theorem take_prefix_take_left (l : List α) {m n : Nat} (h : m n) : take m l <+: take n l := by
rw [isPrefix_iff]
intro i w
rw [getElem?_take_of_lt, getElem_take', getElem?_eq_getElem]
rw [getElem?_take_of_lt, getElem_take, getElem?_eq_getElem]
simp only [length_take] at w
exact Nat.lt_of_lt_of_le (Nat.lt_of_lt_of_le w (Nat.min_le_left _ _)) h
@@ -219,8 +219,9 @@ dropping the first `i` elements. Version designed to rewrite from the big list t
theorem getElem_drop' (L : List α) {i j : Nat} (h : i + j < L.length) :
L[i + j] = (L.drop i)[j]'(lt_length_drop L h) := by
have : i L.length := Nat.le_trans (Nat.le_add_right _ _) (Nat.le_of_lt h)
rw [getElem_of_eq (take_append_drop i L).symm h, getElem_append_right'] <;>
simp [Nat.min_eq_left this, Nat.add_sub_cancel_left, Nat.le_add_right]
rw [getElem_of_eq (take_append_drop i L).symm h, getElem_append_right]
· simp [Nat.min_eq_left this, Nat.add_sub_cancel_left]
· simp [Nat.min_eq_left this, Nat.le_add_right]
/-- The `i + j`-th element of a list coincides with the `j`-th element of the list obtained by
dropping the first `i` elements. Version designed to rewrite from the big list to the small list. -/
@@ -267,9 +268,9 @@ theorem mem_take_iff_getElem {l : List α} {a : α} :
constructor
· rintro i, hm, rfl
simp at hm
refine i, by omega, by rw [getElem_take']
refine i, by omega, by rw [getElem_take]
· rintro i, hm, rfl
refine i, by simpa, by rw [getElem_take']
refine i, by simpa, by rw [getElem_take]
theorem mem_drop_iff_getElem {l : List α} {a : α} :
a l.drop n (i : Nat) (hm : i + n < l.length), l[n + i] = a := by
@@ -478,7 +479,7 @@ theorem false_of_mem_take_findIdx {xs : List α} {p : α → Bool} (h : x ∈ xs
· simp only [take_succ_cons, findIdx?_cons]
split
· simp
· simp [ih, Option.guard_comp]
· simp [ih, Option.guard_comp, Option.bind_map]
@[simp] theorem min_findIdx_findIdx {xs : List α} {p q : α Bool} :
min (xs.findIdx p) (xs.findIdx q) = xs.findIdx (fun a => p a || q a) := by

View File

@@ -5,6 +5,7 @@ Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, M
-/
prelude
import Init.Data.List.Pairwise
import Init.Data.List.Zip
/-!
# Lemmas about `List.range` and `List.enum`
@@ -35,11 +36,16 @@ theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step)
theorem range'_ne_nil (s : Nat) {n : Nat} : range' s n [] n 0 := by
cases n <;> simp
@[simp] theorem range'_zero : range' s 0 = [] := by
@[simp] theorem range'_zero : range' s 0 step = [] := by
simp
@[simp] theorem range'_one {s step : Nat} : range' s 1 step = [s] := rfl
@[simp] theorem tail_range' (n : Nat) : (range' s n step).tail = range' (s + step) (n - 1) step := by
cases n with
| zero => simp
| succ n => simp [range'_succ]
@[simp] theorem range'_inj : range' s n = range' s' n' n = n' (n = 0 s = s') := by
constructor
· intro h
@@ -153,6 +159,9 @@ theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) :=
theorem range_ne_nil {n : Nat} : range n [] n 0 := by
cases n <;> simp
@[simp] theorem tail_range (n : Nat) : (range n).tail = range' 1 (n - 1) := by
rw [range_eq_range', tail_range']
@[simp]
theorem range_sublist {m n : Nat} : range m <+ range n m n := by
simp only [range_eq_range', range'_sublist_right]
@@ -219,6 +228,12 @@ theorem getElem_enumFrom (l : List α) (n) (i : Nat) (h : i < (l.enumFrom n).len
simp only [getElem?_enumFrom, getElem?_eq_getElem h]
simp
@[simp]
theorem tail_enumFrom (l : List α) (n : Nat) : (enumFrom n l).tail = enumFrom (n + 1) l.tail := by
induction l generalizing n with
| nil => simp
| cons _ l ih => simp [ih, enumFrom_cons]
theorem map_fst_add_enumFrom_eq_enumFrom (l : List α) (n k : Nat) :
map (Prod.map (· + n) id) (enumFrom k l) = enumFrom (n + k) l :=
ext_getElem? fun i by simp [(· ·), Nat.add_comm, Nat.add_left_comm]; rfl
@@ -227,4 +242,47 @@ theorem map_fst_add_enum_eq_enumFrom (l : List α) (n : Nat) :
map (Prod.map (· + n) id) (enum l) = enumFrom n l :=
map_fst_add_enumFrom_eq_enumFrom l _ _
theorem enumFrom_cons' (n : Nat) (x : α) (xs : List α) :
enumFrom n (x :: xs) = (n, x) :: (enumFrom n xs).map (Prod.map (· + 1) id) := by
rw [enumFrom_cons, Nat.add_comm, map_fst_add_enumFrom_eq_enumFrom]
@[simp]
theorem enumFrom_map_fst (n) :
(l : List α), map Prod.fst (enumFrom n l) = range' n l.length
| [] => rfl
| _ :: _ => congrArg (cons _) (enumFrom_map_fst _ _)
@[simp]
theorem enumFrom_map_snd : (n) (l : List α), map Prod.snd (enumFrom n l) = l
| _, [] => rfl
| _, _ :: _ => congrArg (cons _) (enumFrom_map_snd _ _)
theorem enumFrom_eq_zip_range' (l : List α) {n : Nat} : l.enumFrom n = (range' n l.length).zip l :=
zip_of_prod (enumFrom_map_fst _ _) (enumFrom_map_snd _ _)
@[simp]
theorem unzip_enumFrom_eq_prod (l : List α) {n : Nat} :
(l.enumFrom n).unzip = (range' n l.length, l) := by
simp only [enumFrom_eq_zip_range', unzip_zip, length_range']
/-! ### enum -/
theorem enum_cons : (a::as).enum = (0, a) :: as.enumFrom 1 := rfl
theorem enum_cons' (x : α) (xs : List α) :
enum (x :: xs) = (0, x) :: (enum xs).map (Prod.map (· + 1) id) :=
enumFrom_cons' _ _ _
theorem enum_eq_enumFrom {l : List α} : l.enum = l.enumFrom 0 := rfl
theorem enumFrom_eq_map_enum (l : List α) (n : Nat) :
enumFrom n l = (enum l).map (Prod.map (· + n) id) := by
induction l generalizing n with
| nil => simp
| cons x xs ih =>
simp only [enumFrom_cons, ih, enum_cons, map_cons, Prod.map_apply, Nat.zero_add, id_eq, map_map,
cons.injEq, map_inj_left, Function.comp_apply, Prod.forall, Prod.mk.injEq, and_true, true_and]
intro a b _
exact (succ_add a n).symm
end List

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
Authors: Kim Morrison, Eric Wieser, François G. Dorais
-/
prelude
import Init.Data.List.Perm
@@ -114,31 +114,40 @@ theorem enumLE_trans (trans : ∀ a b c, le a b → le b c → le a c)
· simp_all
· simp_all
theorem enumLE_total (total : a b, !le a b le b a)
(a b : Nat × α) : !enumLE le a b enumLE le b a := by
theorem enumLE_total (total : a b, le a b || le b a)
(a b : Nat × α) : enumLE le a b || enumLE le b a := by
simp only [enumLE]
split <;> split
· simpa using Nat.le_of_lt
· simpa using Nat.le_total a.fst b.fst
· simp
· simp
· simp_all [total a.2 b.2]
· have := total a.2 b.2
simp_all
/-! ### merge -/
theorem merge_stable : (xs ys) (_ : x y, x xs y ys x.1 y.1),
(merge xs ys (enumLE le)).map (·.2) = merge (xs.map (·.2)) (ys.map (·.2)) le
| [], ys, _ => by simp [merge]
| xs, [], _ => by simp [merge]
| (i, x) :: xs, (j, y) :: ys, h => by
simp only [merge, enumLE, map_cons]
split <;> rename_i w
· rw [if_pos (by simp [h _ _ (mem_cons_self ..) (mem_cons_self ..)])]
simp only [map_cons, cons.injEq, true_and]
rw [merge_stable, map_cons]
exact fun x' y' mx my => h x' y' (mem_cons_of_mem (i, x) mx) my
· simp only [reduceIte, map_cons, cons.injEq, true_and, reduceCtorEq]
rw [merge_stable, map_cons]
exact fun x' y' mx my => h x' y' mx (mem_cons_of_mem (j, y) my)
theorem cons_merge_cons (s : α α Bool) (a b l r) :
merge (a::l) (b::r) s = if s a b then a :: merge l (b::r) s else b :: merge (a::l) r s := by
simp only [merge]
@[simp] theorem cons_merge_cons_pos (s : α α Bool) (l r) (h : s a b) :
merge (a::l) (b::r) s = a :: merge l (b::r) s := by
rw [cons_merge_cons, if_pos h]
@[simp] theorem cons_merge_cons_neg (s : α α Bool) (l r) (h : ¬ s a b) :
merge (a::l) (b::r) s = b :: merge (a::l) r s := by
rw [cons_merge_cons, if_neg h]
@[simp] theorem length_merge (s : α α Bool) (l r) :
(merge l r s).length = l.length + r.length := by
match l, r with
| [], r => simp
| l, [] => simp
| a::l, b::r =>
rw [cons_merge_cons]
split
· simp_arith [length_merge s l (b::r)]
· simp_arith [length_merge s (a::l) r]
/--
The elements of `merge le xs ys` are exactly the elements of `xs` and `ys`.
@@ -158,16 +167,37 @@ theorem mem_merge {a : α} {xs ys : List α} : a ∈ merge xs ys le ↔ a ∈ xs
apply or_congr_left
simp only [or_comm (a := a = y), or_assoc]
theorem mem_merge_left (s : α α Bool) (h : x l) : x merge l r s :=
mem_merge.2 <| .inl h
theorem mem_merge_right (s : α α Bool) (h : x r) : x merge l r s :=
mem_merge.2 <| .inr h
theorem merge_stable : (xs ys) (_ : x y, x xs y ys x.1 y.1),
(merge xs ys (enumLE le)).map (·.2) = merge (xs.map (·.2)) (ys.map (·.2)) le
| [], ys, _ => by simp [merge]
| xs, [], _ => by simp [merge]
| (i, x) :: xs, (j, y) :: ys, h => by
simp only [merge, enumLE, map_cons]
split <;> rename_i w
· rw [if_pos (by simp [h _ _ (mem_cons_self ..) (mem_cons_self ..)])]
simp only [map_cons, cons.injEq, true_and]
rw [merge_stable, map_cons]
exact fun x' y' mx my => h x' y' (mem_cons_of_mem (i, x) mx) my
· simp only [reduceIte, map_cons, cons.injEq, true_and, reduceCtorEq]
rw [merge_stable, map_cons]
exact fun x' y' mx my => h x' y' mx (mem_cons_of_mem (j, y) my)
-- We enable this instance locally so we can write `Pairwise le` instead of `Pairwise (le · ·)` everywhere.
attribute [local instance] boolRelToRel
/--
If the ordering relation `le` is transitive and total (i.e. `le a b le b a` for all `a, b`)
If the ordering relation `le` is transitive and total (i.e. `le a b || le b a` for all `a, b`)
then the `merge` of two sorted lists is sorted.
-/
theorem sorted_merge
(trans : (a b c : α), le a b le b c le a c)
(total : (a b : α), !le a b le b a)
(total : (a b : α), le a b || le b a)
(l₁ l₂ : List α) (h₁ : l₁.Pairwise le) (h₂ : l₂.Pairwise le) : (merge l₁ l₂ le).Pairwise le := by
induction l₁ generalizing l₂ with
| nil => simpa only [merge]
@@ -188,9 +218,10 @@ theorem sorted_merge
· apply Pairwise.cons
· intro z m
rw [mem_merge, mem_cons] at m
simp only [Bool.not_eq_true] at h
rcases m with (rfl|m|m)
· exact total _ _ (by simpa using h)
· exact trans _ _ _ (total _ _ (by simpa using h)) (rel_of_pairwise_cons h₁ m)
· simpa [h] using total y z
· exact trans _ _ _ (by simpa [h] using total x y) (rel_of_pairwise_cons h₁ m)
· exact rel_of_pairwise_cons h₂ m
· exact ih₂ h₂.tail
@@ -234,7 +265,7 @@ theorem mergeSort_perm : ∀ (l : List α) (le), mergeSort l le ~ l
(Perm.of_eq (splitInTwo_fst_append_splitInTwo_snd _)))
termination_by l => l.length
@[simp] theorem mergeSort_length (l : List α) : (mergeSort l le).length = l.length :=
@[simp] theorem length_mergeSort (l : List α) : (mergeSort l le).length = l.length :=
(mergeSort_perm l le).length_eq
@[simp] theorem mem_mergeSort {a : α} {l : List α} : a mergeSort l le a l :=
@@ -243,13 +274,13 @@ termination_by l => l.length
/--
The result of `mergeSort` is sorted,
as long as the comparison function is transitive (`le a b → le b c → le a c`)
and total in the sense that `le a b le b a`.
and total in the sense that `le a b || le b a`.
The comparison function need not be irreflexive, i.e. `le a b` and `le b a` is allowed even when `a ≠ b`.
-/
theorem sorted_mergeSort
(trans : (a b c : α), le a b le b c le a c)
(total : (a b : α), !le a b le b a) :
(total : (a b : α), le a b || le b a) :
(l : List α) (mergeSort l le).Pairwise le
| [] => by simp [mergeSort]
| [a] => by simp [mergeSort]
@@ -317,7 +348,7 @@ termination_by _ l => l.length
theorem mergeSort_cons {le : α α Bool}
(trans : (a b c : α), le a b le b c le a c)
(total : (a b : α), !le a b le b a)
(total : (a b : α), le a b || le b a)
(a : α) (l : List α) :
l₁ l₂, mergeSort (a :: l) le = l₁ ++ a :: l₂ mergeSort l le = l₁ ++ l₂
b, b l₁ !le a b := by
@@ -376,7 +407,7 @@ then `c` is still a sublist of `mergeSort le l`.
-/
theorem sublist_mergeSort
(trans : (a b c : α), le a b le b c le a c)
(total : (a b : α), !le a b le b a) :
(total : (a b : α), le a b || le b a) :
{c : List α} (_ : c.Pairwise le) (_ : c <+ l),
c <+ mergeSort l le
| _, _, .slnil => nil_sublist _
@@ -407,8 +438,45 @@ then `[a, b]` is still a sublist of `mergeSort le l`.
-/
theorem pair_sublist_mergeSort
(trans : (a b c : α), le a b le b c le a c)
(total : (a b : α), !le a b le b a)
(total : (a b : α), le a b || le b a)
(hab : le a b) (h : [a, b] <+ l) : [a, b] <+ mergeSort l le :=
sublist_mergeSort trans total (pairwise_pair.mpr hab) h
@[deprecated (since := "2024-09-02")] abbrev mergeSort_stable_pair := @pair_sublist_mergeSort
theorem map_merge {f : α β} {r : α α Bool} {s : β β Bool} {l l' : List α}
(hl : a l, b l', r a b = s (f a) (f b)) :
(l.merge l' r).map f = (l.map f).merge (l'.map f) s := by
match l, l' with
| [], x' => simp
| x, [] => simp
| x :: xs, x' :: xs' =>
simp only [List.forall_mem_cons] at hl
simp only [forall_and] at hl
simp only [List.map, List.cons_merge_cons]
rw [ hl.1.1]
split
· rw [List.map, map_merge, List.map]
simp only [List.forall_mem_cons, forall_and]
exact hl.2.1, hl.2.2
· rw [List.map, map_merge, List.map]
simp only [List.forall_mem_cons]
exact hl.1.2, hl.2.2
theorem map_mergeSort {r : α α Bool} {s : β β Bool} {f : α β} {l : List α}
(hl : a l, b l, r a b = s (f a) (f b)) :
(l.mergeSort r).map f = (l.map f).mergeSort s :=
match l with
| [] => by simp
| [x] => by simp
| a :: b :: l => by
simp only [mergeSort, splitInTwo_fst, splitInTwo_snd, map_cons]
rw [map_merge (fun a am b bm => hl a (mem_of_mem_take (by simpa using am))
b (mem_of_mem_drop (by simpa using bm)))]
rw [map_mergeSort (s := s) (fun a am b bm => hl a (mem_of_mem_take (by simpa using am))
b (mem_of_mem_take (by simpa using bm)))]
rw [map_mergeSort (s := s) (fun a am b bm => hl a (mem_of_mem_drop (by simpa using am))
b (mem_of_mem_drop (by simpa using bm)))]
rw [map_take, map_drop]
simp
termination_by length l

View File

@@ -667,7 +667,7 @@ theorem IsSuffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length :=
theorem IsPrefix.getElem {x y : List α} (h : x <+: y) {n} (hn : n < x.length) :
x[n] = y[n]'(Nat.le_trans hn h.length_le) := by
obtain _, rfl := h
exact (List.getElem_append n hn).symm
exact (List.getElem_append_left hn).symm
-- See `Init.Data.List.Nat.Sublist` for `IsSuffix.getElem`.

View File

@@ -16,83 +16,6 @@ open Nat
/-! ## Zippers -/
/-! ### zip -/
theorem zip_map (f : α γ) (g : β δ) :
(l₁ : List α) (l₂ : List β), zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g)
| [], l₂ => rfl
| l₁, [] => by simp only [map, zip_nil_right]
| a :: l₁, b :: l₂ => by
simp only [map, zip_cons_cons, zip_map, Prod.map]; constructor
theorem zip_map_left (f : α γ) (l₁ : List α) (l₂ : List β) :
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [ zip_map, map_id]
theorem zip_map_right (f : β γ) (l₁ : List α) (l₂ : List β) :
zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [ zip_map, map_id]
theorem zip_append :
{l₁ r₁ : List α} {l₂ r₂ : List β} (_h : length l₁ = length l₂),
zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂
| [], r₁, l₂, r₂, h => by simp only [eq_nil_of_length_eq_zero h.symm]; rfl
| l₁, r₁, [], r₂, h => by simp only [eq_nil_of_length_eq_zero h]; rfl
| a :: l₁, r₁, b :: l₂, r₂, h => by
simp only [cons_append, zip_cons_cons, zip_append (Nat.succ.inj h)]
theorem zip_map' (f : α β) (g : α γ) :
l : List α, zip (l.map f) (l.map g) = l.map fun a => (f a, g a)
| [] => rfl
| a :: l => by simp only [map, zip_cons_cons, zip_map']
theorem of_mem_zip {a b} : {l₁ : List α} {l₂ : List β}, (a, b) zip l₁ l₂ a l₁ b l₂
| _ :: l₁, _ :: l₂, h => by
cases h
case head => simp
case tail h =>
· have := of_mem_zip h
exact Mem.tail _ this.1, Mem.tail _ this.2
@[deprecated of_mem_zip (since := "2024-07-28")] abbrev mem_zip := @of_mem_zip
theorem map_fst_zip :
(l₁ : List α) (l₂ : List β), l₁.length l₂.length map Prod.fst (zip l₁ l₂) = l₁
| [], bs, _ => rfl
| _ :: as, _ :: bs, h => by
simp [Nat.succ_le_succ_iff] at h
show _ :: map Prod.fst (zip as bs) = _ :: as
rw [map_fst_zip as bs h]
| a :: as, [], h => by simp at h
theorem map_snd_zip :
(l₁ : List α) (l₂ : List β), l₂.length l₁.length map Prod.snd (zip l₁ l₂) = l₂
| _, [], _ => by
rw [zip_nil_right]
rfl
| [], b :: bs, h => by simp at h
| a :: as, b :: bs, h => by
simp [Nat.succ_le_succ_iff] at h
show _ :: map Prod.snd (zip as bs) = _ :: bs
rw [map_snd_zip as bs h]
theorem map_prod_left_eq_zip {l : List α} (f : α β) :
(l.map fun x => (x, f x)) = l.zip (l.map f) := by
rw [ zip_map']
congr
simp
theorem map_prod_right_eq_zip {l : List α} (f : α β) :
(l.map fun x => (f x, x)) = (l.map f).zip l := by
rw [ zip_map']
congr
simp
/-- See also `List.zip_replicate` in `Init.Data.List.TakeDrop` for a generalization with different lengths. -/
@[simp] theorem zip_replicate' {a : α} {b : β} {n : Nat} :
zip (replicate n a) (replicate n b) = replicate n (a, b) := by
induction n with
| zero => rfl
| succ n ih => simp [replicate_succ, ih]
/-! ### zipWith -/
theorem zipWith_comm (f : α β γ) :
@@ -229,6 +152,7 @@ theorem drop_zipWith : (zipWith f l l').drop n = zipWith f (l.drop n) (l'.drop n
@[deprecated drop_zipWith (since := "2024-07-26")] abbrev zipWith_distrib_drop := @drop_zipWith
@[simp]
theorem tail_zipWith : (zipWith f l l').tail = zipWith f l.tail l'.tail := by
rw [ drop_one]; simp [drop_zipWith]
@@ -248,6 +172,65 @@ theorem zipWith_append (f : α → β → γ) (l la : List α) (l' lb : List β)
simp only [length_cons, Nat.succ.injEq] at h
simp [ih _ h]
theorem zipWith_eq_cons_iff {f : α β γ} {l₁ : List α} {l₂ : List β} :
zipWith f l₁ l₂ = g :: l
a l₁' b l₂', l₁ = a :: l₁' l₂ = b :: l₂' g = f a b l = zipWith f l₁' l₂' := by
match l₁, l₂ with
| [], [] => simp
| [], b :: l₂ => simp
| a :: l₁, [] => simp
| a' :: l₁, b' :: l₂ =>
simp only [zip_cons_cons, cons.injEq, Prod.mk.injEq]
constructor
· rintro rfl, rfl, rfl
refine a', l₁, b', l₂, by simp
· rintro a, l₁, b, l₂, rfl, rfl, rfl, rfl, rfl, rfl
simp
theorem zipWith_eq_append_iff {f : α β γ} {l₁ : List α} {l₂ : List β} :
zipWith f l₁ l₂ = l₁' ++ l₂'
w x y z, w.length = y.length l₁ = w ++ x l₂ = y ++ z l₁' = zipWith f w y l₂' = zipWith f x z := by
induction l₁ generalizing l₂ l₁' with
| nil =>
simp
constructor
· rintro rfl, rfl
exact [], [], [], by simp
· rintro _, _, _, -, rfl, rfl, _, rfl, rfl, rfl
simp
| cons x₁ l₁ ih₁ =>
cases l₂ with
| nil =>
constructor
· simp only [zipWith_nil_right, nil_eq, append_eq_nil, exists_and_left, and_imp]
rintro rfl rfl
exact [], x₁ :: l₁, [], by simp
· rintro w, x, y, z, h₁, _, h₃, rfl, rfl
simp only [nil_eq, append_eq_nil] at h₃
obtain rfl, rfl := h₃
simp
| cons x₂ l₂ =>
simp only [zipWith_cons_cons]
rw [cons_eq_append_iff]
constructor
· rintro (rfl, rfl | l₁'', rfl, h)
· exact [], x₁ :: l₁, [], x₂ :: l₂, by simp
· rw [ih₁] at h
obtain w, x, y, z, h, rfl, rfl, h', rfl := h
refine x₁ :: w, x, x₂ :: y, z, by simp [h, h']
· rintro w, x, y, z, h₁, h₂, h₃, rfl, rfl
rw [cons_eq_append_iff] at h₂
rw [cons_eq_append_iff] at h₃
obtain (rfl, rfl | w', rfl, rfl) := h₂
· simp only [zipWith_nil_left, true_and, nil_eq, reduceCtorEq, false_and, exists_const,
or_false]
obtain (rfl, rfl | y', rfl, rfl) := h₃
· simp
· simp_all
· obtain (rfl, rfl | y', rfl, rfl) := h₃
· simp_all
· simp_all [zipWith_append, Nat.succ_inj']
/-- See also `List.zipWith_replicate` in `Init.Data.List.TakeDrop` for a generalization with different lengths. -/
@[simp] theorem zipWith_replicate' {a : α} {b : β} {n : Nat} :
zipWith f (replicate n a) (replicate n b) = replicate n (f a b) := by
@@ -255,6 +238,113 @@ theorem zipWith_append (f : α → β → γ) (l la : List α) (l' lb : List β)
| zero => rfl
| succ n ih => simp [replicate_succ, ih]
/-! ### zip -/
theorem zip_eq_zipWith : (l₁ : List α) (l₂ : List β), zip l₁ l₂ = zipWith Prod.mk l₁ l₂
| [], _ => rfl
| _, [] => rfl
| a :: l₁, b :: l₂ => by simp [zip_cons_cons, zip_eq_zipWith l₁ l₂]
theorem zip_map (f : α γ) (g : β δ) :
(l₁ : List α) (l₂ : List β), zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g)
| [], l₂ => rfl
| l₁, [] => by simp only [map, zip_nil_right]
| a :: l₁, b :: l₂ => by
simp only [map, zip_cons_cons, zip_map, Prod.map]; constructor
theorem zip_map_left (f : α γ) (l₁ : List α) (l₂ : List β) :
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [ zip_map, map_id]
theorem zip_map_right (f : β γ) (l₁ : List α) (l₂ : List β) :
zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [ zip_map, map_id]
@[simp] theorem tail_zip (l₁ : List α) (l₂ : List β) :
(zip l₁ l₂).tail = zip l₁.tail l₂.tail := by
cases l₁ <;> cases l₂ <;> simp
theorem zip_append :
{l₁ r₁ : List α} {l₂ r₂ : List β} (_h : length l₁ = length l₂),
zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂
| [], r₁, l₂, r₂, h => by simp only [eq_nil_of_length_eq_zero h.symm]; rfl
| l₁, r₁, [], r₂, h => by simp only [eq_nil_of_length_eq_zero h]; rfl
| a :: l₁, r₁, b :: l₂, r₂, h => by
simp only [cons_append, zip_cons_cons, zip_append (Nat.succ.inj h)]
theorem zip_map' (f : α β) (g : α γ) :
l : List α, zip (l.map f) (l.map g) = l.map fun a => (f a, g a)
| [] => rfl
| a :: l => by simp only [map, zip_cons_cons, zip_map']
theorem of_mem_zip {a b} : {l₁ : List α} {l₂ : List β}, (a, b) zip l₁ l₂ a l₁ b l₂
| _ :: l₁, _ :: l₂, h => by
cases h
case head => simp
case tail h =>
· have := of_mem_zip h
exact Mem.tail _ this.1, Mem.tail _ this.2
@[deprecated of_mem_zip (since := "2024-07-28")] abbrev mem_zip := @of_mem_zip
theorem map_fst_zip :
(l₁ : List α) (l₂ : List β), l₁.length l₂.length map Prod.fst (zip l₁ l₂) = l₁
| [], bs, _ => rfl
| _ :: as, _ :: bs, h => by
simp [Nat.succ_le_succ_iff] at h
show _ :: map Prod.fst (zip as bs) = _ :: as
rw [map_fst_zip as bs h]
| a :: as, [], h => by simp at h
theorem map_snd_zip :
(l₁ : List α) (l₂ : List β), l₂.length l₁.length map Prod.snd (zip l₁ l₂) = l₂
| _, [], _ => by
rw [zip_nil_right]
rfl
| [], b :: bs, h => by simp at h
| a :: as, b :: bs, h => by
simp [Nat.succ_le_succ_iff] at h
show _ :: map Prod.snd (zip as bs) = _ :: bs
rw [map_snd_zip as bs h]
theorem map_prod_left_eq_zip {l : List α} (f : α β) :
(l.map fun x => (x, f x)) = l.zip (l.map f) := by
rw [ zip_map']
congr
simp
theorem map_prod_right_eq_zip {l : List α} (f : α β) :
(l.map fun x => (f x, x)) = (l.map f).zip l := by
rw [ zip_map']
congr
simp
@[simp] theorem zip_eq_nil_iff {l₁ : List α} {l₂ : List β} :
zip l₁ l₂ = [] l₁ = [] l₂ = [] := by
simp [zip_eq_zipWith]
theorem zip_eq_cons_iff {l₁ : List α} {l₂ : List β} :
zip l₁ l₂ = (a, b) :: l
l₁' l₂', l₁ = a :: l₁' l₂ = b :: l₂' l = zip l₁' l₂' := by
simp only [zip_eq_zipWith, zipWith_eq_cons_iff]
constructor
· rintro a, l₁, b, l₂, rfl, rfl, h, rfl, rfl
simp only [Prod.mk.injEq] at h
obtain rfl, rfl := h
simp
· rintro l₁', l₂', rfl, rfl, rfl
refine a, l₁', b, l₂', by simp
theorem zip_eq_append_iff {l₁ : List α} {l₂ : List β} :
zip l₁ l₂ = l₁' ++ l₂'
w x y z, w.length = y.length l₁ = w ++ x l₂ = y ++ z l₁' = zip w y l₂' = zip x z := by
simp [zip_eq_zipWith, zipWith_eq_append_iff]
/-- See also `List.zip_replicate` in `Init.Data.List.TakeDrop` for a generalization with different lengths. -/
@[simp] theorem zip_replicate' {a : α} {b : β} {n : Nat} :
zip (replicate n a) (replicate n b) = replicate n (a, b) := by
induction n with
| zero => rfl
| succ n ih => simp [replicate_succ, ih]
/-! ### zipWithAll -/
theorem getElem?_zipWithAll {f : Option α Option β γ} {i : Nat} :
@@ -284,12 +374,16 @@ theorem head?_zipWithAll {f : Option α → Option β → γ} :
| none, none => .none | a?, b? => some (f a? b?) := by
simp [head?_eq_getElem?, getElem?_zipWithAll]
theorem head_zipWithAll {f : Option α Option β γ} (h) :
@[simp] theorem head_zipWithAll {f : Option α Option β γ} (h) :
(zipWithAll f as bs).head h = f as.head? bs.head? := by
apply Option.some.inj
rw [ head?_eq_head, head?_zipWithAll]
split <;> simp_all
@[simp] theorem tail_zipWithAll {f : Option α Option β γ} :
(zipWithAll f as bs).tail = zipWithAll f as.tail bs.tail := by
cases as <;> cases bs <;> simp
theorem zipWithAll_map {μ} (f : Option γ Option δ μ) (g : α γ) (h : β δ) (l₁ : List α) (l₂ : List β) :
zipWithAll f (l₁.map g) (l₂.map h) = zipWithAll (fun a b => f (g <$> a) (h <$> b)) l₁ l₂ := by
induction l₁ generalizing l₂ <;> cases l₂ <;> simp_all
@@ -358,6 +452,12 @@ theorem zip_of_prod {l : List α} {l' : List β} {lp : List (α × β)} (hl : lp
(hr : lp.map Prod.snd = l') : lp = l.zip l' := by
rw [ hl, hr, zip_unzip lp, unzip_fst, unzip_snd, zip_unzip, zip_unzip]
theorem tail_zip_fst {l : List (α × β)} : l.unzip.1.tail = l.tail.unzip.1 := by
simp
theorem tail_zip_snd {l : List (α × β)} : l.unzip.2.tail = l.tail.unzip.2 := by
simp
@[simp] theorem unzip_replicate {n : Nat} {a : α} {b : β} :
unzip (replicate n (a, b)) = (replicate n a, replicate n b) := by
ext1 <;> simp

View File

@@ -514,6 +514,10 @@ protected theorem add_lt_add_left {n m : Nat} (h : n < m) (k : Nat) : k + n < k
protected theorem add_lt_add_right {n m : Nat} (h : n < m) (k : Nat) : n + k < m + k :=
Nat.add_comm k m Nat.add_comm k n Nat.add_lt_add_left h k
protected theorem lt_add_of_pos_left (h : 0 < k) : n < k + n := by
rw [Nat.add_comm]
exact Nat.add_lt_add_left h n
protected theorem lt_add_of_pos_right (h : 0 < k) : n < n + k :=
Nat.add_lt_add_left h n
@@ -718,7 +722,7 @@ protected theorem zero_ne_one : 0 ≠ (1 : Nat) :=
theorem succ_ne_zero (n : Nat) : succ n 0 := by simp
instance {n : Nat} : NeZero (succ n) := succ_ne_zero n
instance instNeZeroSucc {n : Nat} : NeZero (n + 1) := succ_ne_zero n
/-! # mul + order -/

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Data.Nat.Bitwise.Basic

View File

@@ -36,7 +36,7 @@ private theorem two_mul_sub_one {n : Nat} (n_pos : n > 0) : (2*n - 1) % 2 = 1 :=
/-! ### Preliminaries -/
/--
An induction principal that works on divison by two.
An induction principal that works on division by two.
-/
noncomputable def div2Induction {motive : Nat Sort u}
(n : Nat) (ind : (n : Nat), (n > 0 motive (n/2)) motive n) : motive n := by
@@ -226,18 +226,18 @@ private theorem succ_mod_two : succ x % 2 = 1 - x % 2 := by
simp [Nat.mod_eq (x+2) 2, p, hyp]
cases Nat.mod_two_eq_zero_or_one x with | _ p => simp [p]
private theorem testBit_succ_zero : testBit (x + 1) 0 = not (testBit x 0) := by
private theorem testBit_succ_zero : testBit (x + 1) 0 = !(testBit x 0) := by
simp [testBit_to_div_mod, succ_mod_two]
cases Nat.mod_two_eq_zero_or_one x with | _ p =>
simp [p]
theorem testBit_two_pow_add_eq (x i : Nat) : testBit (2^i + x) i = not (testBit x i) := by
theorem testBit_two_pow_add_eq (x i : Nat) : testBit (2^i + x) i = !(testBit x i) := by
simp [testBit_to_div_mod, add_div_left, Nat.two_pow_pos, succ_mod_two]
cases mod_two_eq_zero_or_one (x / 2 ^ i) with
| _ p => simp [p]
theorem testBit_mul_two_pow_add_eq (a b i : Nat) :
testBit (2^i*a + b) i = Bool.xor (a%2 = 1) (testBit b i) := by
testBit (2^i*a + b) i = (a%2 = 1 ^^ testBit b i) := by
match a with
| 0 => simp
| a+1 =>
@@ -570,7 +570,7 @@ theorem or_div_two : (a ||| b) / 2 = a / 2 ||| b / 2 := by
/-! ### xor -/
@[simp] theorem testBit_xor (x y i : Nat) :
(x ^^^ y).testBit i = Bool.xor (x.testBit i) (y.testBit i) := by
(x ^^^ y).testBit i = ((x.testBit i) ^^ (y.testBit i)) := by
simp [HXor.hXor, Xor.xor, xor, testBit_bitwise ]
@[simp] theorem zero_xor (x : Nat) : 0 ^^^ x = x := by

View File

@@ -84,7 +84,7 @@ decreasing_by apply div_rec_lemma; assumption
protected def mod : @& Nat @& Nat Nat
/-
Nat.modCore is defined by well-founded recursion and thus irreducible. Nevertheless it is
desireable if trivial `Nat.mod` calculations, namely
desirable if trivial `Nat.mod` calculations, namely
* `Nat.mod 0 m` for all `m`
* `Nat.mod n (m+n)` for concrete literals `n`
reduce definitionally.
@@ -134,6 +134,19 @@ theorem mod_eq_of_lt {a b : Nat} (h : a < b) : a % b = a :=
if_neg h'
(mod_eq a b).symm this
@[simp] theorem one_mod_eq_zero_iff {n : Nat} : 1 % n = 0 n = 1 := by
match n with
| 0 => simp
| 1 => simp
| n + 2 =>
rw [mod_eq_of_lt (by exact Nat.lt_of_sub_eq_succ rfl)]
simp only [add_one_ne_zero, false_iff, ne_eq]
exact ne_of_beq_eq_false rfl
@[simp] theorem Nat.zero_eq_one_mod_iff {n : Nat} : 0 = 1 % n n = 1 := by
rw [eq_comm]
simp
theorem mod_eq_sub_mod {a b : Nat} (h : a b) : a % b = (a - b) % b :=
match eq_zero_or_pos b with
| Or.inl h₁ => h₁.symm (Nat.sub_zero a).symm rfl
@@ -157,6 +170,13 @@ theorem mod_lt (x : Nat) {y : Nat} : y > 0 → x % y < y := by
rw [mod_eq_sub_mod h₁]
exact h₂ h₃
@[simp] protected theorem sub_mod_add_mod_cancel (a b : Nat) [NeZero a] : a - b % a + b % a = a := by
rw [Nat.sub_add_cancel]
cases a with
| zero => simp_all
| succ a =>
exact Nat.le_of_lt (mod_lt b (zero_lt_succ a))
theorem mod_le (x y : Nat) : x % y x := by
match Nat.lt_or_ge x y with
| Or.inl h₁ => rw [mod_eq_of_lt h₁]; apply Nat.le_refl
@@ -197,7 +217,6 @@ decreasing_by apply div_rec_lemma; assumption
theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b a) : a / b = (a - b) / b + 1 := by
rw [div_eq a, if_pos]; constructor <;> assumption
theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by
induction m, k using mod.inductionOn with rw [div_eq, mod_eq]
| base x y h => simp [h]

View File

@@ -84,9 +84,6 @@ protected theorem add_lt_add_of_lt_of_le {a b c d : Nat} (hlt : a < b) (hle : c
a + c < b + d :=
Nat.lt_of_le_of_lt (Nat.add_le_add_left hle _) (Nat.add_lt_add_right hlt _)
protected theorem lt_add_of_pos_left : 0 < k n < k + n := by
rw [Nat.add_comm]; exact Nat.lt_add_of_pos_right
protected theorem pos_of_lt_add_right (h : n < n + k) : 0 < k :=
Nat.lt_of_add_lt_add_left h
@@ -233,6 +230,17 @@ instance : Std.Associative (α := Nat) min := ⟨Nat.min_assoc⟩
@[simp] protected theorem min_self_assoc' {m n : Nat} : min n (min m n) = min n m := by
rw [Nat.min_comm m n, Nat.min_assoc, Nat.min_self]
@[simp] theorem min_add_left {a b : Nat} : min a (b + a) = a := by
rw [Nat.min_def]
simp
@[simp] theorem min_add_right {a b : Nat} : min a (a + b) = a := by
rw [Nat.min_def]
simp
@[simp] theorem add_left_min {a b : Nat} : min (b + a) a = a := by
rw [Nat.min_comm, min_add_left]
@[simp] theorem add_right_min {a b : Nat} : min (a + b) a = a := by
rw [Nat.min_comm, min_add_right]
protected theorem sub_sub_eq_min : (a b : Nat), a - (a - b) = min a b
| 0, _ => by rw [Nat.zero_sub, Nat.zero_min]
| _, 0 => by rw [Nat.sub_zero, Nat.sub_self, Nat.min_zero]
@@ -287,6 +295,17 @@ protected theorem max_assoc : ∀ (a b c : Nat), max (max a b) c = max a (max b
| _+1, _+1, _+1 => by simp only [Nat.succ_max_succ]; exact congrArg succ <| Nat.max_assoc ..
instance : Std.Associative (α := Nat) max := Nat.max_assoc
@[simp] theorem max_add_left {a b : Nat} : max a (b + a) = b + a := by
rw [Nat.max_def]
simp
@[simp] theorem max_add_right {a b : Nat} : max a (a + b) = a + b := by
rw [Nat.max_def]
simp
@[simp] theorem add_left_max {a b : Nat} : max (b + a) a = b + a := by
rw [Nat.max_comm, max_add_left]
@[simp] theorem add_right_max {a b : Nat} : max (a + b) a = a + b := by
rw [Nat.max_comm, max_add_right]
protected theorem sub_add_eq_max (a b : Nat) : a - b + b = max a b := by
match Nat.le_total a b with
| .inl hl => rw [Nat.max_eq_right hl, Nat.sub_eq_zero_iff_le.mpr hl, Nat.zero_add]

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Omega
@@ -15,7 +15,7 @@ in particular
and its corollary
`Nat.mod_pow_succ : x % b ^ (k + 1) = x % b ^ k + b ^ k * ((x / b ^ k) % b)`.
It contains the necesssary preliminary results relating order and `*` and `/`,
It contains the necessary preliminary results relating order and `*` and `/`,
which should probably be moved to their own file.
-/

View File

@@ -6,6 +6,7 @@ Authors: Mario Carneiro
prelude
import Init.Data.Option.BasicAux
import Init.Data.Option.Instances
import Init.Data.BEq
import Init.Classical
import Init.Ext
@@ -13,7 +14,7 @@ namespace Option
theorem mem_iff {a : α} {b : Option α} : a b b = some a := .rfl
@[simp] theorem mem_some {a b : α} : a some b b = a := by simp [mem_iff]
theorem mem_some {a b : α} : a some b b = a := by simp
theorem mem_some_self (a : α) : a some a := mem_some.2 rfl
@@ -230,7 +231,7 @@ theorem isSome_filter_of_isSome (p : α → Bool) (o : Option α) (h : (o.filter
o.isSome := by
cases o <;> simp at h
@[simp] theorem filter_eq_none (p : α Bool) :
@[simp] theorem filter_eq_none {p : α Bool} :
Option.filter p o = none o = none a, a o ¬ p a := by
cases o <;> simp [filter_some]
@@ -247,7 +248,7 @@ theorem isSome_filter_of_isSome (p : α → Bool) (o : Option α) (h : (o.filter
theorem bind_map_comm {α β} {x : Option (Option α)} {f : α β} :
x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp
@[simp] theorem bind_map {f : α β} {g : β Option γ} {x : Option α} :
theorem bind_map {f : α β} {g : β Option γ} {x : Option α} :
(x.map f).bind g = x.bind (g f) := by cases x <;> simp
@[simp] theorem map_bind {f : α Option β} {g : β γ} {x : Option α} :
@@ -411,27 +412,42 @@ variable [BEq α]
@[simp] theorem some_beq_none (a : α) : ((some a : Option α) == none) = false := rfl
@[simp] theorem some_beq_some {a b : α} : (some a == some b) = (a == b) := rfl
@[simp] theorem reflBEq_iff : ReflBEq (Option α) ReflBEq α := by
constructor
· intro h
constructor
intro a
suffices (some a == some a) = true by
simpa only [some_beq_some]
simp
· intro h
constructor
· rintro (_ | a) <;> simp
@[simp] theorem lawfulBEq_iff : LawfulBEq (Option α) LawfulBEq α := by
constructor
· intro h
constructor
· intro a b h
apply Option.some.inj
apply eq_of_beq
simpa
· intro a
suffices (some a == some a) = true by
simpa only [some_beq_some]
simp
· intro h
constructor
· intro a b h
simpa using h
· intro a
simp
end beq
/-! ### ite -/
section ite
@[simp] theorem mem_dite_none_left {x : α} [Decidable p] {l : ¬ p Option α} :
(x if h : p then none else l h) h : ¬ p, x l h := by
split <;> simp_all
@[simp] theorem mem_dite_none_right {x : α} [Decidable p] {l : p Option α} :
(x if h : p then l h else none) h : p, x l h := by
split <;> simp_all
@[simp] theorem mem_ite_none_left {x : α} [Decidable p] {l : Option α} :
(x if p then none else l) ¬ p x l := by
split <;> simp_all
@[simp] theorem mem_ite_none_right {x : α} [Decidable p] {l : Option α} :
(x if p then l else none) p x l := by
split <;> simp_all
@[simp] theorem dite_none_left_eq_some {p : Prop} [Decidable p] {b : ¬p Option β} :
(if h : p then none else b h) = some a h, b h = some a := by
split <;> simp_all
@@ -464,6 +480,22 @@ section ite
some a = (if p then b else none) p some a = b := by
split <;> simp_all
theorem mem_dite_none_left {x : α} [Decidable p] {l : ¬ p Option α} :
(x if h : p then none else l h) h : ¬ p, x l h := by
simp
theorem mem_dite_none_right {x : α} [Decidable p] {l : p Option α} :
(x if h : p then l h else none) h : p, x l h := by
simp
theorem mem_ite_none_left {x : α} [Decidable p] {l : Option α} :
(x if p then none else l) ¬ p x l := by
simp
theorem mem_ite_none_right {x : α} [Decidable p] {l : Option α} :
(x if p then l else none) p x l := by
simp
@[simp] theorem isSome_dite {p : Prop} [Decidable p] {b : p β} :
(if h : p then some (b h) else none).isSome = true p := by
split <;> simpa

View File

@@ -51,6 +51,12 @@ instance [Repr α] : Repr (id α) :=
instance [Repr α] : Repr (Id α) :=
inferInstanceAs (Repr α)
/-
This instance allows us to use `Empty` as a type parameter without causing instance synthesis to fail.
-/
instance : Repr Empty where
reprPrec := nofun
instance : Repr Bool where
reprPrec
| true, _ => "true"

View File

@@ -290,11 +290,17 @@ instance (a b : UInt64) : Decidable (a ≤ b) := UInt64.decLe a b
instance : Max UInt64 := maxOfLe
instance : Min UInt64 := minOfLe
-- This instance would interfere with the global instance `NeZero (n + 1)`,
-- so we only enable it locally.
@[local instance]
private def instNeZeroUSizeSize : NeZero USize.size := add_one_ne_zero _
@[deprecated (since := "2024-09-16")]
theorem usize_size_gt_zero : USize.size > 0 :=
Nat.zero_lt_succ ..
@[extern "lean_usize_of_nat"]
def USize.ofNat (n : @& Nat) : USize := Fin.ofNat' n usize_size_gt_zero
def USize.ofNat (n : @& Nat) : USize := Fin.ofNat' _ n
abbrev Nat.toUSize := USize.ofNat
@[extern "lean_usize_to_nat"]
def USize.toNat (n : USize) : Nat := n.val.val

View File

@@ -156,11 +156,11 @@ theorem getElem?_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem d
theorem getElem!_pos [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
[Inhabited elem] (c : cont) (i : idx) (h : dom c i) [Decidable (dom c i)] :
c[i]! = c[i]'h := by
simp only [getElem!_def, getElem?_def, h]
simp [getElem!_def, getElem?_def, h]
theorem getElem!_neg [GetElem? cont idx elem dom] [LawfulGetElem cont idx elem dom]
[Inhabited elem] (c : cont) (i : idx) (h : ¬dom c i) [Decidable (dom c i)] : c[i]! = default := by
simp only [getElem!_def, getElem?_def, h]
simp [getElem!_def, getElem?_def, h]
namespace Fin

View File

@@ -7,7 +7,7 @@ Additional goodies for writing macros
-/
prelude
import Init.MetaTypes
import Init.Data.Array.Basic
import Init.Data.Array.GetLit
import Init.Data.Option.BasicAux
namespace Lean
@@ -862,7 +862,7 @@ partial def decodeRawStrLitAux (s : String) (i : String.Pos) (num : Nat) : Strin
/--
Takes the string literal lexical syntax parsed by the parser and interprets it as a string.
This is where escape sequences are processed for example.
The string `s` is is either a plain string literal or a raw string literal.
The string `s` is either a plain string literal or a raw string literal.
If it returns `none` then the string literal is ill-formed, which indicates a bug in the parser.
The function is not required to return `none` if the string literal is ill-formed.

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Omega.Int

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Omega.IntList

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Omega.LinearCombo

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Data.Int.DivMod

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Data.List.Zip

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.Omega.Coeffs

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
Authors: Kim Morrison
-/
prelude
import Init.PropLemmas

View File

@@ -754,10 +754,11 @@ infer the proof of `Nonempty α`.
noncomputable def Classical.ofNonempty {α : Sort u} [Nonempty α] : α :=
Classical.choice inferInstance
instance (α : Sort u) {β : Sort v} [Nonempty β] : Nonempty (α β) :=
instance {α : Sort u} {β : Sort v} [Nonempty β] : Nonempty (α β) :=
Nonempty.intro fun _ => Classical.ofNonempty
instance (α : Sort u) {β : α Sort v} [(a : α) Nonempty (β a)] : Nonempty ((a : α) β a) :=
instance Pi.instNonempty {α : Sort u} {β : α Sort v} [(a : α) Nonempty (β a)] :
Nonempty ((a : α) β a) :=
Nonempty.intro fun _ => Classical.ofNonempty
instance : Inhabited (Sort u) where
@@ -766,7 +767,8 @@ instance : Inhabited (Sort u) where
instance (α : Sort u) {β : Sort v} [Inhabited β] : Inhabited (α β) where
default := fun _ => default
instance (α : Sort u) {β : α Sort v} [(a : α) Inhabited (β a)] : Inhabited ((a : α) β a) where
instance Pi.instInhabited {α : Sort u} {β : α Sort v} [(a : α) Inhabited (β a)] :
Inhabited ((a : α) β a) where
default := fun _ => default
deriving instance Inhabited for Bool
@@ -1014,7 +1016,7 @@ with `Or : Prop → Prop → Prop`, which is the propositional connective).
It is `@[macro_inline]` because it has C-like short-circuiting behavior:
if `x` is true then `y` is not evaluated.
-/
@[macro_inline] def or (x y : Bool) : Bool :=
@[macro_inline] def Bool.or (x y : Bool) : Bool :=
match x with
| true => true
| false => y
@@ -1025,7 +1027,7 @@ with `And : Prop → Prop → Prop`, which is the propositional connective).
It is `@[macro_inline]` because it has C-like short-circuiting behavior:
if `x` is false then `y` is not evaluated.
-/
@[macro_inline] def and (x y : Bool) : Bool :=
@[macro_inline] def Bool.and (x y : Bool) : Bool :=
match x with
| false => false
| true => y
@@ -1034,10 +1036,12 @@ if `x` is false then `y` is not evaluated.
`not x`, or `!x`, is the boolean "not" operation (not to be confused
with `Not : Prop → Prop`, which is the propositional connective).
-/
@[inline] def not : Bool Bool
@[inline] def Bool.not : Bool Bool
| true => false
| false => true
export Bool (or and not)
/--
The type of natural numbers, starting at zero. It is defined as an
inductive type freely generated by "zero is a natural number" and
@@ -1208,7 +1212,7 @@ class HDiv (α : Type u) (β : Type v) (γ : outParam (Type w)) where
* For most types like `Nat`, `Int`, `Rat`, `Real`, `a / 0` is defined to be `0`.
* For `Nat`, `a / b` rounds downwards.
* For `Int`, `a / b` rounds downwards if `b` is positive or upwards if `b` is negative.
It is implemented as `Int.ediv`, the unique function satisfiying
It is implemented as `Int.ediv`, the unique function satisfying
`a % b + b * (a / b) = a` and `0 ≤ a % b < natAbs b` for `b ≠ 0`.
Other rounding conventions are available using the functions
`Int.fdiv` (floor rounding) and `Int.div` (truncation rounding).
@@ -1362,7 +1366,7 @@ class Pow (α : Type u) (β : Type v) where
/-- `a ^ b` computes `a` to the power of `b`. See `HPow`. -/
pow : α β α
/-- The homogenous version of `Pow` where the exponent is a `Nat`.
/-- The homogeneous version of `Pow` where the exponent is a `Nat`.
The purpose of this class is that it provides a default `Pow` instance,
which can be used to specialize the exponent to `Nat` during elaboration.
@@ -2063,7 +2067,7 @@ The size of type `USize`, that is, `2^System.Platform.numBits`, which may
be either `2^32` or `2^64` depending on the platform's architecture.
Remark: we define `USize.size` using `(2^numBits - 1) + 1` to ensure the
Lean unifier can solve contraints such as `?m + 1 = USize.size`. Recall that
Lean unifier can solve constraints such as `?m + 1 = USize.size`. Recall that
`numBits` does not reduce to a numeral in the Lean kernel since it is platform
specific. Without this trick, the following definition would be rejected by the
Lean type checker.
@@ -2566,7 +2570,9 @@ structure Array (α : Type u) where
/--
Converts a `List α` into an `Array α`.
At runtime, this constructor is implemented by `List.toArray` and is O(n) in the length of the
You can also use the synonym `List.toArray` when dot notation is convenient.
At runtime, this constructor is implemented by `List.toArrayImpl` and is O(n) in the length of the
list.
-/
mk ::
@@ -2580,6 +2586,9 @@ structure Array (α : Type u) where
attribute [extern "lean_array_to_list"] Array.toList
attribute [extern "lean_array_mk"] Array.mk
@[inherit_doc Array.mk, match_pattern]
abbrev List.toArray (xs : List α) : Array α := .mk xs
/-- Construct a new empty array with initial capacity `c`. -/
@[extern "lean_mk_empty_array_with_capacity"]
def Array.mkEmpty {α : Type u} (c : @& Nat) : Array α where
@@ -2707,7 +2716,10 @@ def Array.extract (as : Array α) (start stop : Nat) : Array α :=
let sz' := Nat.sub (min stop as.size) start
loop sz' start (mkEmpty sz')
/-- Auxiliary definition for `List.toArray`. -/
/--
Auxiliary definition for `List.toArray`.
`List.toArrayAux as r = r ++ as.toArray`
-/
@[inline_if_reduce]
def List.toArrayAux : List α Array α Array α
| nil, r => r
@@ -2723,7 +2735,7 @@ def List.redLength : List α → Nat
-- This function is exported to C, where it is called by `Array.mk`
-- (the constructor) to implement this functionality.
@[inline, match_pattern, pp_nodot, export lean_list_to_array]
def List.toArray (as : List α) : Array α :=
def List.toArrayImpl (as : List α) : Array α :=
as.toArrayAux (Array.mkEmpty as.redLength)
/-- The typeclass which supplies the `>>=` "bind" function. See `Monad`. -/

View File

@@ -231,8 +231,21 @@ instance : Std.Associative (· || ·) := ⟨Bool.or_assoc⟩
@[simp] theorem Bool.not_false : (!false) = true := by decide
@[simp] theorem beq_true (b : Bool) : (b == true) = b := by cases b <;> rfl
@[simp] theorem beq_false (b : Bool) : (b == false) = !b := by cases b <;> rfl
@[simp] theorem Bool.not_eq_true' (b : Bool) : ((!b) = true) = (b = false) := by cases b <;> simp
@[simp] theorem Bool.not_eq_false' (b : Bool) : ((!b) = false) = (b = true) := by cases b <;> simp
/--
We move `!` from the left hand side of an equality to the right hand side.
This helps confluence, and also helps combining pairs of `!`s.
-/
@[simp] theorem Bool.not_eq_eq_eq_not {a b : Bool} : ((!a) = b) (a = !b) := by
cases a <;> cases b <;> simp
@[simp] theorem Bool.not_eq_not {a b : Bool} : ¬a = !b a = b := by
cases a <;> cases b <;> simp
theorem Bool.not_not_eq {a b : Bool} : ¬(!a) = b a = b := by simp
theorem Bool.not_eq_true' (b : Bool) : ((!b) = true) = (b = false) := by simp
theorem Bool.not_eq_false' (b : Bool) : ((!b) = false) = (b = true) := by simp
@[simp] theorem Bool.not_eq_true (b : Bool) : (¬(b = true)) = (b = false) := by cases b <;> decide
@[simp] theorem Bool.not_eq_false (b : Bool) : (¬(b = false)) = (b = true) := by cases b <;> decide

View File

@@ -456,7 +456,7 @@ syntax (name := change) "change " term (location)? : tactic
/--
* `change a with b` will change occurrences of `a` to `b` in the goal,
assuming `a` and `b` are are definitionally equal.
assuming `a` and `b` are definitionally equal.
* `change a with b at h` similarly changes `a` to `b` in the type of hypothesis `h`.
-/
syntax (name := changeWith) "change " term " with " term (location)? : tactic
@@ -773,8 +773,9 @@ macro_rules
macro "refine_lift' " e:term : tactic => `(tactic| focus (refine' no_implicit_lambda% $e; rotate_right))
/-- Similar to `have`, but using `refine'` -/
macro "have' " d:haveDecl : tactic => `(tactic| refine_lift' have $d:haveDecl; ?_)
/-- Similar to `have`, but using `refine'` -/
set_option linter.missingDocs false in -- OK, because `tactic_alt` causes inheritance of docs
macro (priority := high) "have'" x:ident " := " p:term : tactic => `(tactic| have' $x:ident : _ := $p)
attribute [tactic_alt tacticHave'_] «tacticHave'_:=_»
/-- Similar to `let`, but using `refine'` -/
macro "let' " d:letDecl : tactic => `(tactic| refine_lift' let $d:letDecl; ?_)
@@ -1588,7 +1589,7 @@ macro "get_elem_tactic" : tactic =>
There is a proof embedded in the right-hand-side, and we want it to be just `hi`.
If `omega` is used to "fill" this proof, we will have a more complex proof term that
cannot be inferred by unification.
We hardcoded `assumption` here to ensure users cannot accidentaly break this IF
We hardcoded `assumption` here to ensure users cannot accidentally break this IF
they add new `macro_rules` for `get_elem_tactic_trivial`.
TODO: Implement priorities for `macro_rules`.
@@ -1598,7 +1599,7 @@ macro "get_elem_tactic" : tactic =>
| get_elem_tactic_trivial
| fail "failed to prove index is valid, possible solutions:
- Use `have`-expressions to prove the index is valid
- Use `a[i]!` notation instead, runtime check is perfomed, and 'Panic' error message is produced if index is not valid
- Use `a[i]!` notation instead, runtime check is performed, and 'Panic' error message is produced if index is not valid
- Use `a[i]?` notation instead, result is an `Option` type
- Use `a[i]'h` notation instead, where `h` is a proof that index is valid"
)

View File

@@ -20,7 +20,7 @@ macro "simp_wf" : tactic =>
/--
This tactic is used internally by lean before presenting the proof obligations from a well-founded
definition to the user via `decreasing_by`. It is not necessary to use this tactic manuall.
definition to the user via `decreasing_by`. It is not necessary to use this tactic manually.
-/
macro "clean_wf" : tactic =>
`(tactic| simp

View File

@@ -68,7 +68,7 @@ namespace InitParamMap
def initBorrow (ps : Array Param) : Array Param :=
ps.map fun p => { p with borrow := p.ty.isObj }
/-- We do perform borrow inference for constants marked as `export`.
/-- We do not perform borrow inference for constants marked as `export`.
Reason: we current write wrappers in C++ for using exported functions.
These wrappers use smart pointers such as `object_ref`.
When writing a new wrapper we need to know whether an argument is a borrow

View File

@@ -91,7 +91,7 @@ private def isBorrowParamAux (x : VarId) (ys : Array Arg) (consumeParamPred : Na
| Arg.var y => x == y && !consumeParamPred i
private def isBorrowParam (x : VarId) (ys : Array Arg) (ps : Array Param) : Bool :=
isBorrowParamAux x ys fun i => not ps[i]!.borrow
isBorrowParamAux x ys fun i => ! ps[i]!.borrow
/--
Return `n`, the number of times `x` is consumed.
@@ -124,7 +124,7 @@ private def addIncBeforeAux (ctx : Context) (xs : Array Arg) (consumeParamPred :
addInc ctx x b numIncs
private def addIncBefore (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (liveVarsAfter : LiveVarSet) : FnBody :=
addIncBeforeAux ctx xs (fun i => not ps[i]!.borrow) b liveVarsAfter
addIncBeforeAux ctx xs (fun i => ! ps[i]!.borrow) b liveVarsAfter
/-- See `addIncBeforeAux`/`addIncBefore` for the procedure that inserts `inc` operations before an application. -/
private def addDecAfterFullApp (ctx : Context) (xs : Array Arg) (ps : Array Param) (b : FnBody) (bLiveVars : LiveVarSet) : FnBody :=

View File

@@ -103,7 +103,7 @@ private def mkFresh : M VarId := do
/--
Helper function for applying `S`. We only introduce a `reset` if we managed
to replace a `ctor` withe `reuse` in `b`.
to replace a `ctor` with `reuse` in `b`.
-/
private def tryS (x : VarId) (c : CtorInfo) (b : FnBody) : M FnBody := do
let w mkFresh

View File

@@ -242,7 +242,7 @@ structure ExtendState where
/--
A map from join point `FVarId`s to a respective map from free variables
to `Param`s. The free variables in this map are the once that the context
of said join point will be extended by by passing in the respective parameter.
of said join point will be extended by passing in the respective parameter.
-/
fvarMap : Std.HashMap FVarId (Std.HashMap FVarId Param) := {}

View File

@@ -35,7 +35,7 @@ def checkIsDefinition (env : Environment) (n : Name) : Except String Unit :=
match env.find? n with
| (some (ConstantInfo.defnInfo _)) => Except.ok ()
| (some (ConstantInfo.opaqueInfo _)) => Except.ok ()
| none => Except.error s!"unknow declaration '{n}'"
| none => Except.error s!"unknown declaration '{n}'"
| _ => Except.error s!"declaration is not a definition '{n}'"
/--

View File

@@ -195,7 +195,7 @@ def insert' (m : HashMap α β) (a : α) (b : β) : HashMap α β × Bool :=
/--
Similar to `insert`, but returns `some old` if the map already had an entry `α → old`.
If the result is `some old`, the the resulting map is equal to `m`. -/
If the result is `some old`, the resulting map is equal to `m`. -/
def insertIfNew (m : HashMap α β) (a : α) (b : β) : HashMap α β × Option β :=
match m with
| m, hw =>

View File

@@ -28,6 +28,12 @@ instance : ToJson Json := ⟨id⟩
instance : FromJson JsonNumber := Json.getNum?
instance : ToJson JsonNumber := Json.num
instance : FromJson Empty where
fromJson? j := throw (s!"type Empty has no constructor to match JSON value '{j}'. \
This occurs when deserializing a value for type Empty, \
e.g. at type Option Empty with code for the 'some' constructor.")
instance : ToJson Empty := nofun
-- looks like id, but there are coercions happening
instance : FromJson Bool := Json.getBool?
instance : ToJson Bool := fun b => b

View File

@@ -266,7 +266,7 @@ instance [FromJson α] : FromJson (Notification α) where
let params := params?
let param : α fromJson? (toJson params)
pure $ method, param
else throw "not a notfication"
else throw "not a notification"
end Lean.JsonRpc

View File

@@ -36,7 +36,7 @@ instance : FromJson Trace := ⟨fun j =>
| Except.ok "off" => return Trace.off
| Except.ok "messages" => return Trace.messages
| Except.ok "verbose" => return Trace.verbose
| _ => throw "uknown trace"
| _ => throw "unknown trace"
instance Trace.hasToJson : ToJson Trace :=
fun

View File

@@ -317,8 +317,8 @@ variable {m : Type → Type w} [Monad m]
anyMAux p t.root <||> t.tail.anyM p
@[inline] def allM (a : PersistentArray α) (p : α m Bool) : m Bool := do
let b anyM a (fun v => do let b p v; pure (not b))
pure (not b)
let b anyM a (fun v => do let b p v; pure (!b))
pure (!b)
end

View File

@@ -239,7 +239,7 @@ structure InductiveVal extends ConstantVal where
all : List Name
/-- List of the names of the constructors for this inductive datatype. -/
ctors : List Name
/-- Number of auxillary data types produced from nested occurrences.
/-- Number of auxiliary data types produced from nested occurrences.
An inductive definition `T` is nested when there is a constructor with an argument `x : F T`,
where `F : Type → Type` is some suitably behaved (ie strictly positive) function (Eg `Array T`, `List T`, `T × T`, ...). -/
numNested : Nat

View File

@@ -24,7 +24,7 @@ def elabAuxDef : CommandElab
let id := `_aux ++ ( getMainModule) ++ `_ ++ id
let id := String.intercalate "_" <| id.components.map (·.toString (escape := false))
let ns getCurrNamespace
-- make sure we only add a single component so that scoped workes
-- make sure we only add a single component so that scoped works
let id mkAuxName (ns.mkStr id) 1
let id := id.replacePrefix ns Name.anonymous -- TODO: replace with def _root_.id
elabCommand <|

View File

@@ -170,8 +170,9 @@ private def toBinderViews (stx : Syntax) : TermElabM (Array BinderView) := do
else
throwUnsupportedSyntax
private def registerFailedToInferBinderTypeInfo (type : Expr) (ref : Syntax) : TermElabM Unit :=
private def registerFailedToInferBinderTypeInfo (type : Expr) (ref : Syntax) : TermElabM Unit := do
registerCustomErrorIfMVar type ref "failed to infer binder type"
registerLevelMVarErrorExprInfo type ref m!"failed to infer universe levels in binder type"
def addLocalVarInfo (stx : Syntax) (fvar : Expr) : TermElabM Unit :=
addTermInfo' (isBinder := true) stx fvar
@@ -639,7 +640,7 @@ open Lean.Elab.Term.Quotation in
| _ => throwUnsupportedSyntax
/-- If `useLetExpr` is true, then a kernel let-expression `let x : type := val; body` is created.
Otherwise, we create a term of the form `(fun (x : type) => body) val`
Otherwise, we create a term of the form `letFun val (fun (x : type) => body)`
The default elaboration order is `binders`, `typeStx`, `valStx`, and `body`.
If `elabBodyFirst == true`, then we use the order `binders`, `typeStx`, `body`, and `valStx`. -/
@@ -650,7 +651,7 @@ def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (va
/-
We use `withSynthesize` to ensure that any postponed elaboration problem
and nested tactics in `type` are resolved before elaborating `val`.
Resolved: we want to avoid synthethic opaque metavariables in `type`.
Resolved: we want to avoid synthetic opaque metavariables in `type`.
Recall that this kind of metavariable is non-assignable, and `isDefEq`
may waste a lot of time unfolding declarations before failing.
See issue #4051 for an example.
@@ -670,7 +671,9 @@ def elabLetDeclAux (id : Syntax) (binders : Array Syntax) (typeStx : Syntax) (va
Recall that TC resolution does **not** produce synthetic opaque metavariables.
-/
let type withSynthesize (postpone := .partial) <| elabType typeStx
registerCustomErrorIfMVar type typeStx "failed to infer 'let' declaration type"
let letMsg := if useLetExpr then "let" else "have"
registerCustomErrorIfMVar type typeStx m!"failed to infer '{letMsg}' declaration type"
registerLevelMVarErrorExprInfo type typeStx m!"failed to infer universe levels in '{letMsg}' declaration type"
if elabBodyFirst then
let type mkForallFVars fvars type
let val mkFreshExprMVar type

View File

@@ -381,7 +381,7 @@ unsafe def elabEvalCoreUnsafe (bang : Bool) (tk term : Syntax): CommandElabM Uni
-- Evaluate using term using `MetaEval` class.
let elabMetaEval : CommandElabM Unit := do
-- Generate an action without executing it. We use `withoutModifyingEnv` to ensure
-- we don't polute the environment with auxliary declarations.
-- we don't pollute the environment with auxliary declarations.
-- We have special support for `CommandElabM` to ensure `#eval` can be used to execute commands
-- that modify `CommandElabM` state not just the `Environment`.
let act : Sum (CommandElabM Unit) (Environment Options IO (String × Except IO.Error Environment))

View File

@@ -532,8 +532,7 @@ def elabCommandTopLevel (stx : Syntax) : CommandElabM Unit := withRef stx do pro
-- We can assume that the root command snapshot is not involved in parallelism yet, so this
-- should be true iff the command supports incrementality
if ( IO.hasFinished snap.new.result) then
trace[Elab.snapshotTree]
(Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.format)
liftCoreM <| Language.ToSnapshotTree.toSnapshotTree snap.new.result.get |>.trace
modify fun st => { st with
messages := initMsgs ++ msgs
infoState := { st.infoState with trees := initInfoTrees ++ st.infoState.trees }

View File

@@ -120,7 +120,7 @@ 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`, `proctected`, `unsafe`, `noncomputable`, doc string)-/
/-- 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]

View File

@@ -61,16 +61,17 @@ def expandDeclSig (stx : Syntax) : Syntax × Syntax :=
(binders, typeSpec[1])
/--
Sort the given list of `usedParams` using the following order:
- If it is an explicit level `allUserParams`, then use user given order.
- Otherwise, use lexicographical.
Sort the given list of `usedParams` using the following order:
- If it is an explicit level in `allUserParams`, then use user-given order.
- All other levels come in lexicographic order after these.
Remark: `scopeParams` are the universe params introduced using the `universe` command. `allUserParams` contains
the universe params introduced using the `universe` command *and* the `.{...}` notation.
Remark: `scopeParams` are the universe params introduced using the `universe` command. `allUserParams` contains
the universe params introduced using the `universe` command *and* the `.{...}` notation.
Remark: this function return an exception if there is an `u` not in `usedParams`, that is in `allUserParams` but not in `scopeParams`.
Remark: this function return an exception if there is an `u` not in `usedParams`, that is in `allUserParams` but not in `scopeParams`.
Remark: `explicitParams` are in reverse declaration order. That is, the head is the last declared parameter. -/
Remark: `scopeParams` and `allUserParams` are in reverse declaration order. That is, the head is the last declared parameter.
-/
def sortDeclLevelParams (scopeParams : List Name) (allUserParams : List Name) (usedParams : Array Name) : Except String (List Name) :=
match allUserParams.find? fun u => !usedParams.contains u && !scopeParams.elem u with
| some u => throw s!"unused universe parameter '{u}'"

View File

@@ -59,15 +59,17 @@ where
let mut ctorArgs := #[]
let mut rhs : Term := Syntax.mkStrLit (toString ctorInfo.name)
rhs `(Format.text $rhs)
-- add `_` for inductive parameters, they are inaccessible
for _ in [:indVal.numParams] do
ctorArgs := ctorArgs.push ( `(_))
for i in [:ctorInfo.numFields] do
let x := xs[indVal.numParams + i]!
let a := mkIdent ( mkFreshUserName `a)
ctorArgs := ctorArgs.push a
let localDecl x.fvarId!.getDecl
if localDecl.binderInfo.isExplicit then
for i in [:xs.size] do
-- Note: some inductive parameters are explicit if they were promoted from indices,
-- so we process all constructor arguments in the same loop.
let x := xs[i]!
let a mkIdent <$> if i < indVal.numParams then pure header.argNames[i]! else mkFreshUserName `a
if i < indVal.numParams then
-- add `_` for inductive parameters, they are inaccessible
ctorArgs := ctorArgs.push ( `(_))
else
ctorArgs := ctorArgs.push a
if ( x.fvarId!.getBinderInfo).isExplicit then
if ( inferType x).isAppOf indVal.name then
rhs `($rhs ++ Format.line ++ $(mkIdent auxFunName):ident $a:ident max_prec)
else if ( isType x <||> isProof x) then

View File

@@ -18,7 +18,7 @@ private def getMonadForIn (expectedType? : Option Expr) : TermElabM Expr := do
| some expectedType =>
match ( isTypeApp? expectedType) with
| some (m, _) => return m
| none => throwError "invalid 'for_in%' notation, expected type is not of of the form `M α`{indentExpr expectedType}"
| none => throwError "invalid 'for_in%' notation, expected type is not of the form `M α`{indentExpr expectedType}"
private def throwForInFailure (forInInstance : Expr) : TermElabM Expr :=
throwError "failed to synthesize instance for 'for_in%' notation{indentExpr forInInstance}"
@@ -375,7 +375,7 @@ private def hasHeterogeneousDefaultInstances (f : Expr) (maxType : Expr) (lhs :
return false
/--
Return `true` if polymorphic function `f` has a homogenous instance of `maxType`.
Return `true` if polymorphic function `f` has a homogeneous instance of `maxType`.
The coercions to `maxType` only makes sense if such instance exists.
For example, suppose `maxType` is `Int`, and `f` is `HPow.hPow`. Then,
@@ -421,9 +421,9 @@ mutual
| .binop ref kind f lhs rhs =>
/-
We only keep applying coercions to `maxType` if `f` is predicate or
`f` has a homogenous instance with `maxType`. See `hasHomogeneousInstance` for additional details.
`f` has a homogeneous instance with `maxType`. See `hasHomogeneousInstance` for additional details.
Remark: We assume `binrel%` elaborator is only used with homogenous predicates.
Remark: We assume `binrel%` elaborator is only used with homogeneous predicates.
-/
if ( pure isPred <||> hasHomogeneousInstance f maxType) then
return .binop ref kind f ( go lhs f true false) ( go rhs f false false)

View File

@@ -183,7 +183,7 @@ def UserWidgetInfo.format (info : UserWidgetInfo) : Format :=
f!"UserWidget {info.id}\n{Std.ToFormat.format <| info.props.run' {}}"
def FVarAliasInfo.format (info : FVarAliasInfo) : Format :=
f!"FVarAlias {info.userName.eraseMacroScopes}"
f!"FVarAlias {info.userName.eraseMacroScopes}: {info.id.name} -> {info.baseId.name}"
def FieldRedeclInfo.format (ctx : ContextInfo) (info : FieldRedeclInfo) : Format :=
f!"FieldRedecl @ {formatStxRange ctx info.stx}"

View File

@@ -30,7 +30,7 @@ private def mkUserNameFor (e : Expr) : TermElabM Name := do
/--
Remark: if the discriminat is `Systax.missing`, we abort the elaboration of the `match`-expression.
Remark: if the discriminat is `Syntax.missing`, we abort the elaboration of the `match`-expression.
This can happen due to error recovery. Example
```
example : (p p) → p := fun h => match
@@ -795,7 +795,7 @@ private def elabMatchAltView (discrs : Array Discr) (alt : MatchAltView) (matchT
let rhs elabTermEnsuringType alt.rhs matchType'
-- We use all approximations to ensure the auxiliary type is defeq to the original one.
unless ( fullApproxDefEq <| isDefEq matchType' matchType) do
throwError "type mistmatch, alternative {← mkHasTypeButIsExpectedMsg matchType' matchType}"
throwError "type mismatch, alternative {← mkHasTypeButIsExpectedMsg matchType' matchType}"
let xs := altLHS.fvarDecls.toArray.map LocalDecl.toExpr ++ eqs
let rhs if xs.isEmpty then pure <| mkSimpleThunk rhs else mkLambdaFVars xs rhs
trace[Elab.match] "rhs: {rhs}"

View File

@@ -98,7 +98,7 @@ private def isMultiConstant? (views : Array DefView) : Option (List Name) :=
else
none
private def getPendindMVarErrorMessage (views : Array DefView) : String :=
private def getPendingMVarErrorMessage (views : Array DefView) : String :=
match isMultiConstant? views with
| some ids =>
let idsStr := ", ".intercalate <| ids.map fun id => s!"`{id}`"
@@ -196,7 +196,7 @@ private def elabHeaders (views : Array DefView)
if view.type?.isSome then
let pendingMVarIds getMVars type
discard <| logUnassignedUsingErrorInfos pendingMVarIds <|
getPendindMVarErrorMessage views
getPendingMVarErrorMessage views
let newHeader : DefViewElabHeaderData := {
declName, shortDeclName, type, levelNames, binderIds
numParams := xs.size
@@ -947,45 +947,6 @@ private def levelMVarToParamHeaders (views : Array DefView) (headers : Array Def
let newHeaders (process).run' 1
newHeaders.mapM fun header => return { header with type := ( instantiateMVars header.type) }
partial def checkForHiddenUnivLevels (allUserLevelNames : List Name) (preDefs : Array PreDefinition) : TermElabM Unit :=
unless ( MonadLog.hasErrors) do
-- We do not report this kind of error if the declaration already contains errors
let mut sTypes : CollectLevelParams.State := {}
let mut sValues : CollectLevelParams.State := {}
for preDef in preDefs do
sTypes := collectLevelParams sTypes preDef.type
sValues := collectLevelParams sValues preDef.value
if sValues.params.all fun u => sTypes.params.contains u || allUserLevelNames.contains u then
-- If all universe level occurring in values also occur in types or explicitly provided universes, then everything is fine
-- and we just return
return ()
let checkPreDef (preDef : PreDefinition) : TermElabM Unit :=
-- Otherwise, we try to produce an error message containing the expression with the offending universe
let rec visitLevel (u : Level) : ReaderT Expr TermElabM Unit := do
match u with
| .succ u => visitLevel u
| .imax u v | .max u v => visitLevel u; visitLevel v
| .param n =>
unless sTypes.visitedLevel.contains u || allUserLevelNames.contains n do
let parent withOptions (fun o => pp.universes.set o true) do addMessageContext m!"{indentExpr (← read)}"
let body withOptions (fun o => pp.letVarTypes.setIfNotSet (pp.funBinderTypes.setIfNotSet o true) true) do addMessageContext m!"{indentExpr preDef.value}"
throwError "invalid occurrence of universe level '{u}' at '{preDef.declName}', it does not occur at the declaration type, nor it is explicit universe level provided by the user, occurring at expression{parent}\nat declaration body{body}"
| _ => pure ()
let rec visit (e : Expr) : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit := do
checkCache { val := e : ExprStructEq } fun _ => do
match e with
| .forallE n d b c | .lam n d b c => visit d e; withLocalDecl n c d fun x => visit (b.instantiate1 x) e
| .letE n t v b _ => visit t e; visit v e; withLetDecl n t v fun x => visit (b.instantiate1 x) e
| .app .. => e.withApp fun f args => do visit f e; args.forM fun arg => visit arg e
| .mdata _ b => visit b e
| .proj _ _ b => visit b e
| .sort u => visitLevel u ( read)
| .const _ us => us.forM (visitLevel · ( read))
| _ => pure ()
visit preDef.value preDef.value |>.run {}
for preDef in preDefs do
checkPreDef preDef
def elabMutualDef (vars : Array Expr) (sc : Command.Scope) (views : Array DefView) : TermElabM Unit :=
if isExample views then
withoutModifyingEnv do
@@ -1021,13 +982,12 @@ where
let preDefs MutualClosure.main vars headers funFVars values letRecsToLift
for preDef in preDefs do
trace[Elab.definition] "{preDef.declName} : {preDef.type} :=\n{preDef.value}"
let preDefs withLevelNames allUserLevelNames <| levelMVarToParamPreDecls preDefs
let preDefs withLevelNames allUserLevelNames <| levelMVarToParamTypesPreDecls preDefs
let preDefs instantiateMVarsAtPreDecls preDefs
let preDefs shareCommonPreDefs preDefs
let preDefs fixLevelParams preDefs scopeLevelNames allUserLevelNames
for preDef in preDefs do
trace[Elab.definition] "after eraseAuxDiscr, {preDef.declName} : {preDef.type} :=\n{preDef.value}"
checkForHiddenUnivLevels allUserLevelNames preDefs
addPreDefinitions preDefs
processDeriving headers
for view in views, header in headers do

View File

@@ -156,9 +156,11 @@ private def processVar (idStx : Syntax) : M Syntax := do
modify fun s => { s with vars := s.vars.push idStx, found := s.found.insert id }
return idStx
private def samePatternsVariables (startingAt : Nat) (s₁ s₂ : State) : Bool :=
if h : s₁.vars.size = s₂.vars.size then
Array.isEqvAux s₁.vars s.vars h (.==.) startingAt
private def samePatternsVariables (startingAt : Nat) (s₁ s₂ : State) : Bool := Id.run do
if h : s₁.vars.size = s₂.vars.size then
for h₂ : i in [startingAt:s.vars.size] do
if s₁.vars[i] != s₂.vars[i]'(by obtain _, y := h₂; simp_all) then return false
true
else
false

View File

@@ -39,14 +39,26 @@ structure PreDefinition where
def PreDefinition.filterAttrs (preDef : PreDefinition) (p : Attribute Bool) : PreDefinition :=
{ preDef with modifiers := preDef.modifiers.filterAttrs p }
/--
Applies `Lean.instantiateMVars` to the types of values of each predefinition.
-/
def instantiateMVarsAtPreDecls (preDefs : Array PreDefinition) : TermElabM (Array PreDefinition) :=
preDefs.mapM fun preDef => do
pure { preDef with type := ( instantiateMVars preDef.type), value := ( instantiateMVars preDef.value) }
def levelMVarToParamPreDecls (preDefs : Array PreDefinition) : TermElabM (Array PreDefinition) :=
/--
Applies `Lean.Elab.Term.levelMVarToParam` to the types of each predefinition.
-/
def levelMVarToParamTypesPreDecls (preDefs : Array PreDefinition) : TermElabM (Array PreDefinition) :=
preDefs.mapM fun preDef => do
pure { preDef with type := ( levelMVarToParam preDef.type), value := ( levelMVarToParam preDef.value) }
pure { preDef with type := ( levelMVarToParam preDef.type) }
/--
Collects all the level parameters in sorted order from the types and values of each predefinition.
Throws an "unused universe parameter" error if there is an unused `.{...}` parameter.
See `Lean.collectLevelParams`.
-/
private def getLevelParamsPreDecls (preDefs : Array PreDefinition) (scopeLevelNames allUserLevelNames : List Name) : TermElabM (List Name) := do
let mut s : CollectLevelParams.State := {}
for preDef in preDefs do

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