Compare commits

...

82 Commits

Author SHA1 Message Date
Kim Morrison
fd7377eb54 chore: upstream Subarray.empty 2024-09-29 15:33:54 +10:00
Kyle Miller
96adf04a62 fix: reduce parents in structure command (#5511)
Makes it possible to `extend` another structure through an abbreviation.
Also inserts a `withSynthesize` checkpoint for parents.

Closes #5417
2024-09-29 02:15:07 +00:00
Kyle Miller
0db6daa8f1 feat: actual implementation for #5283 (#5512)
I did a bad git rebase before merging #5283, which reverted it to an
earlier version. This PR has the actual implementation of RFC #5397.
2024-09-29 01:22:12 +00:00
Kyle Miller
130b465aaf feat: generalize elab_as_elim to allow arbitrary motive applications (#5510)
Now the elab-as-elim procedure allows eliminators whose result is an
arbitrary application of the motive. For example, the following is now
accepted. It will generalize `Int.natAbs _` from the expected type.
```lean
@[elab_as_elim]
theorem natAbs_elim {motive : Nat → Prop} (i : Int)
  (hpos : ∀ (n : Nat), i = n → motive n)
  (hneg : ∀ (n : Nat), i = -↑n → motive n) :
  motive (Int.natAbs i) := by sorry
```

This change simplifies the elaborator, since it no longer needs to keep
track of discriminants (which can easily be read off from the return
type of the eliminator) or the difference between "targets" and "extra
arguments" (which are now both "major arguments" that should be eagerly
elaborated).

Closes #4086
2024-09-28 22:30:14 +00:00
Lean stage0 autoupdater
ccdf07b6a1 chore: update stage0 2024-09-28 14:05:01 +00:00
Tobias Grosser
5605e0198a chore: BitVec.Lemmas - drop non-terminal simps (#5499)
`BitVec.Lemmas` contained a couple of non-terminal simps. We turn
non-terminal `simp$`, `simp [`, and `simp at` expressions into `simp
only` to improve code maintainability.
2024-09-28 10:23:28 +00:00
Henrik Böving
5f22ba7789 feat: bv_normalize handle -> False (#5507) 2024-09-28 10:05:16 +00:00
Henrik Böving
16a16898d5 feat: improve bv_normalize rules for Prop and == (#5506) 2024-09-28 09:21:48 +00:00
Mac Malone
4ea76aadd1 refactor: lake: switch new/init default to TOML (#5504)
Changes the default configuration for new Lake packages to TOML.

Closes #4106.
2024-09-28 06:28:50 +00:00
Kim Morrison
ef71f0beab chore: restore @[simp] to upstreamed Nat.lt_off_iff (#5503)
This was upstreamed from Mathlib in #5478, but leaving off the `@[simp]`
attribute, thereby breaking Mathlib. (We could of course add the simp
attribute back in Mathlib, but wherever it lives it should have been in
place at the time we merged -- this way I have to add it temporarily in
Mathlib and then remove it again once it is redundant.)
2024-09-28 04:55:15 +00:00
Kyle Miller
9f4075be72 fix: refine how named arguments suppress explicit arguments (#5283)
Recall that currently named arguments suppress all explicit parameters
that are dependencies. This PR limits this feature to only apply to true
structure projections, except in the case where it is triggered when
there are no more positional arguments. This preserves the primary
reason for generalizing this feature (issue #1851), while removing the
generalized feature, which has led to numerous confusions (issue #1867).
This also fixes a bug pointed out [on
Zulip](https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/.40foo.20.28A.20.3A.3D.20bar.29.20_.20_/near/468564862)
where in `@` mode, instance implicit parameter dependencies to named
arguments would be suppressed unless the next positional argument was
`_`.

More detail:
* The `NamedArg` structure now has a `suppressDeps : Bool` field. It is
set to `true` for the `self` argument in structure projections. If there
is such a `NamedArg`, explicit parameters that are dependencies to the
named argument are turned into implicit arguments. The consequence is
that *all* structure projections are treated as if their type parameters
are implicit, even for class projections. This flag is *not* used for
generalized field notation.
* We preserve the suppression feature when there are no positional
arguments remaining. This feature pre-dates the fix to issue #1851, and
it is useful when combining named arguments and the eta expansion
feature, since dependencies of named arguments cannot be turned into eta
arguments. Plus, there are examples of the form `rw [lem (h := foo)]`
where `lem` has explicit arguments that `h` depends on.
* For instance implicit parameters in explicit mode, now `_` arguments
register terminfo and are hoverable.
* Now `..` is respected in explicit mode.

This implements RFC #5397. The `suppressDeps` flag suggests a future
possibility of a named argument syntax that can suppress dependencies.
2024-09-27 20:14:29 +00:00
Kyle Miller
1b6572726f feat: have autoparams report parameter/field on failure (#5474)
Adds a mechanism where when an autoparam tactic fails to synthesize a
parameter, the associated parameter name or field name for the autoparam
is reported in an error.

Examples:
```text
could not synthesize default value for parameter 'h' using tactics

could not synthesize default value for field 'inv' of 'S' using tactics
```

Notes:
* Autoparams now run their tactics without any error recovery or
error-to-sorry enabled. This enables catching the error and reporting
the contextual information. This is justified on the grounds that
autoparams are not interactive.
* Autoparams for applications now cleanup the autoParam annotation,
bringing it in line with autoparams for structure fields.
* This preserves the old behavior that autoparams leave terminfo, but we
will revisit this after some imminent improvements to the unused
variable linter.

Closes #2950
2024-09-27 19:00:59 +00:00
Joachim Breitner
56b78a0ed1 chore: pr-release.yml: fix bot’s username to look for (#5495)
This didn’t make it in with #5490, but seems to be needed, just as in
https://github.com/leanprover-community/mathlib4/pull/17182/files (the
code is duplicated in both repos, and should be the same).
2024-09-27 15:29:53 +00:00
Sebastian Ullrich
e28bfedae2 doc: remove inaccurate PersistentEnvExtension.setState/modifyState claim
Likely a copy-paste mistake

Fixes #3039
2024-09-27 15:59:36 +02:00
Sebastian Ullrich
e7691f37c6 fix: induction pre-tactic should be indented (#5494)
Fixes #2876
2024-09-27 12:43:42 +00:00
Luisa Cicolini
48711ce6eb feat: BitVec.(not_sshiftRight, not_sshiftRight_not, getMsb_not, msb_not) (#5492) 2024-09-27 10:36:17 +00:00
Tobias Grosser
0733273a78 feat: add BitVec.toNat_[abs|sdiv|smod] (#5491)
Co-authored-by: Luisa Cicolini <48860705+luisacicolini@users.noreply.github.com>
2024-09-27 10:35:41 +00:00
Henrik Böving
2221296d3c chore: delete unused code (#5493) 2024-09-27 09:36:56 +00:00
Eric Wieser
f22998edfe fix: collect level parameters in evalExpr (#3090)
`elabEvalUnsafe` already does something similar: it also instantiates
universe metavariables, but it is not clear to me whether that is
sensible here.
To be conservative, I leave it out of this PR.

See https://github.com/leanprover/lean4/pull/3090#discussion_r1432007590
for a comparison between `#eval` and `Meta.evalExpr`. This PR is not
trying to fully align them, but just to fix one particular misalignment
that I am impacted by.

Closes #3091
2024-09-27 11:55:33 +02:00
Kim Morrison
3817b16c35 chore: use separate secrets for commenting and branching in pr-release.yml (#5490)
Hopefully this will resolve the problem of duplicated comments when the
bots post about Mathlib CI status.
2024-09-27 07:27:55 +00:00
Kim Morrison
9eef726204 chore: commit lake-manifest.json when updating lean-pr-testing branches (#5489) 2024-09-27 06:52:24 +00:00
Siddharth
9460f79d28 feat: add sdiv_eq, smod_eq to allow sdiv/smod bitblasting (#5487)
We add lemmas to reduce `sdiv` to `udiv` and `smod` to `umod`, along
with `msb` comparisons which `bv_decide` understands.

We use the same implementation as Bitwuzla, as evidenced by the
following rewrite rules:
[sdiv](f229d64be7/src/rewrite/rewrites_bv.cpp (L3168C30-L3168C42)),
[smod](f229d64be7/src/rewrite/rewrites_bv.cpp (L3282C30-L3282C39)).
2024-09-27 04:46:00 +00:00
Kim Morrison
c38c07e1a1 chore: reverse simp direction for toArray_concat (#5485)
This is mistakenly pushing a `toArray` inwards rather than outwards.
2024-09-27 01:24:12 +00:00
Siddharth
062ecb5eae feat: add udiv/umod bitblasting for bv_decide (#5281)
This PR adds the theorems

```
@[simp]
theorem divRec_zero (qr : DivModState w) :
  divRec w w 0 n d qr  = qr

@[simp]
theorem divRec_succ' (wn : Nat) (qr : DivModState w) :
    divRec w wr (wn + 1) n d qr =
    let r' := shiftConcat qr.r (n.getLsbD wn)
    let input : DivModState w :=
      if r' < d then ⟨qr.q.shiftConcat false, r'⟩ else ⟨qr.q.shiftConcat true, r' - d⟩
    divRec w (wr + 1) wn n d input
```

The final statements may need some masasging to interoperate with
`bv_decide`. We prove the recurrence for unsigned division by building a
shift-subtract circuit, and then showing that this circuit obeys the
division algorithm's invariant.

--- 

A `DivModState` is lawful if the remainder width `wr` plus the dividend
width `wn` equals `w`,
and the bitvectors `r` and `n` have values in the bounds given by
bitwidths `wr`, resp. `wn`.
This is a proof engineering choice: An alternative world could have
`r : BitVec wr` and `n : BitVec wn`, but this required much more
dependent typing coercions.
Instead, we choose to declare all involved bitvectors as length `w`, and
then prove that
the values are within their respective bounds.

---------

Co-authored-by: Tobias Grosser <github@grosser.es>
Co-authored-by: Alex Keizer <alex@keizer.dev>
Co-authored-by: Kim Morrison <scott@tqft.net>
Co-authored-by: Tobias Grosser <tobias@grosser.es>
2024-09-26 23:45:31 +00:00
Henrik Böving
13969ad667 fix: handling BitVec.ofNat with Nat fvars in bv_decide (#5484) 2024-09-26 21:38:18 +00:00
Alex Keizer
91a033488c chore: remove mention of Lean.withSeconds (#5481)
There's a comment on `withHeartbeats` that says "See also
Lean.withSeconds", but his definition does not seem to actually exist.
Hence, I've removed the comment.
2024-09-26 18:15:58 +00:00
Luisa Cicolini
1fb75b68ab feat: add BitVec.(shiftLeft_add_distrib, shiftLeft_ushiftRight) (#5478)
Moved some Nat theorems from Mathlib

---------

Co-authored-by: Tobias Grosser <github@grosser.es>
Co-authored-by: Tobias Grosser <tobias@grosser.es>
2024-09-26 15:51:13 +00:00
Joachim Breitner
26f508db87 test: check that recusive functions do not apply attriubutes twices (#5480)
I suspected a bug based on reading the code, but it seems there is no
bug.
2024-09-26 10:30:37 +00:00
Daniel Weber
3d1ac7cfa2 feat: add lemmas about List.IsPrefix (#5448)
Add iff version of `List.IsPrefix.getElem`, and `eq_of_length_le`
variants of `List.IsInfix.eq_of_length, List.IsPrefix.eq_of_length,
List.IsSuffix.eq_of_length`
2024-09-26 06:58:40 +00:00
Johan Commelin
0196bca784 doc: fix typo in docstring of computeSynthOrder (#5398) 2024-09-26 04:51:23 +00:00
L
b320dcfef9 doc: fix typo in BitVec.mul docstring (#5473)
Seems this was copy-pasted from `BitVec.neg`
2024-09-26 03:11:46 +00:00
Kim Morrison
5dea30f169 feat: @[simp] lemmas about List.toArray (#5472)
We make sure that we can pull `List.toArray` out through all operations
(well, for now "most" rather than "all"). As we also push `Array.toList`
inwards, this hopefully has the effect of them cancelling as they meet,
and `simp` naturally rewriting Array operations into List operations
wherever possible.

This is not at all complete yet.
2024-09-26 00:59:13 +00:00
Kim Morrison
90cb6e5da8 chore: fix typos in Lean.MetavarContext (#5476) 2024-09-26 00:25:03 +00:00
Joachim Breitner
a3ca15d2b2 refactor: back rfl tactic primarily via apply_rfl (#3718)
building upon #3714, this (almost) implements the second half of #3302.

The main effect is that we now get a better error message when `rfl`
fails. For
```lean
example : n+1+m = n + (1+m) := by rfl
```
instead of the wall of text
```
The rfl tactic failed. Possible reasons:
- The goal is not a reflexive relation (neither `=` nor a relation with a @[refl] lemma).
- The arguments of the relation are not equal.
Try using the reflexivity lemma for your relation explicitly, e.g. `exact Eq.refl _` or
`exact HEq.rfl` etc.
n m : Nat
⊢ n + 1 + m = n + (1 + m)
```
we now get
```
error: tactic 'rfl' failed, the left-hand side
  n + 1 + m
is not definitionally equal to the right-hand side
  n + (1 + m)
n m : Nat
⊢ n + 1 + m = n + (1 + m)
```

Unfortunately, because of very subtle differences in semantics (which
transparency setting is used when reducing the goal and whether the
“implicit lambda” feature applies) I could not make this simply the only
`rfl` implementation. So `rfl` remains a macro and is still expanded to
`eq_refl` (difference transparency setting) and `exact Iff.rfl` and
`exact HEq.rfl` (implicit lambda) to not break existing code. This can
be revised later, so this still closes: #3302.

A user might still be puzzled *why* to terms are not defeq. Explaining
that better (“reduced to… and reduces to… etc.”) would also be great,
but that’s not specific to `rfl`, so better left for some other time.
2024-09-25 10:34:42 +00:00
Kim Morrison
c2f6297554 feat: adjust simp attributes on monad lemmas (#5464) 2024-09-25 10:21:18 +00:00
Tobias Grosser
1defa2028f feat: add BitVec.toInt_[intMin|neg|neg_of_ne_intMin ] (#5450) 2024-09-25 10:04:21 +00:00
Joachim Breitner
78c40f380c doc: contradiction docstring indendation (#5470)
Just saw some bad markdown, thought I’ll quickly fix it.
2024-09-25 09:50:21 +00:00
Luisa Cicolini
3e2a465b13 feat: add BitVec.[not_not, allOnes_shiftLeft_or_shiftLeft, allOnes_shiftLeft_and_shiftLeft, one_shiftLeft_mul] (#5469)
Co-authored-by: Tobias Grosser <github@grosser.es>
2024-09-25 09:33:24 +00:00
Sebastian Ullrich
1ec0c64c7b test: remove flaky test (#5468) 2024-09-25 08:18:42 +00:00
Kim Morrison
604bcf50ef chore: upstream some monad lemmas (#5463) 2024-09-25 07:57:26 +00:00
Kim Morrison
145c9efb32 feat: Array.foldX lemmas (#5466) 2024-09-25 07:17:19 +00:00
Kim Morrison
e4f2de0a53 feat: improve Array GetElem lemmas (#5465)
This should be tested against Mathlib, but there are conflicts with the
`nightly-with-mathlib` branch right now, so I'll wait until tomorrow.
2024-09-25 07:17:13 +00:00
Mac Malone
7845a05cf1 chore: update src/lake/lakefie.toml (#5462)
Update the Lake-specific package configuration with the proper root for
the executable (after #5143).
2024-09-25 05:42:52 +00:00
Mac Malone
57679eeff5 fix: typo in run_new_frontend signature (#4685)
Fixes a mixed up between the parameter and global variable for
`json_output` the occurred during some name juggling in #3939.
2024-09-25 05:42:48 +00:00
Kim Morrison
974cc3306c chore: restore @[simp] on Array.swapAt!_def (#5461) 2024-09-25 01:33:53 +00:00
Kim Morrison
c7819bd6eb chore: missing List.set_replicate_self (#5460) 2024-09-25 01:15:24 +00:00
Kim Morrison
a4fb740d2f chore: missing BitVec lemmas (#5459) 2024-09-25 01:06:39 +00:00
Kyle Miller
ea75c924a1 feat: add heq_comm (#5456)
Requested [on
Zulip](https://leanprover.zulipchat.com/#narrow/stream/217875-Is-there-code-for-X.3F/topic/heq_comm/near/472516757).
2024-09-24 23:36:00 +00:00
Kim Morrison
65f4b92505 chore: cleanup of Array docstrings after refactor (#5458)
Sorry this is coming through in tiny pieces; I'm still hitting a
bootstrapping problem and getting things through piecemeal to localise
it.
2024-09-24 23:16:49 +00: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
838 changed files with 3395 additions and 1175 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
@@ -164,10 +164,10 @@ jobs:
# Use GitHub API to check if a comment already exists
existing_comment="$(curl --retry 3 --location --silent \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
"https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments" \
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-mathlib4-bot"))')"
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-bot"))')"
existing_comment_id="$(echo "$existing_comment" | jq -r .id)"
existing_comment_body="$(echo "$existing_comment" | jq -r .body)"
@@ -177,14 +177,14 @@ jobs:
echo "Posting message to the comments: $MESSAGE"
# Append new result to the existing comment or post a new comment
# It's essential we use the MATHLIB4_BOT token here, so that Mathlib CI can subsequently edit the comment.
# It's essential we use the MATHLIB4_COMMENT_BOT token here, so that Mathlib CI can subsequently edit the comment.
if [ -z "$existing_comment_id" ]; then
INTRO="Mathlib CI status ([docs](https://leanprover-community.github.io/contribute/tags_and_branches.html)):"
# Post new comment with a bullet point
echo "Posting as new comment at leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
curl -L -s \
-X POST \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
-d "$(jq --null-input --arg intro "$INTRO" --arg val "$MESSAGE" '{"body":($intro + "\n" + $val)}')" \
"https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
@@ -193,7 +193,7 @@ jobs:
echo "Appending to existing comment at leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments"
curl -L -s \
-X PATCH \
-H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Authorization: token ${{ secrets.MATHLIB4_COMMENT_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
-d "$(jq --null-input --arg existing "$existing_comment_body" --arg message "$MESSAGE" '{"body":($existing + "\n" + $message)}')" \
"https://api.github.com/repos/leanprover/lean4/issues/comments/$existing_comment_id"
@@ -329,16 +329,18 @@ 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
get add lake-manifest.json
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

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

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

@@ -33,6 +33,10 @@ attribute [simp] id_map
@[simp] theorem id_map' [Functor m] [LawfulFunctor m] (x : m α) : (fun a => a) <$> x = x :=
id_map x
@[simp] theorem Functor.map_map [Functor f] [LawfulFunctor f] (m : α β) (g : β γ) (x : f α) :
g <$> m <$> x = (fun a => g (m a)) <$> x :=
(comp_map _ _ _).symm
/--
The `Applicative` typeclass only contains the operations of an applicative functor.
`LawfulApplicative` further asserts that these operations satisfy the laws of an applicative functor:
@@ -83,12 +87,16 @@ class LawfulMonad (m : Type u → Type v) [Monad m] extends LawfulApplicative m
seq_assoc x g h := (by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind])
export LawfulMonad (bind_pure_comp bind_map pure_bind bind_assoc)
attribute [simp] pure_bind bind_assoc
attribute [simp] pure_bind bind_assoc bind_pure_comp
@[simp] theorem bind_pure [Monad m] [LawfulMonad m] (x : m α) : x >>= pure = x := by
show x >>= (fun a => pure (id a)) = x
rw [bind_pure_comp, id_map]
/--
Use `simp [← bind_pure_comp]` rather than `simp [map_eq_pure_bind]`,
as `bind_pure_comp` is in the default simp set, so also using `map_eq_pure_bind` would cause a loop.
-/
theorem map_eq_pure_bind [Monad m] [LawfulMonad m] (f : α β) (x : m α) : f <$> x = x >>= fun a => pure (f a) := by
rw [ bind_pure_comp]
@@ -109,10 +117,21 @@ theorem seq_eq_bind {α β : Type u} [Monad m] [LawfulMonad m] (mf : m (α
theorem seqRight_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x *> y = x >>= fun _ => y := by
rw [seqRight_eq]
simp [map_eq_pure_bind, seq_eq_bind_map, const]
simp only [map_eq_pure_bind, const, seq_eq_bind_map, bind_assoc, pure_bind, id_eq, bind_pure]
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
rw [seqLeft_eq]
simp only [map_eq_pure_bind, seq_eq_bind_map, bind_assoc, pure_bind, const_apply]
@[simp] theorem map_bind [Monad m] [LawfulMonad m] (f : β γ) (x : m α) (g : α m β) :
f <$> (x >>= g) = x >>= fun a => f <$> g a := by
rw [ bind_pure_comp, LawfulMonad.bind_assoc]
simp [bind_pure_comp]
@[simp] theorem bind_map_left [Monad m] [LawfulMonad m] (f : α β) (x : m α) (g : β m γ) :
((f <$> x) >>= fun b => g b) = (x >>= fun a => g (f a)) := by
rw [ bind_pure_comp]
simp only [bind_assoc, pure_bind]
/--
An alternative constructor for `LawfulMonad` which has more

View File

@@ -25,7 +25,7 @@ theorem ext {x y : ExceptT ε m α} (h : x.run = y.run) : x = y := by
@[simp] theorem run_throw [Monad m] : run (throw e : ExceptT ε m β) = pure (Except.error e) := rfl
@[simp] theorem run_bind_lift [Monad m] [LawfulMonad m] (x : m α) (f : α ExceptT ε m β) : run (ExceptT.lift x >>= f : ExceptT ε m β) = x >>= fun a => run (f a) := by
simp[ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont, map_eq_pure_bind]
simp [ExceptT.run, ExceptT.lift, bind, ExceptT.bind, ExceptT.mk, ExceptT.bindCont]
@[simp] theorem bind_throw [Monad m] [LawfulMonad m] (f : α ExceptT ε m β) : (throw e >>= f) = throw e := by
simp [throw, throwThe, MonadExceptOf.throw, bind, ExceptT.bind, ExceptT.bindCont, ExceptT.mk]
@@ -43,7 +43,7 @@ theorem run_bind [Monad m] (x : ExceptT ε m α)
@[simp] theorem run_map [Monad m] [LawfulMonad m] (f : α β) (x : ExceptT ε m α)
: (f <$> x).run = Except.map f <$> x.run := by
simp [Functor.map, ExceptT.map, map_eq_pure_bind]
simp [Functor.map, ExceptT.map, bind_pure_comp]
apply bind_congr
intro a; cases a <;> simp [Except.map]
@@ -62,7 +62,7 @@ protected theorem seqLeft_eq {α β ε : Type u} {m : Type u → Type v} [Monad
intro
| Except.error _ => simp
| Except.ok _ =>
simp [map_eq_pure_bind]; apply bind_congr; intro b;
simp [bind_pure_comp]; apply bind_congr; intro b;
cases b <;> simp [comp, Except.map, const]
protected theorem seqRight_eq [Monad m] [LawfulMonad m] (x : ExceptT ε m α) (y : ExceptT ε m β) : x *> y = const α id <$> x <*> y := by
@@ -175,7 +175,7 @@ theorem ext {x y : StateT σ m α} (h : ∀ s, x.run s = y.run s) : x = y :=
simp [bind, StateT.bind, run]
@[simp] theorem run_map {α β σ : Type u} [Monad m] [LawfulMonad m] (f : α β) (x : StateT σ m α) (s : σ) : (f <$> x).run s = (fun (p : α × σ) => (f p.1, p.2)) <$> x.run s := by
simp [Functor.map, StateT.map, run, map_eq_pure_bind]
simp [Functor.map, StateT.map, run, bind_pure_comp]
@[simp] theorem run_get [Monad m] (s : σ) : (get : StateT σ m σ).run s = pure (s, s) := rfl
@@ -210,13 +210,13 @@ theorem run_bind_lift {α σ : Type u} [Monad m] [LawfulMonad m] (x : m α) (f :
theorem seqRight_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x *> y = const α id <$> x <*> y := by
apply ext; intro s
simp [map_eq_pure_bind, const]
simp [bind_pure_comp, const]
apply bind_congr; intro p; cases p
simp [Prod.eta]
theorem seqLeft_eq [Monad m] [LawfulMonad m] (x : StateT σ m α) (y : StateT σ m β) : x <* y = const β <$> x <*> y := by
apply ext; intro s
simp [map_eq_pure_bind]
simp [bind_pure_comp]
instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
id_map := by intros; apply ext; intros; simp[Prod.eta]
@@ -224,7 +224,7 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
seqLeft_eq := seqLeft_eq
seqRight_eq := seqRight_eq
pure_seq := by intros; apply ext; intros; simp
bind_pure_comp := by intros; apply ext; intros; simp; apply LawfulMonad.bind_pure_comp
bind_pure_comp := by intros; apply ext; intros; simp
bind_map := by intros; rfl
pure_bind := by intros; apply ext; intros; simp
bind_assoc := by intros; apply ext; intros; simp

View File

@@ -823,6 +823,7 @@ theorem iff_iff_implies_and_implies {a b : Prop} : (a ↔ b) ↔ (a → b) ∧ (
protected theorem Iff.rfl {a : Prop} : a a :=
Iff.refl a
-- And, also for backward compatibility, we try `Iff.rfl.` using `exact` (see #5366)
macro_rules | `(tactic| rfl) => `(tactic| exact Iff.rfl)
theorem Iff.of_eq (h : a = b) : a b := h Iff.rfl
@@ -837,6 +838,9 @@ instance : Trans Iff Iff Iff where
theorem Eq.comm {a b : α} : a = b b = a := Iff.intro Eq.symm Eq.symm
theorem eq_comm {a b : α} : a = b b = a := Eq.comm
theorem HEq.comm {a : α} {b : β} : HEq a b HEq b a := Iff.intro HEq.symm HEq.symm
theorem heq_comm {a : α} {b : β} : HEq a b HEq b a := HEq.comm
@[symm] theorem Iff.symm (h : a b) : b a := Iff.intro h.mpr h.mp
theorem Iff.comm: (a b) (b a) := Iff.intro Iff.symm Iff.symm
theorem iff_comm : (a b) (b a) := Iff.comm
@@ -1892,7 +1896,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 -/
@@ -2055,7 +2060,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
@@ -2071,7 +2076,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
@@ -2087,7 +2092,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

@@ -73,8 +73,7 @@ theorem ext' {as bs : Array α} (h : as.toList = bs.toList) : as = bs := by
@[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]
@[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]

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,14 +5,15 @@ 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 hi)
(j : Nat) (hj : j < i) : a[j]'(Nat.lt_of_lt_of_le hj hi) = b[j]'(Nat.lt_of_lt_of_le hj (hsz hi)) := by
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 =>
@@ -25,23 +26,28 @@ theorem eq_of_isEqvAux
subst hj'
exact heqv.left
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 a.size (Nat.le_refl ..) h
exact ext a b hsz fun i h _ => aux i h
next => intro; contradiction
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 isEqvAux_self [DecidableEq α] (a : Array α) (i : Nat) (h : i a.size) :
Array.isEqvAux a a rfl (fun x y => x = y) i h = true := by
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 (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, decide_True, Bool.and_self]
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

@@ -19,12 +19,119 @@ This file contains some theorems about `Array` and `List` needed for `Init.Data.
namespace Array
@[simp] theorem getElem_toList {a : Array α} {i : Nat} (h : i < a.size) : a.toList[i] = a[i] := rfl
@[simp] theorem getElem_mk {xs : List α} {i : Nat} (h : i < xs.length) : (Array.mk xs)[i] = xs[i] := rfl
theorem getElem_eq_getElem_toList {a : Array α} (h : i < a.size) : a[i] = a.toList[i] := by
by_cases i < a.size <;> (try simp [*]) <;> rfl
theorem getElem?_eq_getElem {a : Array α} {i : Nat} (h : i < a.size) : a[i]? = some a[i] :=
getElem?_pos ..
@[simp] theorem getElem?_eq_none_iff {a : Array α} : a[i]? = none a.size i := by
by_cases h : i < a.size
· simp [getElem?_eq_getElem, h]
· rw [getElem?_neg a i h]
simp_all
theorem getElem?_eq {a : Array α} {i : Nat} :
a[i]? = if h : i < a.size then some a[i] else none := by
split
· simp_all [getElem?_eq_getElem]
· simp_all
theorem getElem?_eq_getElem?_toList (a : Array α) (i : Nat) : a[i]? = a.toList[i]? := by
rw [getElem?_eq]
split <;> simp_all
@[deprecated getElem_eq_getElem_toList (since := "2024-09-25")]
abbrev getElem_eq_toList_getElem := @getElem_eq_getElem_toList
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
abbrev getElem_eq_data_getElem := @getElem_eq_getElem_toList
@[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
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
(a.push x)[i] = a[i] := by
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append, List.getElem_append_left, h]
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
simp only [push, getElem_eq_getElem_toList, List.concat_eq_append]
rw [List.getElem_append_right] <;> simp [getElem_eq_getElem_toList, Nat.zero_lt_one]
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
(a.push x)[i] = if h : i < a.size then a[i] else x := by
by_cases h' : i < a.size
· simp [get_push_lt, h']
· simp at h
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
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
@[deprecated "Use the reverse direction of `List.push_toArray`." (since := "2024-09-27")]
theorem toArray_concat {as : List α} {x : α} :
(as ++ [x]).toArray = as.toArray.push x := by
apply ext'
simp
@[simp] theorem push_toArray (l : List α) (a : α) : l.toArray.push a = (l ++ [a]).toArray := by
apply Array.ext'
simp
/-- Unapplied variant of `push_toArray`, useful for monadic reasoning. -/
@[simp] theorem push_toArray_fun (l : List α) : l.toArray.push = fun a => (l ++ [a]).toArray := by
funext a
simp
@[simp] theorem foldrM_toArray [Monad m] (f : α β m β) (init : β) (l : List α) :
l.toArray.foldrM f init = l.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList]
simp
@[simp] theorem foldlM_toArray [Monad m] (f : β α m β) (init : β) (l : List α) :
l.toArray.foldlM f init = l.foldlM f init := by
rw [foldlM_eq_foldlM_toList]
@[simp] theorem foldr_toArray (f : α β β) (init : β) (l : List α) :
l.toArray.foldr f init = l.foldr f init := by
rw [foldr_eq_foldr_toList]
@[simp] theorem foldl_toArray (f : β α β) (init : β) (l : List α) :
l.toArray.foldl f init = l.foldl f init := by
rw [foldl_eq_foldl_toList]
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
| l => ext' (toList_toArray l)
@[simp] theorem toArray_toList (a : Array α) : a.toList.toArray = a := rfl
@[deprecated toArray_toList (since := "2024-09-09")]
abbrev toArray_data := @toArray_toList
@@ -38,20 +145,11 @@ abbrev data_length := @toList_length
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
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
@[deprecated getElem_eq_toList_getElem (since := "2024-09-09")]
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]
/-- 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]
@@ -59,6 +157,7 @@ theorem foldrM_push [Monad m] (f : α → β → m β) (init : β) (arr : Array
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' ..
@@ -68,22 +167,6 @@ theorem foldr_push (f : α → β → β) (init : β) (arr : Array α) (a : α)
@[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 get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
(a.push x)[i] = a[i] := by
simp only [push, getElem_eq_toList_getElem, List.concat_eq_append, List.getElem_append_left, h]
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
simp only [push, getElem_eq_toList_getElem, List.concat_eq_append]
rw [List.getElem_append_right] <;> simp [getElem_eq_toList_getElem, Nat.zero_lt_one]
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
(a.push x)[i] = if h : i < a.size then a[i] else x := by
by_cases h' : i < a.size
· simp [get_push_lt, h']
· simp at h
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
rw [mapM, aux, foldlM_eq_foldlM_toList]; rfl
@@ -186,11 +269,11 @@ theorem get!_eq_getD [Inhabited α] (a : Array α) : a.get! n = a.getD n default
@[simp] theorem getElem_set_eq (a : Array α) (i : Fin a.size) (v : α) {j : Nat}
(eq : i.val = j) (p : j < (a.set i v).size) :
(a.set i v)[j]'p = v := by
simp [set, getElem_eq_toList_getElem, eq]
simp [set, getElem_eq_getElem_toList, eq]
@[simp] theorem getElem_set_ne (a : Array α) (i : Fin a.size) (v : α) {j : Nat} (pj : j < (a.set i v).size)
(h : i.val j) : (a.set i v)[j]'pj = a[j]'(size_set a i v pj) := by
simp only [set, getElem_eq_toList_getElem, List.getElem_set_ne h]
simp only [set, getElem_eq_getElem_toList, List.getElem_set_ne h]
theorem getElem_set (a : Array α) (i : Fin a.size) (v : α) (j : Nat)
(h : j < (a.set i v).size) :
@@ -280,7 +363,7 @@ termination_by n - i
abbrev mkArray_data := @toList_mkArray
@[simp] theorem getElem_mkArray (n : Nat) (v : α) (h : i < (mkArray n v).size) :
(mkArray n v)[i] = v := by simp [Array.getElem_eq_toList_getElem]
(mkArray n v)[i] = v := by simp [Array.getElem_eq_getElem_toList]
/-- # mem -/
@@ -321,7 +404,7 @@ theorem lt_of_getElem {x : α} {a : Array α} {idx : Nat} {hidx : idx < a.size}
hidx
theorem getElem?_mem {l : Array α} {i : Fin l.size} : l[i] l := by
erw [Array.mem_def, getElem_eq_toList_getElem]
erw [Array.mem_def, getElem_eq_getElem_toList]
apply List.get_mem
theorem getElem_fin_eq_toList_get (a : Array α) (i : Fin _) : a[i] = a.toList.get i := rfl
@@ -332,20 +415,17 @@ abbrev getElem_fin_eq_data_get := @getElem_fin_eq_toList_get
@[simp] theorem ugetElem_eq_getElem (a : Array α) {i : USize} (h : i.toNat < a.size) :
a[i] = a[i.toNat] := rfl
theorem getElem?_eq_getElem (a : Array α) (i : Nat) (h : i < a.size) : a[i]? = some a[i] :=
getElem?_pos ..
theorem get?_len_le (a : Array α) (i : Nat) (h : a.size i) : a[i]? = none := by
simp [getElem?_neg, h]
theorem getElem_mem_toList (a : Array α) (h : i < a.size) : a[i] a.toList := by
simp only [getElem_eq_toList_getElem, List.getElem_mem]
simp only [getElem_eq_getElem_toList, List.getElem_mem]
@[deprecated getElem_mem_toList (since := "2024-09-09")]
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?
@@ -399,7 +479,7 @@ abbrev data_set := @toList_set
theorem get_set_eq (a : Array α) (i : Fin a.size) (v : α) :
(a.set i v)[i.1] = v := by
simp only [set, getElem_eq_toList_getElem, List.getElem_set_self]
simp only [set, getElem_eq_getElem_toList, List.getElem_set_self]
theorem get?_set_eq (a : Array α) (i : Fin a.size) (v : α) :
(a.set i v)[i.1]? = v := by simp [getElem?_pos, i.2]
@@ -418,7 +498,7 @@ theorem get_set (a : Array α) (i : Fin a.size) (j : Nat) (hj : j < a.size) (v :
@[simp] theorem get_set_ne (a : Array α) (i : Fin a.size) {j : Nat} (v : α) (hj : j < a.size)
(h : i.1 j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
simp only [set, getElem_eq_toList_getElem, List.getElem_set_ne h]
simp only [set, getElem_eq_getElem_toList, List.getElem_set_ne h]
theorem getElem_setD (a : Array α) (i : Nat) (v : α) (h : i < (setD a i v).size) :
(setD a i v)[i] = v := by
@@ -434,7 +514,7 @@ theorem swap_def (a : Array α) (i j : Fin a.size) :
a.swap i j = (a.set i (a.get j)).set j.1, by simp [j.2] (a.get i) := by
simp [swap, fin_cast_val]
theorem toList_swap (a : Array α) (i j : Fin a.size) :
@[simp] theorem toList_swap (a : Array α) (i j : Fin a.size) :
(a.swap i j).toList = (a.toList.set i (a.get j)).set j (a.get i) := by simp [swap_def]
@[deprecated toList_swap (since := "2024-09-09")]
@@ -447,7 +527,7 @@ theorem get?_swap (a : Array α) (i j : Fin a.size) (k : Nat) : (a.swap i j)[k]?
@[simp] theorem swapAt_def (a : Array α) (i : Fin a.size) (v : α) :
a.swapAt i v = (a[i.1], a.set i v) := rfl
-- @[simp] -- FIXME: gives a weird linter error
@[simp]
theorem swapAt!_def (a : Array α) (i : Nat) (v : α) (h : i < a.size) :
a.swapAt! i v = (a[i], a.set i, h v) := by simp [swapAt!, h]
@@ -520,7 +600,7 @@ abbrev data_range := @toList_range
@[simp]
theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
simp [getElem_eq_toList_getElem]
simp [getElem_eq_getElem_toList]
set_option linter.deprecated false in
@[simp] theorem reverse_toList (a : Array α) : a.reverse.toList = a.toList.reverse := by
@@ -566,6 +646,32 @@ set_option linter.deprecated false in
/-! ### foldl / foldr -/
@[simp] theorem foldlM_loop_empty [Monad m] (f : β α m β) (init : β) (i j : Nat) :
foldlM.loop f #[] s h i j init = pure init := by
unfold foldlM.loop; split
· split
· rfl
· simp at h
omega
· rfl
@[simp] theorem foldlM_empty [Monad m] (f : β α m β) (init : β) :
foldlM f init #[] start stop = return init := by
simp [foldlM]
@[simp] theorem foldrM_fold_empty [Monad m] (f : α β m β) (init : β) (i j : Nat) (h) :
foldrM.fold f #[] i j h init = pure init := by
unfold foldrM.fold
split <;> rename_i h₁
· rfl
· split <;> rename_i h₂
· rfl
· simp at h₂
@[simp] theorem foldrM_empty [Monad m] (f : α β m β) (init : β) :
foldrM f init #[] start stop = return init := by
simp [foldrM]
-- This proof is the pure version of `Array.SatisfiesM_foldlM`,
-- reproduced to avoid a dependency on `SatisfiesM`.
theorem foldl_induction
@@ -609,8 +715,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]
@[deprecated mapM_eq_mapM_toList (since := "2024-09-09")]
abbrev mapM_eq_mapM_data := @mapM_eq_mapM_toList
@@ -751,7 +857,7 @@ theorem get_modify {arr : Array α} {x i} (h : i < arr.size) :
/-! ### filter -/
@[simp] theorem filter_toList (p : α Bool) (l : Array α) :
@[simp] theorem toList_filter (p : α Bool) (l : Array α) :
(l.filter p).toList = l.toList.filter p := by
dsimp only [filter]
rw [foldl_eq_foldl_toList]
@@ -762,23 +868,23 @@ theorem get_modify {arr : Array α} {x i} (h : i < arr.size) :
induction l with simp
| cons => split <;> simp [*]
@[deprecated filter_toList (since := "2024-09-09")]
abbrev filter_data := @filter_toList
@[deprecated toList_filter (since := "2024-09-09")]
abbrev filter_data := @toList_filter
@[simp] theorem filter_filter (q) (l : Array α) :
filter p (filter q l) = filter (fun a => p a && q a) l := by
apply ext'
simp only [filter_toList, List.filter_filter]
simp only [toList_filter, List.filter_filter]
@[simp] theorem mem_filter : x filter p as x as p x := by
simp only [mem_def, filter_toList, List.mem_filter]
simp only [mem_def, toList_filter, List.mem_filter]
theorem mem_of_mem_filter {a : α} {l} (h : a filter p l) : a l :=
(mem_filter.mp h).1
/-! ### filterMap -/
@[simp] theorem filterMap_toList (f : α Option β) (l : Array α) :
@[simp] theorem toList_filterMap (f : α Option β) (l : Array α) :
(l.filterMap f).toList = l.toList.filterMap f := by
dsimp only [filterMap, filterMapM]
rw [foldlM_eq_foldlM_toList]
@@ -791,12 +897,12 @@ theorem mem_of_mem_filter {a : α} {l} (h : a ∈ filter p l) : a ∈ l :=
· simp_all [Id.run, List.filterMap_cons]
split <;> simp_all
@[deprecated filterMap_toList (since := "2024-09-09")]
abbrev filterMap_data := @filterMap_toList
@[deprecated toList_filterMap (since := "2024-09-09")]
abbrev filterMap_data := @toList_filterMap
@[simp] theorem mem_filterMap {f : α Option β} {l : Array α} {b : β} :
b filterMap f l a, a l f a = some b := by
simp only [mem_def, filterMap_toList, List.mem_filterMap]
simp only [mem_def, toList_filterMap, List.mem_filterMap]
/-! ### empty -/
@@ -819,7 +925,7 @@ theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size :=
theorem get_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i < as.size) :
(as ++ bs)[i] = as[i] := by
simp only [getElem_eq_toList_getElem]
simp only [getElem_eq_getElem_toList]
have h' : i < (as.toList ++ bs.toList).length := by rwa [ toList_length, append_toList] at h
conv => rhs; rw [ List.getElem_append_left (bs := bs.toList) (h' := h')]
apply List.get_of_eq; rw [append_toList]
@@ -827,7 +933,7 @@ theorem get_append_left {as bs : Array α} {h : i < (as ++ bs).size} (hlt : i <
theorem get_append_right {as bs : Array α} {h : i < (as ++ bs).size} (hle : as.size i)
(hlt : i - as.size < bs.size := Nat.sub_lt_left_of_lt_add hle (size_append .. h)) :
(as ++ bs)[i] = bs[i - as.size] := by
simp only [getElem_eq_toList_getElem]
simp only [getElem_eq_getElem_toList]
have h' : i < (as.toList ++ bs.toList).length := by rwa [ toList_length, append_toList] at h
conv => rhs; rw [ List.getElem_append_right (h₁ := hle) (h₂ := h')]
apply List.get_of_eq; rw [append_toList]
@@ -975,6 +1081,33 @@ theorem extract_empty_of_size_le_start (as : Array α) {start stop : Nat} (h : a
/-! ### any -/
theorem anyM_loop_cons [Monad m] (p : α m Bool) (a : α) (as : List α) (stop start : Nat) (h : stop + 1 (a :: as).length) :
anyM.loop p a :: as (stop + 1) h (start + 1) = anyM.loop p as stop (by simpa using h) start := by
rw [anyM.loop]
conv => rhs; rw [anyM.loop]
split <;> rename_i h'
· simp only [Nat.add_lt_add_iff_right] at h'
rw [dif_pos h']
rw [anyM_loop_cons]
simp
· rw [dif_neg]
omega
@[simp] theorem anyM_toList [Monad m] (p : α m Bool) (as : Array α) :
as.toList.anyM p = as.anyM p :=
match as with
| [] => rfl
| a :: as => by
simp only [List.anyM, anyM, size_toArray, List.length_cons, Nat.le_refl, reduceDIte]
rw [anyM.loop, dif_pos (by omega)]
congr 1
funext b
split
· simp
· simp only [Bool.false_eq_true, reduceIte]
rw [anyM_loop_cons]
simpa [anyM] using anyM_toList p as
-- Auxiliary for `any_iff_exists`.
theorem anyM_loop_iff_exists {p : α Bool} {as : Array α} {start stop} (h : stop as.size) :
anyM.loop (m := Id) p as stop h start = true
@@ -1019,6 +1152,17 @@ theorem any_def {p : α → Bool} (as : Array α) : as.any p = as.toList.any p :
/-! ### all -/
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α m Bool) (as : Array α) :
allM p as = (! ·) <$> anyM ((! ·) <$> p ·) as := by
dsimp [allM, anyM]
simp
@[simp] theorem allM_toList [Monad m] [LawfulMonad m] (p : α m Bool) (as : Array α) :
as.toList.allM p = as.allM p := by
rw [allM_eq_not_anyM_not]
rw [ anyM_toList]
rw [List.allM_eq_not_anyM_not]
theorem all_eq_not_any_not (p : α Bool) (as : Array α) (start stop) :
all as p start stop = !(any as (!p ·) start stop) := by
dsimp [all, allM]
@@ -1040,10 +1184,10 @@ theorem all_def {p : α → Bool} (as : Array α) : as.all p = as.toList.all p :
rw [Bool.eq_iff_iff, all_eq_true, List.all_eq_true]; simp only [List.mem_iff_getElem]
constructor
· rintro w x r, h, rfl
rw [ getElem_eq_toList_getElem]
rw [ getElem_eq_getElem_toList]
exact w r, h
· intro w i
exact w as[i] i, i.2, (getElem_eq_toList_getElem as i.2).symm
exact w as[i] i, i.2, (getElem_eq_getElem_toList i.2).symm
theorem all_eq_true_iff_forall_mem {l : Array α} : l.all p x, x l p x := by
simp only [all_def, List.all_eq_true, mem_def]
@@ -1115,3 +1259,117 @@ theorem swap_comm (a : Array α) {i j : Fin a.size} : a.swap i j = a.swap j i :=
· split <;> simp_all
end Array
open Array
namespace List
/-!
### More theorems about `List.toArray`, followed by an `Array` operation.
Our goal is to have `simp` "pull `List.toArray` outwards" as much as possible.
-/
@[simp] theorem mem_toArray {a : α} {l : List α} : a l.toArray a l := by
simp [mem_def]
@[simp] theorem getElem?_toArray (l : List α) (i : Nat) : l.toArray[i]? = l[i]? := by
simp [getElem?_eq_getElem?_toList]
@[simp] theorem toListRev_toArray (l : List α) : l.toArray.toListRev = l.reverse := by
simp
@[simp] theorem push_append_toArray (as : Array α) (a : α) (l : List α) :
as.push a ++ l.toArray = as ++ (a :: l).toArray := by
apply ext'
simp
@[simp] theorem mapM_toArray [Monad m] [LawfulMonad m] (f : α m β) (l : List α) :
l.toArray.mapM f = List.toArray <$> l.mapM f := by
simp only [ mapM'_eq_mapM, mapM_eq_foldlM]
suffices init : Array β,
foldlM (fun bs a => bs.push <$> f a) init l.toArray = (init ++ toArray ·) <$> mapM' f l by
simpa using this #[]
intro init
induction l generalizing init with
| nil => simp
| cons a l ih =>
simp only [foldlM_toArray] at ih
rw [size_toArray, mapM'_cons, foldlM_toArray]
simp [ih]
@[simp] theorem map_toArray (f : α β) (l : List α) : l.toArray.map f = (l.map f).toArray := by
apply ext'
simp
@[simp] theorem toArray_appendList (l₁ l₂ : List α) :
l₁.toArray ++ l₂ = (l₁ ++ l₂).toArray := by
apply ext'
simp
@[simp] theorem set_toArray (l : List α) (i : Fin l.toArray.size) (a : α) :
l.toArray.set i a = (l.set i a).toArray := by
apply ext'
simp
@[simp] theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray.size) :
l.toArray.uset i a h = (l.set i.toNat a).toArray := by
apply ext'
simp
@[simp] theorem setD_toArray (l : List α) (i : Nat) (a : α) :
l.toArray.setD i a = (l.set i a).toArray := by
apply ext'
simp only [setD]
split
· simp
· simp_all [List.set_eq_of_length_le]
@[simp] theorem anyM_toArray [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α) :
l.toArray.anyM p = l.anyM p := by
rw [ anyM_toList]
@[simp] theorem any_toArray (p : α Bool) (l : List α) : l.toArray.any p = l.any p := by
rw [Array.any_def]
@[simp] theorem allM_toArray [Monad m] [LawfulMonad m] (p : α m Bool) (l : List α) :
l.toArray.allM p = l.allM p := by
rw [ allM_toList]
@[simp] theorem all_toArray (p : α Bool) (l : List α) : l.toArray.all p = l.all p := by
rw [Array.all_def]
@[simp] theorem swap_toArray (l : List α) (i j : Fin l.toArray.size) :
l.toArray.swap i j = ((l.set i l[j]).set j l[i]).toArray := by
apply ext'
simp
@[simp] theorem pop_toArray (l : List α) : l.toArray.pop = l.dropLast.toArray := by
apply ext'
simp
@[simp] theorem reverse_toArray (l : List α) : l.toArray.reverse = l.reverse.toArray := by
apply ext'
simp
@[simp] theorem filter_toArray (p : α Bool) (l : List α) :
l.toArray.filter p = (l.filter p).toArray := by
apply ext'
erw [toList_filter] -- `erw` required to unify `l.length` with `l.toArray.size`.
@[simp] theorem filterMap_toArray (f : α Option β) (l : List α) :
l.toArray.filterMap f = (l.filterMap f).toArray := by
apply ext'
erw [toList_filterMap] -- `erw` required to unify `l.length` with `l.toArray.size`.
@[simp] theorem append_toArray (l₁ l₂ : List α) :
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
apply ext'
simp
@[simp] theorem toArray_range (n : Nat) : (range n).toArray = Array.range n := by
apply ext'
simp
end List

View File

@@ -59,6 +59,22 @@ def popFront (s : Subarray α) : Subarray α :=
else
s
/--
The empty subarray.
-/
protected def empty : Subarray α where
array := #[]
start := 0
stop := 0
start_le_stop := Nat.le_refl 0
stop_le_array_size := Nat.le_refl 0
instance : EmptyCollection (Subarray α) :=
Subarray.empty
instance : Inhabited (Subarray α) :=
{}
@[inline] unsafe def forInUnsafe {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (s : Subarray α) (b : β) (f : α β m (ForInStep β)) : m β :=
let sz := USize.ofNat s.stop
let rec @[specialize] loop (i : USize) (b : β) : m β := do

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

@@ -269,8 +269,8 @@ Return the absolute value of a signed bitvector.
protected def abs (x : BitVec n) : BitVec n := if x.msb then .neg x else x
/--
Multiplication for bit vectors. This can be interpreted as either signed or unsigned negation
modulo `2^n`.
Multiplication for bit vectors. This can be interpreted as either signed or unsigned
multiplication modulo `2^n`.
SMT-Lib name: `bvmul`.
-/
@@ -676,6 +676,13 @@ result of appending a single bit to the front in the naive implementation).
That is, the new bit is the least significant bit. -/
def concat {n} (msbs : BitVec n) (lsb : Bool) : BitVec (n+1) := msbs ++ (ofBool lsb)
/--
`x.shiftConcat b` shifts all bits of `x` to the left by `1` and sets the least significant bit to `b`.
It is a non-dependent version of `concat` that does not change the total bitwidth.
-/
def shiftConcat (x : BitVec n) (b : Bool) : BitVec n :=
(x.concat b).truncate n
/-- Prepend a single bit to the front of a bitvector, using big endian order (see `append`).
That is, the new bit is the most significant bit. -/
def cons {n} (msb : Bool) (lsbs : BitVec n) : BitVec (n+1) :=

View File

@@ -438,6 +438,386 @@ theorem shiftLeft_eq_shiftLeftRec (x : BitVec w₁) (y : BitVec w₂) :
· simp [of_length_zero]
· simp [shiftLeftRec_eq]
/-! # udiv/urem recurrence for bitblasting
In order to prove the correctness of the division algorithm on the integers,
one shows that `n.div d = q` and `n.mod d = r` iff `n = d * q + r` and `0 ≤ r < d`.
Mnemonic: `n` is the numerator, `d` is the denominator, `q` is the quotient, and `r` the remainder.
This *uniqueness of decomposition* is not true for bitvectors.
For `n = 0, d = 3, w = 3`, we can write:
- `0 = 0 * 3 + 0` (`q = 0`, `r = 0 < 3`.)
- `0 = 2 * 3 + 2 = 6 + 2 ≃ 0 (mod 8)` (`q = 2`, `r = 2 < 3`).
Such examples can be created by choosing different `(q, r)` for a fixed `(d, n)`
such that `(d * q + r)` overflows and wraps around to equal `n`.
This tells us that the division algorithm must have more restrictions than just the ones
we have for integers. These restrictions are captured in `DivModState.Lawful`.
The key idea is to state the relationship in terms of the toNat values of {n, d, q, r}.
If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.udiv d = q` and `n.umod d = r`.
Following this, we implement the division algorithm by repeated shift-subtract.
References:
- Fast 32-bit Division on the DSP56800E: Minimized nonrestoring division algorithm by David Baca
- Bitwuzla sources for bitblasting.h
-/
private theorem Nat.div_add_eq_left_of_lt {x y z : Nat} (hx : z x) (hy : y < z) (hz : 0 < z) :
(x + y) / z = x / z := by
refine Nat.div_eq_of_lt_le ?lo ?hi
· apply Nat.le_trans
· exact div_mul_le_self x z
· omega
· simp only [succ_eq_add_one, Nat.add_mul, Nat.one_mul]
apply Nat.add_lt_add_of_le_of_lt
· apply Nat.le_of_eq
exact (Nat.div_eq_iff_eq_mul_left hz hx).mp rfl
· exact hy
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.udiv d = q`. -/
theorem udiv_eq_of_mul_add_toNat {d n q r : BitVec w} (hd : 0 < d)
(hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n.udiv d = q := by
apply BitVec.eq_of_toNat_eq
rw [toNat_udiv]
replace hdqnr : (d.toNat * q.toNat + r.toNat) / d.toNat = n.toNat / d.toNat := by
simp [hdqnr]
rw [Nat.div_add_eq_left_of_lt] at hdqnr
· rw [ hdqnr]
exact mul_div_right q.toNat hd
· exact Nat.dvd_mul_right d.toNat q.toNat
· exact hrd
· exact hd
/-- If the division equation `d.toNat * q.toNat + r.toNat = n.toNat` holds,
then `n.umod d = r`. -/
theorem umod_eq_of_mul_add_toNat {d n q r : BitVec w} (hrd : r < d)
(hdqnr : d.toNat * q.toNat + r.toNat = n.toNat) :
n.umod d = r := by
apply BitVec.eq_of_toNat_eq
rw [toNat_umod]
replace hdqnr : (d.toNat * q.toNat + r.toNat) % d.toNat = n.toNat % d.toNat := by
simp [hdqnr]
rw [Nat.add_mod, Nat.mul_mod_right] at hdqnr
simp only [Nat.zero_add, mod_mod] at hdqnr
replace hrd : r.toNat < d.toNat := by
simpa [BitVec.lt_def] using hrd
rw [Nat.mod_eq_of_lt hrd] at hdqnr
simp [hdqnr]
/-! ### DivModState -/
/-- `DivModState` is a structure that maintains the state of recursive `divrem` calls. -/
structure DivModState (w : Nat) : Type where
/-- The number of bits in the numerator that are not yet processed -/
wn : Nat
/-- The number of bits in the remainder (and quotient) -/
wr : Nat
/-- The current quotient. -/
q : BitVec w
/-- The current remainder. -/
r : BitVec w
/-- `DivModArgs` contains the arguments to a `divrem` call which remain constant throughout
execution. -/
structure DivModArgs (w : Nat) where
/-- the numerator (aka, dividend) -/
n : BitVec w
/-- the denumerator (aka, divisor)-/
d : BitVec w
/-- A `DivModState` is lawful if the remainder width `wr` plus the numerator width `wn` equals `w`,
and the bitvectors `r` and `n` have values in the bounds given by bitwidths `wr`, resp. `wn`.
This is a proof engineering choice: an alternative world could have been
`r : BitVec wr` and `n : BitVec wn`, but this required much more dependent typing coercions.
Instead, we choose to declare all involved bitvectors as length `w`, and then prove that
the values are within their respective bounds.
We start with `wn = w` and `wr = 0`, and then in each step, we decrement `wn` and increment `wr`.
In this way, we grow a legal remainder in each loop iteration.
-/
structure DivModState.Lawful {w : Nat} (args : DivModArgs w) (qr : DivModState w) : Prop where
/-- The sum of widths of the dividend and remainder is `w`. -/
hwrn : qr.wr + qr.wn = w
/-- The denominator is positive. -/
hdPos : 0 < args.d
/-- The remainder is strictly less than the denominator. -/
hrLtDivisor : qr.r.toNat < args.d.toNat
/-- The remainder is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
hrWidth : qr.r.toNat < 2^qr.wr
/-- The quotient is morally a `Bitvec wr`, and so has value less than `2^wr`. -/
hqWidth : qr.q.toNat < 2^qr.wr
/-- The low `(w - wn)` bits of `n` obey the invariant for division. -/
hdiv : args.n.toNat >>> qr.wn = args.d.toNat * qr.q.toNat + qr.r.toNat
/-- A lawful DivModState implies `w > 0`. -/
def DivModState.Lawful.hw {args : DivModArgs w} {qr : DivModState w}
{h : DivModState.Lawful args qr} : 0 < w := by
have hd := h.hdPos
rcases w with rfl | w
· have hcontra : args.d = 0#0 := by apply Subsingleton.elim
rw [hcontra] at hd
simp at hd
· omega
/-- An initial value with both `q, r = 0`. -/
def DivModState.init (w : Nat) : DivModState w := {
wn := w
wr := 0
q := 0#w
r := 0#w
}
/-- The initial state is lawful. -/
def DivModState.lawful_init {w : Nat} (args : DivModArgs w) (hd : 0#w < args.d) :
DivModState.Lawful args (DivModState.init w) := by
simp only [BitVec.DivModState.init]
exact {
hwrn := by simp only; omega,
hdPos := by assumption
hrLtDivisor := by simp [BitVec.lt_def] at hd ; assumption
hrWidth := by simp [DivModState.init],
hqWidth := by simp [DivModState.init],
hdiv := by
simp only [DivModState.init, toNat_ofNat, zero_mod, Nat.mul_zero, Nat.add_zero];
rw [Nat.shiftRight_eq_div_pow]
apply Nat.div_eq_of_lt args.n.isLt
}
/--
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
quotient has been correctly computed.
-/
theorem DivModState.udiv_eq_of_lawful {n d : BitVec w} {qr : DivModState w}
(h_lawful : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n.udiv d = qr.q := by
apply udiv_eq_of_mul_add_toNat h_lawful.hdPos h_lawful.hrLtDivisor
have hdiv := h_lawful.hdiv
simp only [h_final] at *
omega
/--
A lawful DivModState with a fully consumed dividend (`wn = 0`) witnesses that the
remainder has been correctly computed.
-/
theorem DivModState.umod_eq_of_lawful {qr : DivModState w}
(h : DivModState.Lawful {n, d} qr)
(h_final : qr.wn = 0) :
n.umod d = qr.r := by
apply umod_eq_of_mul_add_toNat h.hrLtDivisor
have hdiv := h.hdiv
simp only [shiftRight_zero] at hdiv
simp only [h_final] at *
exact hdiv.symm
/-! ### DivModState.Poised -/
/--
A `Poised` DivModState is a state which is `Lawful` and furthermore, has at least
one numerator bit left to process `(0 < wn)`
The input to the shift subtractor is a legal input to `divrem`, and we also need to have an
input bit to perform shift subtraction on, and thus we need `0 < wn`.
-/
structure DivModState.Poised {w : Nat} (args : DivModArgs w) (qr : DivModState w)
extends DivModState.Lawful args qr : Type where
/-- Only perform a round of shift-subtract if we have dividend bits. -/
hwn_lt : 0 < qr.wn
/--
In the shift subtract input, the dividend is at least one bit long (`wn > 0`), so
the remainder has bits to be computed (`wr < w`).
-/
def DivModState.wr_lt_w {qr : DivModState w} (h : qr.Poised args) : qr.wr < w := by
have hwrn := h.hwrn
have hwn_lt := h.hwn_lt
omega
/-! ### Division shift subtractor -/
/--
One round of the division algorithm, that tries to perform a subtract shift.
Note that this should only be called when `r.msb = false`, so we will not overflow.
-/
def divSubtractShift (args : DivModArgs w) (qr : DivModState w) : DivModState w :=
let {n, d} := args
let wn := qr.wn - 1
let wr := qr.wr + 1
let r' := shiftConcat qr.r (n.getLsbD wn)
if r' < d then {
q := qr.q.shiftConcat false, -- If `r' < d`, then we do not have a quotient bit.
r := r'
wn, wr
} else {
q := qr.q.shiftConcat true, -- Otherwise, `r' ≥ d`, and we have a quotient bit.
r := r' - d -- we subtract to maintain the invariant that `r < d`.
wn, wr
}
/-- The value of shifting right by `wn - 1` equals shifting by `wn` and grabbing the lsb at `(wn - 1)`. -/
theorem DivModState.toNat_shiftRight_sub_one_eq
{args : DivModArgs w} {qr : DivModState w} (h : qr.Poised args) :
args.n.toNat >>> (qr.wn - 1)
= (args.n.toNat >>> qr.wn) * 2 + (args.n.getLsbD (qr.wn - 1)).toNat := by
show BitVec.toNat (args.n >>> (qr.wn - 1)) = _
have {..} := h -- break the structure down for `omega`
rw [shiftRight_sub_one_eq_shiftConcat args.n h.hwn_lt]
rw [toNat_shiftConcat_eq_of_lt (k := w - qr.wn)]
· simp
· omega
· apply BitVec.toNat_ushiftRight_lt
omega
/--
This is used when proving the correctness of the divison algorithm,
where we know that `r < d`.
We then want to show that `((r.shiftConcat b) - d) < d` as the loop invariant.
In arithmetic, this is the same as showing that
`r * 2 + 1 - d < d`, which this theorem establishes.
-/
private theorem two_mul_add_sub_lt_of_lt_of_lt_two (h : a < x) (hy : y < 2) :
2 * a + y - x < x := by omega
/-- We show that the output of `divSubtractShift` is lawful, which tells us that it
obeys the division equation. -/
theorem lawful_divSubtractShift (qr : DivModState w) (h : qr.Poised args) :
DivModState.Lawful args (divSubtractShift args qr) := by
rcases args with n, d
simp only [divSubtractShift, decide_eq_true_eq]
-- We add these hypotheses for `omega` to find them later.
have hrwn, hd, hrd, hr, hn, hrnd, hwn_lt := h
have : d.toNat * (qr.q.toNat * 2) = d.toNat * qr.q.toNat * 2 := by rw [Nat.mul_assoc]
by_cases rltd : shiftConcat qr.r (n.getLsbD (qr.wn - 1)) < d
· simp only [rltd, reduceIte]
constructor <;> try bv_omega
case pos.hrWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
case pos.hqWidth => apply toNat_shiftConcat_lt_of_lt <;> omega
case pos.hdiv =>
simp [qr.toNat_shiftRight_sub_one_eq h, h.hdiv, this,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth]
omega
· simp only [rltd, reduceIte]
constructor <;> try bv_omega
case neg.hrLtDivisor =>
simp only [lt_def, Nat.not_lt] at rltd
rw [BitVec.toNat_sub_of_le rltd,
toNat_shiftConcat_eq_of_lt (hk := qr.wr_lt_w h) (hx := h.hrWidth),
Nat.mul_comm]
apply two_mul_add_sub_lt_of_lt_of_lt_two <;> bv_omega
case neg.hrWidth =>
simp only
have hdr' : d (qr.r.shiftConcat (n.getLsbD (qr.wn - 1))) :=
BitVec.not_lt_iff_le.mp rltd
have hr' : ((qr.r.shiftConcat (n.getLsbD (qr.wn - 1)))).toNat < 2 ^ (qr.wr + 1) := by
apply toNat_shiftConcat_lt_of_lt <;> bv_omega
rw [BitVec.toNat_sub_of_le hdr']
omega
case neg.hqWidth =>
apply toNat_shiftConcat_lt_of_lt <;> omega
case neg.hdiv =>
have rltd' := (BitVec.not_lt_iff_le.mp rltd)
simp only [qr.toNat_shiftRight_sub_one_eq h,
BitVec.toNat_sub_of_le rltd',
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth]
simp only [BitVec.le_def,
toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hrWidth] at rltd'
simp only [toNat_shiftConcat_eq_of_lt (qr.wr_lt_w h) h.hqWidth, h.hdiv, Nat.mul_add]
bv_omega
/-! ### Core division algorithm circuit -/
/-- A recursive definition of division for bitblasting, in terms of a shift-subtraction circuit. -/
def divRec {w : Nat} (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
DivModState w :=
match m with
| 0 => qr
| m + 1 => divRec m args <| divSubtractShift args qr
@[simp]
theorem divRec_zero (qr : DivModState w) :
divRec 0 args qr = qr := rfl
@[simp]
theorem divRec_succ (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
divRec (m + 1) args qr =
divRec m args (divSubtractShift args qr) := rfl
/-- The output of `divRec` is a lawful state -/
theorem lawful_divRec {args : DivModArgs w} {qr : DivModState w}
(h : DivModState.Lawful args qr) :
DivModState.Lawful args (divRec qr.wn args qr) := by
generalize hm : qr.wn = m
induction m generalizing qr
case zero =>
exact h
case succ wn' ih =>
simp only [divRec_succ]
apply ih
· apply lawful_divSubtractShift
constructor
· assumption
· omega
· simp only [divSubtractShift, hm]
split <;> rfl
/-- The output of `divRec` has no more bits left to process (i.e., `wn = 0`) -/
@[simp]
theorem wn_divRec (args : DivModArgs w) (qr : DivModState w) :
(divRec qr.wn args qr).wn = 0 := by
generalize hm : qr.wn = m
induction m generalizing qr
case zero =>
assumption
case succ wn' ih =>
apply ih
simp only [divSubtractShift, hm]
split <;> rfl
/-- The result of `udiv` agrees with the result of the division recurrence. -/
theorem udiv_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n.udiv d = out.q := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.udiv_eq_of_lawful this (wn_divRec ..)
/-- The result of `umod` agrees with the result of the division recurrence. -/
theorem umod_eq_divRec (hd : 0#w < d) :
let out := divRec w {n, d} (DivModState.init w)
n.umod d = out.r := by
have := DivModState.lawful_init {n, d} hd
have := lawful_divRec this
apply DivModState.umod_eq_of_lawful this (wn_divRec ..)
@[simp]
theorem divRec_succ' (m : Nat) (args : DivModArgs w) (qr : DivModState w) :
divRec (m+1) args qr =
let wn := qr.wn - 1
let wr := qr.wr + 1
let r' := shiftConcat qr.r (args.n.getLsbD wn)
let input : DivModState _ :=
if r' < args.d then {
q := qr.q.shiftConcat false,
r := r'
wn, wr
} else {
q := qr.q.shiftConcat true,
r := r' - args.d
wn, wr
}
divRec m args input := by
simp [divRec_succ, divSubtractShift]
/- ### Arithmetic shift right (sshiftRight) recurrence -/
/--

View File

@@ -11,6 +11,7 @@ import Init.Data.Fin.Lemmas
import Init.Data.Nat.Lemmas
import Init.Data.Nat.Mod
import Init.Data.Int.Bitwise.Lemmas
import Init.Data.Int.Pow
set_option linter.missingDocs true
@@ -164,7 +165,8 @@ theorem getMsbD_eq_getMsb?_getD (x : BitVec w) (i : Nat) :
· simp [getMsb?, h]
· rw [getLsbD_eq_getElem?_getD, getMsb?_eq_getLsb?]
split <;>
· simp
· simp only [getLsb?_eq_getElem?, Bool.and_iff_right_iff_imp, decide_eq_true_eq,
Option.getD_none, Bool.and_eq_false_imp]
intros
omega
@@ -264,11 +266,17 @@ theorem getLsbD_ofNat (n : Nat) (x : Nat) (i : Nat) :
@[simp] theorem getLsbD_zero : (0#w).getLsbD i = false := by simp [getLsbD]
@[simp] theorem getElem_zero (h : i < w) : (0#w)[i] = false := by simp [getElem_eq_testBit_toNat]
@[simp] theorem getMsbD_zero : (0#w).getMsbD i = false := by simp [getMsbD]
@[simp] theorem toNat_mod_cancel (x : BitVec n) : x.toNat % (2^n) = x.toNat :=
Nat.mod_eq_of_lt x.isLt
@[simp] theorem toNat_mod_cancel' {x : BitVec n} :
(x.toNat : Int) % (((2 ^ n) : Nat) : Int) = x.toNat := by
rw_mod_cast [toNat_mod_cancel]
@[simp] theorem sub_toNat_mod_cancel {x : BitVec w} (h : ¬ x = 0#w) :
(2 ^ w - x.toNat) % 2 ^ w = 2 ^ w - x.toNat := by
simp only [toNat_eq, toNat_ofNat, Nat.zero_mod] at h
@@ -296,7 +304,7 @@ theorem getElem?_zero_ofNat_one : (BitVec.ofNat (w+1) 1)[0]? = some true := by
-- This does not need to be a `@[simp]` theorem as it is already handled by `getElem?_eq_getElem`.
theorem getElem?_zero_ofBool (b : Bool) : (ofBool b)[0]? = some b := by
simp [ofBool, cond_eq_if]
simp only [ofBool, ofNat_eq_ofNat, cond_eq_if]
split <;> simp_all
@[simp] theorem getElem_zero_ofBool (b : Bool) : (ofBool b)[0] = b := by
@@ -312,13 +320,20 @@ theorem getLsbD_ofBool (b : Bool) (i : Nat) : (ofBool b).getLsbD i = ((i = 0) &&
· simp only [ofBool, ofNat_eq_ofNat, cond_true, getLsbD_ofNat, Bool.and_true]
by_cases hi : i = 0 <;> simp [hi] <;> omega
@[simp]
theorem getElem_ofBool {b : Bool} {i : Nat} : (ofBool b)[0] = b := by
rcases b with rfl | rfl
· simp [ofBool]
· simp only [ofBool]
by_cases hi : i = 0 <;> simp [hi] <;> omega
/-! ### msb -/
@[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
theorem msb_eq_getLsbD_last (x : BitVec w) :
x.msb = x.getLsbD (w - 1) := by
simp [BitVec.msb, getMsbD, getLsbD]
simp only [BitVec.msb, getMsbD]
rcases w with rfl | w
· simp [BitVec.eq_nil x]
· simp
@@ -346,7 +361,7 @@ theorem toNat_ge_of_msb_true {x : BitVec n} (p : BitVec.msb x = true) : x.toNat
| 0 =>
simp [BitVec.msb, BitVec.getMsbD] at p
| n + 1 =>
simp [BitVec.msb_eq_decide] at p
simp only [msb_eq_decide, Nat.add_one_sub_one, decide_eq_true_eq] at p
simp only [Nat.add_sub_cancel]
exact p
@@ -406,7 +421,7 @@ theorem toInt_eq_toNat_bmod (x : BitVec n) : x.toInt = Int.bmod x.toNat (2^n) :=
/-- Prove equality of bitvectors in terms of nat operations. -/
theorem eq_of_toInt_eq {x y : BitVec n} : x.toInt = y.toInt x = y := by
intro eq
simp [toInt_eq_toNat_cond] at eq
simp only [toInt_eq_toNat_cond] at eq
apply eq_of_toNat_eq
revert eq
have _xlt := x.isLt
@@ -635,10 +650,18 @@ protected theorem extractLsb_ofNat (x n : Nat) (hi lo : Nat) :
@[simp] theorem extractLsb_toNat (hi lo : Nat) (x : BitVec n) :
(extractLsb hi lo x).toNat = (x.toNat >>> lo) % 2^(hi-lo+1) := rfl
@[simp] theorem getElem_extractLsb' {start len : Nat} {x : BitVec n} {i : Nat} (h : i < len) :
(extractLsb' start len x)[i] = x.getLsbD (start+i) := by
simp [getElem_eq_testBit_toNat, getLsbD, h]
@[simp] theorem getLsbD_extractLsb' (start len : Nat) (x : BitVec n) (i : Nat) :
(extractLsb' start len x).getLsbD i = (i < len && x.getLsbD (start+i)) := by
simp [getLsbD, Nat.lt_succ]
@[simp] theorem getElem_extract {hi lo : Nat} {x : BitVec n} {i : Nat} (h : i < hi - lo + 1) :
(extractLsb hi lo x)[i] = getLsbD x (lo+i) := by
simp [getElem_eq_testBit_toNat, getLsbD, h]
@[simp] theorem getLsbD_extract (hi lo : Nat) (x : BitVec n) (i : Nat) :
getLsbD (extractLsb hi lo x) i = (i (hi-lo) && getLsbD x (lo+i)) := by
simp [getLsbD, Nat.lt_succ]
@@ -714,10 +737,16 @@ instance : Std.Commutative (fun (x y : BitVec w) => x ||| y) := ⟨BitVec.or_com
ext i
simp
instance : Std.IdempotentOp (α := BitVec n) (· ||| · ) where
idempotent _ := BitVec.or_self
@[simp] theorem or_zero {x : BitVec w} : x ||| 0#w = x := by
ext i
simp
instance : Std.LawfulCommIdentity (α := BitVec n) (· ||| · ) (0#n) where
right_id _ := BitVec.or_zero
@[simp] theorem zero_or {x : BitVec w} : 0#w ||| x = x := by
ext i
simp
@@ -775,6 +804,9 @@ instance : Std.Commutative (fun (x y : BitVec w) => x &&& y) := ⟨BitVec.and_co
ext i
simp
instance : Std.IdempotentOp (α := BitVec n) (· &&& · ) where
idempotent _ := BitVec.and_self
@[simp] theorem and_zero {x : BitVec w} : x &&& 0#w = 0#w := by
ext i
simp
@@ -787,6 +819,9 @@ instance : Std.Commutative (fun (x y : BitVec w) => x &&& y) := ⟨BitVec.and_co
ext i
simp
instance : Std.LawfulCommIdentity (α := BitVec n) (· &&& · ) (allOnes n) where
right_id _ := BitVec.and_allOnes
@[simp] theorem allOnes_and {x : BitVec w} : allOnes w &&& x = x := by
ext i
simp
@@ -843,6 +878,9 @@ instance : Std.Commutative (fun (x y : BitVec w) => x ^^^ y) := ⟨BitVec.xor_co
ext i
simp
instance : Std.LawfulCommIdentity (α := BitVec n) (· ^^^ · ) (0#n) where
right_id _ := BitVec.xor_zero
@[simp] theorem zero_xor {x : BitVec w} : 0#w ^^^ x = x := by
ext i
simp
@@ -863,8 +901,8 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
rw [ h]
rw [Nat.testBit_two_pow_sub_succ (isLt _)]
· cases w : decide (i < v)
· simp at w
simp [w]
· simp only [decide_eq_false_iff_not, Nat.not_lt] at w
simp only [Bool.false_bne, Bool.false_and]
rw [Nat.testBit_lt_two_pow]
calc BitVec.toNat x < 2 ^ v := isLt _
_ 2 ^ i := Nat.pow_le_pow_of_le_right Nat.zero_lt_two w
@@ -895,6 +933,10 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
ext
simp
@[simp] theorem not_allOnes : ~~~ allOnes w = 0#w := by
ext
simp
@[simp] theorem xor_allOnes {x : BitVec w} : x ^^^ allOnes w = ~~~ x := by
ext i
simp
@@ -903,6 +945,21 @@ theorem not_def {x : BitVec v} : ~~~x = allOnes v ^^^ x := rfl
ext i
simp
@[simp]
theorem not_not {b : BitVec w} : ~~~(~~~b) = b := by
ext i
simp
@[simp] theorem getMsb_not {x : BitVec w} :
(~~~x).getMsbD i = (decide (i < w) && !(x.getMsbD i)) := by
simp only [getMsbD]
by_cases h : i < w
· simp [h]; omega
· simp [h];
@[simp] theorem msb_not {x : BitVec w} : (~~~x).msb = (decide (0 < w) && !x.msb) := by
simp [BitVec.msb]
/-! ### cast -/
@[simp] theorem not_cast {x : BitVec w} (h : w = w') : ~~~(cast h x) = cast h (~~~x) := by
@@ -947,6 +1004,14 @@ theorem zero_shiftLeft (n : Nat) : 0#w <<< n = 0#w := by
cases h₁ : decide (i < m) <;> cases h₂ : decide (n i) <;> cases h₃ : decide (i < n)
all_goals { simp_all <;> omega }
@[simp] theorem getElem_shiftLeft {x : BitVec m} {n : Nat} (h : i < m) :
(x <<< n)[i] = (!decide (i < n) && getLsbD x (i - n)) := by
rw [ testBit_toNat, getElem_eq_testBit_toNat]
simp only [toNat_shiftLeft, Nat.testBit_mod_two_pow, Nat.testBit_shiftLeft, ge_iff_le]
-- This step could be a case bashing tactic.
cases h₁ : decide (i < m) <;> cases h₂ : decide (n i) <;> cases h₃ : decide (i < n)
all_goals { simp_all <;> omega }
theorem shiftLeft_xor_distrib (x y : BitVec w) (n : Nat) :
(x ^^^ y) <<< n = (x <<< n) ^^^ (y <<< n) := by
ext i
@@ -977,7 +1042,8 @@ theorem shiftLeft_or_distrib (x y : BitVec w) (n : Nat) :
simp only [t]
simp only [decide_True, Nat.sub_sub, Bool.true_and, Nat.add_assoc]
by_cases h₁ : k < w <;> by_cases h₂ : w - (1 + k) < i <;> by_cases h₃ : k + i < w
<;> simp [h₁, h₂, h₃]
<;> simp only [h₁, h₂, h₃, decide_False, h₂, decide_True, Bool.not_true, Bool.false_and, Bool.and_self,
Bool.true_and, Bool.false_eq, Bool.false_and, Bool.not_false]
<;> (first | apply getLsbD_ge | apply Eq.symm; apply getLsbD_ge)
<;> omega
@@ -992,6 +1058,14 @@ theorem shiftLeftZeroExtend_eq {x : BitVec w} :
exact Nat.mul_lt_mul_of_pos_right x.isLt (Nat.two_pow_pos _)
· omega
@[simp] theorem getElem_shiftLeftZeroExtend {x : BitVec m} {n : Nat} (h : i < m + n) :
(shiftLeftZeroExtend x n)[i] = ((! decide (i < n)) && getLsbD x (i - n)) := by
rw [shiftLeftZeroExtend_eq, getLsbD]
simp only [getElem_eq_testBit_toNat, getLsbD_shiftLeft, getLsbD_setWidth]
cases h₁ : decide (i < n) <;> cases h₂ : decide (i - n < m + n)
<;> simp_all [h]
<;> omega
@[simp] theorem getLsbD_shiftLeftZeroExtend (x : BitVec m) (n : Nat) :
getLsbD (shiftLeftZeroExtend x n) i = ((! decide (i < n)) && getLsbD x (i - n)) := by
rw [shiftLeftZeroExtend_eq]
@@ -1020,6 +1094,16 @@ theorem shiftLeft_add {w : Nat} (x : BitVec w) (n m : Nat) :
cases h₅ : decide (i < n + m) <;>
simp at * <;> omega
@[simp]
theorem allOnes_shiftLeft_and_shiftLeft {x : BitVec w} {n : Nat} :
BitVec.allOnes w <<< n &&& x <<< n = x <<< n := by
simp [ BitVec.shiftLeft_and_distrib]
@[simp]
theorem allOnes_shiftLeft_or_shiftLeft {x : BitVec w} {n : Nat} :
BitVec.allOnes w <<< n ||| x <<< n = BitVec.allOnes w <<< n := by
simp [ shiftLeft_or_distrib]
@[deprecated shiftLeft_add (since := "2024-06-02")]
theorem shiftLeft_shiftLeft {w : Nat} (x : BitVec w) (n m : Nat) :
(x <<< n) <<< m = x <<< (n + m) := by
@@ -1040,6 +1124,11 @@ theorem getLsbD_shiftLeft' {x : BitVec w₁} {y : BitVec w₂} {i : Nat} :
(x <<< y).getLsbD i = (decide (i < w₁) && !decide (i < y.toNat) && x.getLsbD (i - y.toNat)) := by
simp [shiftLeft_eq', getLsbD_shiftLeft]
@[simp]
theorem getElem_shiftLeft' {x : BitVec w₁} {y : BitVec w₂} {i : Nat} (h : i < w₁) :
(x <<< y)[i] = (!decide (i < y.toNat) && x.getLsbD (i - y.toNat)) := by
simp [shiftLeft_eq', getLsbD_shiftLeft]
/-! ### ushiftRight -/
@[simp, bv_toNat] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) :
@@ -1072,6 +1161,17 @@ theorem ushiftRight_or_distrib (x y : BitVec w) (n : Nat) :
theorem ushiftRight_zero_eq (x : BitVec w) : x >>> 0 = x := by
simp [bv_toNat]
/--
Shifting right by `n < w` yields a bitvector whose value is less than `2 ^ (w - n)`.
-/
theorem toNat_ushiftRight_lt (x : BitVec w) (n : Nat) (hn : n w) :
(x >>> n).toNat < 2 ^ (w - n) := by
rw [toNat_ushiftRight, Nat.shiftRight_eq_div_pow, Nat.div_lt_iff_lt_mul]
· rw [Nat.pow_sub_mul_pow]
· apply x.isLt
· apply hn
· apply Nat.pow_pos (by decide)
/-! ### ushiftRight reductions from BitVec to Nat -/
@[simp]
@@ -1121,7 +1221,7 @@ theorem sshiftRight_eq_of_msb_true {x : BitVec w} {s : Nat} (h : x.msb = true) :
· rw [Nat.shiftRight_eq_div_pow]
apply Nat.lt_of_le_of_lt (Nat.div_le_self _ _) (by omega)
@[simp] theorem getLsbD_sshiftRight (x : BitVec w) (s i : Nat) :
theorem getLsbD_sshiftRight (x : BitVec w) (s i : Nat) :
getLsbD (x.sshiftRight s) i =
(!decide (w i) && if s + i < w then x.getLsbD (s + i) else x.msb) := by
rcases hmsb : x.msb with rfl | rfl
@@ -1142,6 +1242,15 @@ theorem sshiftRight_eq_of_msb_true {x : BitVec w} {s : Nat} (h : x.msb = true) :
Nat.not_lt, decide_eq_true_eq]
omega
theorem getElem_sshiftRight {x : BitVec w} {s i : Nat} (h : i < w) :
(x.sshiftRight s)[i] = (if s + i < w then x.getLsbD (s + i) else x.msb) := by
rcases hmsb : x.msb with rfl | rfl
· simp only [sshiftRight_eq_of_msb_false hmsb, getElem_ushiftRight, Bool.if_false_right,
Bool.iff_and_self, decide_eq_true_eq]
intros hlsb
apply BitVec.lt_of_getLsbD hlsb
· simp [sshiftRight_eq_of_msb_true hmsb]
theorem sshiftRight_xor_distrib (x y : BitVec w) (n : Nat) :
(x ^^^ y).sshiftRight n = (x.sshiftRight n) ^^^ (y.sshiftRight n) := by
ext i
@@ -1179,7 +1288,7 @@ theorem sshiftRight_msb_eq_msb {n : Nat} {x : BitVec w} :
@[simp] theorem sshiftRight_zero {x : BitVec w} : x.sshiftRight 0 = x := by
ext i
simp
simp [getLsbD_sshiftRight]
theorem sshiftRight_add {x : BitVec w} {m n : Nat} :
x.sshiftRight (m + n) = (x.sshiftRight m).sshiftRight n := by
@@ -1196,6 +1305,22 @@ theorem sshiftRight_add {x : BitVec w} {m n : Nat} :
omega
· simp [h₃, sshiftRight_msb_eq_msb]
theorem not_sshiftRight {b : BitVec w} :
~~~b.sshiftRight n = (~~~b).sshiftRight n := by
ext i
simp only [getLsbD_not, Fin.is_lt, decide_True, getLsbD_sshiftRight, Bool.not_and, Bool.not_not,
Bool.true_and, msb_not]
by_cases h : w i
<;> by_cases h' : n + i < w
<;> by_cases h'' : 0 < w
<;> simp [h, h', h'']
<;> omega
@[simp]
theorem not_sshiftRight_not {x : BitVec w} {n : Nat} :
~~~((~~~x).sshiftRight n) = x.sshiftRight n := by
simp [not_sshiftRight]
/-! ### sshiftRight reductions from BitVec to Nat -/
@[simp]
@@ -1226,6 +1351,69 @@ theorem umod_eq {x y : BitVec n} :
theorem toNat_umod {x y : BitVec n} :
(x.umod y).toNat = x.toNat % y.toNat := rfl
/-! ### sdiv -/
/-- Equation theorem for `sdiv` in terms of `udiv`. -/
theorem sdiv_eq (x y : BitVec w) : x.sdiv y =
match x.msb, y.msb with
| false, false => udiv x y
| false, true => - (x.udiv (- y))
| true, false => - ((- x).udiv y)
| true, true => (- x).udiv (- y) := by
rw [BitVec.sdiv]
rcases x.msb <;> rcases y.msb <;> simp
@[bv_toNat]
theorem toNat_sdiv {x y : BitVec w} : (x.sdiv y).toNat =
match x.msb, y.msb with
| false, false => (udiv x y).toNat
| false, true => (- (x.udiv (- y))).toNat
| true, false => (- ((- x).udiv y)).toNat
| true, true => ((- x).udiv (- y)).toNat := by
simp only [sdiv_eq, toNat_udiv]
by_cases h : x.msb <;> by_cases h' : y.msb <;> simp [h, h']
theorem sdiv_eq_and (x y : BitVec 1) : x.sdiv y = x &&& y := by
have hx : x = 0#1 x = 1#1 := by bv_omega
have hy : y = 0#1 y = 1#1 := by bv_omega
rcases hx with rfl | rfl <;>
rcases hy with rfl | rfl <;>
rfl
/-! ### smod -/
/-- Equation theorem for `smod` in terms of `umod`. -/
theorem smod_eq (x y : BitVec w) : x.smod y =
match x.msb, y.msb with
| false, false => x.umod y
| false, true =>
let u := x.umod (- y)
(if u = 0#w then u else u + y)
| true, false =>
let u := umod (- x) y
(if u = 0#w then u else y - u)
| true, true => - ((- x).umod (- y)) := by
rw [BitVec.smod]
rcases x.msb <;> rcases y.msb <;> simp
@[bv_toNat]
theorem toNat_smod {x y : BitVec w} : (x.smod y).toNat =
match x.msb, y.msb with
| false, false => (x.umod y).toNat
| false, true =>
let u := x.umod (- y)
(if u = 0#w then u.toNat else (u + y).toNat)
| true, false =>
let u := (-x).umod y
(if u = 0#w then u.toNat else (y - u).toNat)
| true, true => (- ((- x).umod (- y))).toNat := by
simp only [smod_eq, toNat_umod]
by_cases h : x.msb <;> by_cases h' : y.msb
<;> by_cases h'' : (-x).umod y = 0#w <;> by_cases h''' : x.umod (-y) = 0#w
<;> simp only [h, h', h'', h''']
<;> simp only [umod, toNat_eq, toNat_ofNatLt, toNat_ofNat, Nat.zero_mod] at h'' h'''
<;> simp [h'', h''']
/-! ### signExtend -/
/-- Equation theorem for `Int.sub` when both arguments are `Int.ofNat` -/
@@ -1271,7 +1459,7 @@ theorem signExtend_eq_not_setWidth_not_of_msb_true {x : BitVec w} {v : Nat} (hms
· apply Nat.le_refl
· omega
@[simp] theorem getLsbD_signExtend (x : BitVec w) {v i : Nat} :
theorem getLsbD_signExtend (x : BitVec w) {v i : Nat} :
(x.signExtend v).getLsbD i = (decide (i < v) && if i < w then x.getLsbD i else x.msb) := by
rcases hmsb : x.msb with rfl | rfl
· rw [signExtend_eq_not_setWidth_not_of_msb_false hmsb]
@@ -1279,6 +1467,11 @@ theorem signExtend_eq_not_setWidth_not_of_msb_true {x : BitVec w} {v : Nat} (hms
· rw [signExtend_eq_not_setWidth_not_of_msb_true hmsb]
by_cases (i < v) <;> by_cases (i < w) <;> simp_all <;> omega
theorem getElem_signExtend {x : BitVec w} {v i : Nat} (h : i < v) :
(x.signExtend v)[i] = if i < w then x.getLsbD i else x.msb := by
rw [getLsbD_eq_getElem, getLsbD_signExtend]
simp [h]
/-- Sign extending to a width smaller than the starting width is a truncation. -/
theorem signExtend_eq_setWidth_of_lt (x : BitVec w) {v : Nat} (hv : v w):
x.signExtend v = x.setWidth v := by
@@ -1300,16 +1493,23 @@ theorem append_def (x : BitVec v) (y : BitVec w) :
(x ++ y).toNat = x.toNat <<< n ||| y.toNat :=
rfl
@[simp] theorem getLsbD_append {x : BitVec n} {y : BitVec m} :
theorem getLsbD_append {x : BitVec n} {y : BitVec m} :
getLsbD (x ++ y) i = bif i < m then getLsbD y i else getLsbD x (i - m) := by
simp only [append_def, getLsbD_or, getLsbD_shiftLeftZeroExtend, getLsbD_setWidth']
by_cases h : i < m
· simp [h]
· simp [h]; simp_all
· simp_all [h]
theorem getElem_append {x : BitVec n} {y : BitVec m} (h : i < n + m) :
(x ++ y)[i] = bif i < m then getLsbD y i else getLsbD x (i - m) := by
simp only [append_def, getElem_or, getElem_shiftLeftZeroExtend, getElem_setWidth']
by_cases h' : i < m
· simp [h']
· simp_all [h']
@[simp] theorem getMsbD_append {x : BitVec n} {y : BitVec m} :
getMsbD (x ++ y) i = bif n i then getMsbD y (i - n) else getMsbD x i := by
simp [append_def]
simp only [append_def]
by_cases h : n i
· simp [h]
· simp [h]
@@ -1317,7 +1517,7 @@ theorem append_def (x : BitVec v) (y : BitVec w) :
theorem msb_append {x : BitVec w} {y : BitVec v} :
(x ++ y).msb = bif (w == 0) then (y.msb) else (x.msb) := by
rw [ append_eq, append]
simp [msb_setWidth']
simp only [msb_or, msb_shiftLeftZeroExtend, msb_setWidth']
by_cases h : w = 0
· subst h
simp [BitVec.msb, getMsbD]
@@ -1336,6 +1536,10 @@ theorem msb_append {x : BitVec w} {y : BitVec v} :
rw [getLsbD_append]
simpa using lt_of_getLsbD
@[simp] theorem zero_append_zero : 0#v ++ 0#w = 0#(v + w) := by
ext
simp only [getLsbD_append, getLsbD_zero, Bool.cond_self]
@[simp] theorem cast_append_right (h : w + v = w + v') (x : BitVec w) (y : BitVec v) :
cast h (x ++ y) = x ++ cast (by omega) y := by
ext
@@ -1350,7 +1554,7 @@ theorem msb_append {x : BitVec w} {y : BitVec v} :
@[simp] theorem cast_append_left (h : w + v = w' + v) (x : BitVec w) (y : BitVec v) :
cast h (x ++ y) = cast (by omega) x ++ y := by
ext
simp
simp [getLsbD_append]
theorem setWidth_append {x : BitVec w} {y : BitVec v} :
(x ++ y).setWidth k = if h : k v then y.setWidth k else (x.setWidth (k - v) ++ y).cast (by omega) := by
@@ -1361,9 +1565,9 @@ theorem setWidth_append {x : BitVec w} {y : BitVec v} :
· have t : i < v := by omega
simp [t]
· by_cases t : i < v
· simp [t]
· simp [t, getLsbD_append]
· have t' : i - v < k - v := by omega
simp [t, t']
simp [t, t', getLsbD_append]
@[simp] theorem setWidth_append_of_eq {x : BitVec v} {y : BitVec w} (h : w' = w) : setWidth (v' + w') (x ++ y) = setWidth v' x ++ setWidth w' y := by
subst h
@@ -1391,25 +1595,40 @@ theorem setWidth_append {x : BitVec w} {y : BitVec v} :
(x₁ ++ y₁) &&& (x₂ ++ y₂) = (x₁ &&& x₂) ++ (y₁ &&& y₂) := by
ext i
simp only [getLsbD_append, cond_eq_if]
split <;> simp [*]
split <;> simp [getLsbD_append, *]
@[simp] theorem or_append {x₁ x₂ : BitVec w} {y₁ y₂ : BitVec v} :
(x₁ ++ y₁) ||| (x₂ ++ y₂) = (x₁ ||| x₂) ++ (y₁ ||| y₂) := by
ext i
simp only [getLsbD_append, cond_eq_if]
split <;> simp [*]
split <;> simp [getLsbD_append, *]
@[simp] theorem xor_append {x₁ x₂ : BitVec w} {y₁ y₂ : BitVec v} :
(x₁ ++ y₁) ^^^ (x₂ ++ y₂) = (x₁ ^^^ x₂) ++ (y₁ ^^^ y₂) := by
ext i
simp only [getLsbD_append, cond_eq_if]
split <;> simp [*]
split <;> simp [getLsbD_append, *]
theorem shiftRight_add {w : Nat} (x : BitVec w) (n m : Nat) :
x >>> (n + m) = (x >>> n) >>> m:= by
ext i
simp [Nat.add_assoc n m i]
theorem shiftLeft_ushiftRight {x : BitVec w} {n : Nat}:
x >>> n <<< n = x &&& BitVec.allOnes w <<< n := by
induction n generalizing x
case zero =>
ext; simp
case succ n ih =>
rw [BitVec.shiftLeft_add, Nat.add_comm, BitVec.shiftRight_add, ih,
Nat.add_comm, BitVec.shiftLeft_add, BitVec.shiftLeft_and_distrib]
ext i
by_cases hw : w = 0
· simp [hw]
· by_cases hi₂ : i.val = 0
· simp [hi₂]
· simp [Nat.lt_one_iff, hi₂, show 1 + (i.val - 1) = i by omega]
@[deprecated shiftRight_add (since := "2024-06-02")]
theorem shiftRight_shiftRight {w : Nat} (x : BitVec w) (n m : Nat) :
(x >>> n) >>> m = x >>> (n + m) := by
@@ -1419,7 +1638,13 @@ theorem shiftRight_shiftRight {w : Nat} (x : BitVec w) (n m : Nat) :
theorem getLsbD_rev (x : BitVec w) (i : Fin w) :
x.getLsbD i.rev = x.getMsbD i := by
simp [getLsbD, getMsbD]
simp only [getLsbD, Fin.val_rev, getMsbD, Fin.is_lt, decide_True, Bool.true_and]
congr 1
omega
theorem getElem_rev {x : BitVec w} {i : Fin w}:
x[i.rev] = x.getMsbD i := by
simp only [Fin.getElem_fin, Fin.val_rev, getMsbD, Fin.is_lt, decide_True, Bool.true_and]
congr 1
omega
@@ -1442,15 +1667,30 @@ theorem toNat_cons' {x : BitVec w} :
(cons a x).toNat = (a.toNat <<< w) + x.toNat := by
simp [cons, Nat.shiftLeft_eq, Nat.mul_comm _ (2^w), Nat.mul_add_lt_is_or, x.isLt]
@[simp] theorem getLsbD_cons (b : Bool) {n} (x : BitVec n) (i : Nat) :
theorem getLsbD_cons (b : Bool) {n} (x : BitVec n) (i : Nat) :
getLsbD (cons b x) i = if i = n then b else getLsbD x i := by
simp only [getLsbD, toNat_cons, Nat.testBit_or]
simp only [getLsbD, toNat_cons, Nat.testBit_or, Nat.testBit_shiftLeft, ge_iff_le]
rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i
· have p1 : ¬(n i) := by omega
have p2 : i n := by omega
simp [p1, p2]
· simp only [i_eq_n, ge_iff_le, Nat.le_refl, decide_True, Nat.sub_self, Nat.testBit_zero,
Bool.true_and, testBit_toNat, getLsbD_ge, Bool.or_false, reduceIte]
cases b <;> trivial
· have p1 : i n := by omega
have p2 : i - n 0 := by omega
simp [p1, p2, Nat.testBit_bool_to_nat]
theorem getElem_cons {b : Bool} {n} {x : BitVec n} {i : Nat} (h : i < n + 1) :
(cons b x)[i] = if i = n then b else getLsbD x i := by
simp only [getElem_eq_testBit_toNat, toNat_cons, Nat.testBit_or, getLsbD]
rw [Nat.testBit_shiftLeft]
rcases Nat.lt_trichotomy i n with i_lt_n | i_eq_n | n_lt_i
· have p1 : ¬(n i) := by omega
have p2 : i n := by omega
simp [p1, p2]
· simp [i_eq_n, testBit_toNat]
· simp only [i_eq_n, ge_iff_le, Nat.le_refl, decide_True, Nat.sub_self, Nat.testBit_zero,
Bool.true_and, testBit_toNat, getLsbD_ge, Bool.or_false, reduceIte]
cases b <;> trivial
· have p1 : i n := by omega
have p2 : i - n 0 := by omega
@@ -1476,15 +1716,19 @@ theorem setWidth_succ (x : BitVec w) :
have j_lt : j.val < i := Nat.lt_of_le_of_ne (Nat.le_of_succ_le_succ j.isLt) j_eq
simp [j_eq, j_lt]
theorem eq_msb_cons_setWidth (x : BitVec (w+1)) : x = (cons x.msb (x.setWidth w)) := by
@[simp] theorem cons_msb_setWidth (x : BitVec (w+1)) : (cons x.msb (x.setWidth w)) = x := by
ext i
simp
simp only [getLsbD_cons]
split <;> rename_i h
· simp [BitVec.msb, getMsbD, h]
· by_cases h' : i < w
· simp_all
· omega
@[deprecated "Use the reverse direction of `cons_msb_setWidth`"]
theorem eq_msb_cons_setWidth (x : BitVec (w+1)) : x = (cons x.msb (x.setWidth w)) := by
simp
@[simp] theorem not_cons (x : BitVec w) (b : Bool) : ~~~(cons b x) = cons (!b) (~~~x) := by
simp [cons]
@@ -1521,12 +1765,27 @@ theorem getLsbD_concat (x : BitVec w) (b : Bool) (i : Nat) :
· simp [Nat.mod_eq_of_lt b.toNat_lt]
· simp [Nat.div_eq_of_lt b.toNat_lt, Nat.testBit_add_one]
theorem getElem_concat (x : BitVec w) (b : Bool) (i : Nat) (h : i < w + 1) :
(concat x b)[i] = if i = 0 then b else x.getLsbD (i - 1) := by
simp only [concat, getElem_eq_testBit_toNat, getLsbD, toNat_append,
toNat_ofBool, Nat.testBit_or, Nat.shiftLeft_eq]
cases i
· simp [Nat.mod_eq_of_lt b.toNat_lt]
· simp [Nat.div_eq_of_lt b.toNat_lt, Nat.testBit_add_one]
@[simp] theorem getLsbD_concat_zero : (concat x b).getLsbD 0 = b := by
simp [getLsbD_concat]
@[simp] theorem getElem_concat_zero : (concat x b)[0] = b := by
simp [getElem_concat]
@[simp] theorem getLsbD_concat_succ : (concat x b).getLsbD (i + 1) = x.getLsbD i := by
simp [getLsbD_concat]
@[simp] theorem getElem_concat_succ {x : BitVec w} {i : Nat} (h : i < w) :
(concat x b)[i + 1] = x[i] := by
simp [getElem_concat, h, getLsbD_eq_getElem]
@[simp] theorem not_concat (x : BitVec w) (b : Bool) : ~~~(concat x b) = concat (~~~x) !b := by
ext i; cases i using Fin.succRecOn <;> simp [*, Nat.succ_lt_succ]
@@ -1542,6 +1801,55 @@ theorem getLsbD_concat (x : BitVec w) (b : Bool) (i : Nat) :
(concat x a) ^^^ (concat y b) = concat (x ^^^ y) (a ^^ b) := by
ext i; cases i using Fin.succRecOn <;> simp
/-! ### shiftConcat -/
theorem getLsbD_shiftConcat (x : BitVec w) (b : Bool) (i : Nat) :
(shiftConcat x b).getLsbD i
= (decide (i < w) && (if (i = 0) then b else x.getLsbD (i - 1))) := by
simp only [shiftConcat, getLsbD_setWidth, getLsbD_concat]
theorem getLsbD_shiftConcat_eq_decide (x : BitVec w) (b : Bool) (i : Nat) :
(shiftConcat x b).getLsbD i
= (decide (i < w) && ((decide (i = 0) && b) || (decide (0 < i) && x.getLsbD (i - 1)))) := by
simp only [getLsbD_shiftConcat]
split <;> simp [*, show ((0 < i) ¬(i = 0)) by omega]
theorem shiftRight_sub_one_eq_shiftConcat (n : BitVec w) (hwn : 0 < wn) :
n >>> (wn - 1) = (n >>> wn).shiftConcat (n.getLsbD (wn - 1)) := by
ext i
simp only [getLsbD_ushiftRight, getLsbD_shiftConcat, Fin.is_lt, decide_True, Bool.true_and]
split
· simp [*]
· congr 1; omega
@[simp, bv_toNat]
theorem toNat_shiftConcat {x : BitVec w} {b : Bool} :
(x.shiftConcat b).toNat
= (x.toNat <<< 1 + b.toNat) % 2 ^ w := by
simp [shiftConcat, Nat.shiftLeft_eq]
/-- `x.shiftConcat b` does not overflow if `x < 2^k` for `k < w`, and so
`x.shiftConcat b |>.toNat = x.toNat * 2 + b.toNat`. -/
theorem toNat_shiftConcat_eq_of_lt {x : BitVec w} {b : Bool} {k : Nat}
(hk : k < w) (hx : x.toNat < 2 ^ k) :
(x.shiftConcat b).toNat = x.toNat * 2 + b.toNat := by
simp only [toNat_shiftConcat, Nat.shiftLeft_eq, Nat.pow_one]
have : 2 ^ k < 2 ^ w := Nat.pow_lt_pow_of_lt (by omega) (by omega)
have : 2 ^ k * 2 2 ^ w := (Nat.pow_lt_pow_iff_pow_mul_le_pow (by omega)).mp this
rw [Nat.mod_eq_of_lt (by cases b <;> simp [bv_toNat] <;> omega)]
theorem toNat_shiftConcat_lt_of_lt {x : BitVec w} {b : Bool} {k : Nat}
(hk : k < w) (hx : x.toNat < 2 ^ k) :
(x.shiftConcat b).toNat < 2 ^ (k + 1) := by
rw [toNat_shiftConcat_eq_of_lt hk hx]
have : 2 ^ (k + 1) 2 ^ w := Nat.pow_le_pow_of_le_right (by decide) (by assumption)
have := Bool.toNat_lt b
omega
@[simp] theorem zero_concat_false : concat 0#w false = 0#(w + 1) := by
ext
simp [getLsbD_concat]
/-! ### add -/
theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := rfl
@@ -1592,6 +1900,15 @@ theorem ofInt_add {n} (x y : Int) : BitVec.ofInt n (x + y) =
apply eq_of_toInt_eq
simp
@[simp]
theorem shiftLeft_add_distrib {x y : BitVec w} {n : Nat} :
(x + y) <<< n = x <<< n + y <<< n := by
induction n
case zero =>
simp
case succ n ih =>
simp [ih, toNat_eq, Nat.shiftLeft_eq, Nat.add_mul]
/-! ### sub/neg -/
theorem sub_def {n} (x y : BitVec n) : x - y = .ofNat n ((2^n - y.toNat) + x.toNat) := by rfl
@@ -1631,13 +1948,28 @@ theorem ofNat_sub_ofNat {n} (x y : Nat) : BitVec.ofNat n x - BitVec.ofNat n y =
@[simp, bv_toNat] theorem toNat_neg (x : BitVec n) : (- x).toNat = (2^n - x.toNat) % 2^n := by
simp [Neg.neg, BitVec.neg]
theorem toInt_neg {x : BitVec w} :
(-x).toInt = (-x.toInt).bmod (2 ^ w) := by
simp only [toInt_eq_toNat_bmod, toNat_neg, Int.ofNat_emod, Int.emod_bmod_congr]
rw [ Int.subNatNat_of_le (by omega), Int.subNatNat_eq_coe, Int.sub_eq_add_neg, Int.add_comm,
Int.bmod_add_cancel]
by_cases h : x.toNat < ((2 ^ w) + 1) / 2
· rw [Int.bmod_pos (x := x.toNat)]
all_goals simp only [toNat_mod_cancel']
norm_cast
· rw [Int.bmod_neg (x := x.toNat)]
· simp only [toNat_mod_cancel']
rw_mod_cast [Int.neg_sub, Int.sub_eq_add_neg, Int.add_comm, Int.bmod_add_cancel]
· norm_cast
simp_all
@[simp] theorem toFin_neg (x : BitVec n) :
(-x).toFin = Fin.ofNat' (2^n) (2^n - x.toNat) :=
rfl
theorem sub_toAdd {n} (x y : BitVec n) : x - y = x + - y := by
apply eq_of_toNat_eq
simp
simp only [toNat_sub, toNat_add, toNat_neg, Nat.add_mod_mod]
rw [Nat.add_comm]
@[simp] theorem neg_zero (n:Nat) : -BitVec.ofNat n 0 = BitVec.ofNat n 0 := by apply eq_of_toNat_eq ; simp
@@ -1686,6 +2018,17 @@ theorem neg_ne_iff_ne_neg {x y : BitVec w} : -x ≠ y ↔ x ≠ -y := by
subst h'
simp at h
/-! ### abs -/
@[simp, bv_toNat]
theorem toNat_abs {x : BitVec w} : x.abs.toNat = if x.msb then 2^w - x.toNat else x.toNat := by
simp only [BitVec.abs, neg_eq]
by_cases h : x.msb = true
· simp only [h, reduceIte, toNat_neg]
have : 2 * x.toNat 2 ^ w := BitVec.msb_eq_true_iff_two_mul_ge.mp h
rw [Nat.mod_eq_of_lt (by omega)]
· simp [h]
/-! ### mul -/
theorem mul_def {n} {x y : BitVec n} : x * y = (ofFin <| x.toFin * y.toFin) := by rfl
@@ -1724,6 +2067,15 @@ theorem BitVec.mul_add {x y z : BitVec w} :
rw [Nat.mul_mod, Nat.mod_mod (y.toNat + z.toNat),
Nat.mul_mod, Nat.mul_add]
theorem mul_succ {x y : BitVec w} : x * (y + 1#w) = x * y + x := by simp [BitVec.mul_add]
theorem succ_mul {x y : BitVec w} : (x + 1#w) * y = x * y + y := by simp [BitVec.mul_comm, BitVec.mul_add]
theorem mul_two {x : BitVec w} : x * 2#w = x + x := by
have : 2#w = 1#w + 1#w := by apply BitVec.eq_of_toNat_eq; simp
simp [this, mul_succ]
theorem two_mul {x : BitVec w} : 2#w * x = x + x := by rw [BitVec.mul_comm, mul_two]
@[simp, bv_toNat] theorem toInt_mul (x y : BitVec w) :
(x * y).toInt = (x.toInt * y.toInt).bmod (2^w) := by
simp [toInt_eq_toNat_bmod]
@@ -1799,6 +2151,10 @@ protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y → x.umod y < y
simp only [ofNat_eq_ofNat, lt_def, toNat_ofNat, Nat.zero_mod, umod, toNat_ofNatLt]
apply Nat.mod_lt
theorem not_lt_iff_le {x y : BitVec w} : (¬ x < y) y x := by
constructor <;>
(intro h; simp only [lt_def, Nat.not_lt, le_def] at h ; omega)
/-! ### ofBoolList -/
@[simp] theorem getMsbD_ofBoolListBE : (ofBoolListBE bs).getMsbD i = bs.getD i false := by
@@ -1808,6 +2164,13 @@ protected theorem umod_lt (x : BitVec n) {y : BitVec n} : 0 < y → x.umod y < y
(ofBoolListBE bs).getLsbD i = (decide (i < bs.length) && bs.getD (bs.length - 1 - i) false) := by
simp [getLsbD_eq_getMsbD]
@[simp] theorem getElem_ofBoolListBE (h : i < bs.length) :
(ofBoolListBE bs)[i] = bs[bs.length - 1 - i] := by
rw [ getLsbD_eq_getElem, getLsbD_ofBoolListBE]
simp only [h, decide_True, List.getD_eq_getElem?_getD, Bool.true_and]
rw [List.getElem?_eq_getElem (by omega)]
simp
@[simp] theorem getLsb_ofBoolListLE : (ofBoolListLE bs).getLsbD i = bs.getD i false := by
induction bs generalizing i <;> cases i <;> simp_all [ofBoolListLE]
@@ -2037,6 +2400,27 @@ theorem twoPow_zero {w : Nat} : twoPow w 0 = 1#w := by
theorem getLsbD_one {w i : Nat} : (1#w).getLsbD i = (decide (0 < w) && decide (0 = i)) := by
rw [ twoPow_zero, getLsbD_twoPow]
theorem shiftLeft_eq_mul_twoPow (x : BitVec w) (n : Nat) :
x <<< n = x * (BitVec.twoPow w n) := by
ext i
simp [getLsbD_shiftLeft, Fin.is_lt, decide_True, Bool.true_and, mul_twoPow_eq_shiftLeft]
/- ### cons -/
@[simp] theorem true_cons_zero : cons true 0#w = twoPow (w + 1) w := by
ext
simp [getLsbD_cons]
omega
@[simp] theorem false_cons_zero : cons false 0#w = 0#(w + 1) := by
ext
simp [getLsbD_cons]
@[simp] theorem zero_concat_true : concat 0#w true = 1#(w + 1) := by
ext
simp [getLsbD_concat]
omega
/- ### setWidth, setWidth, and bitwise operations -/
/--
@@ -2129,10 +2513,28 @@ theorem getLsbD_intMin (w : Nat) : (intMin w).getLsbD i = decide (i + 1 = w) :=
simp only [intMin, getLsbD_twoPow, boolToPropSimps]
omega
/--
The RHS is zero in case `w = 0` which is modeled by wrapping the expression in `... % 2 ^ w`.
-/
@[simp, bv_toNat]
theorem toNat_intMin : (intMin w).toNat = 2 ^ (w - 1) % 2 ^ w := by
simp [intMin]
/--
The RHS is zero in case `w = 0` which is modeled by wrapping the expression in `... % 2 ^ w`.
-/
@[simp]
theorem toInt_intMin {w : Nat} :
(intMin w).toInt = -((2 ^ (w - 1) % 2 ^ w) : Nat) := by
by_cases h : w = 0
· subst h
simp [BitVec.toInt]
· have w_pos : 0 < w := by omega
simp only [BitVec.toInt, toNat_intMin, w_pos, Nat.two_pow_pred_mod_two_pow,
Int.two_pow_pred_sub_two_pow, ite_eq_right_iff]
rw [Nat.mul_comm]
simp [w_pos]
@[simp]
theorem neg_intMin {w : Nat} : -intMin w = intMin w := by
by_cases h : 0 < w
@@ -2140,6 +2542,22 @@ theorem neg_intMin {w : Nat} : -intMin w = intMin w := by
· simp only [Nat.not_lt, Nat.le_zero_eq] at h
simp [bv_toNat, h]
theorem toInt_neg_of_ne_intMin {x : BitVec w} (rs : x intMin w) :
(-x).toInt = -(x.toInt) := by
simp only [ne_eq, toNat_eq, toNat_intMin] at rs
by_cases x_zero : x = 0
· subst x_zero
simp [BitVec.toInt]
omega
by_cases w_0 : w = 0
· subst w_0
simp [BitVec.eq_nil x]
have : 0 < w := by omega
rw [Nat.two_pow_pred_mod_two_pow (by omega)] at rs
simp only [BitVec.toInt, BitVec.toNat_neg, BitVec.sub_toNat_mod_cancel x_zero]
have := @Nat.two_pow_pred_mul_two w (by omega)
split <;> split <;> omega
/-! ### intMax -/
/-- The bitvector of width `w` that has the largest value when interpreted as an integer. -/
@@ -2173,6 +2591,11 @@ theorem getLsbD_intMax (w : Nat) : (intMax w).getLsbD i = decide (i + 1 < w) :=
/-! ### Non-overflow theorems -/
/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow. -/
theorem toNat_add_of_lt {w} {x y : BitVec w} (h : x.toNat + y.toNat < 2^w) :
(x + y).toNat = x.toNat + y.toNat := by
rw [BitVec.toNat_add, Nat.mod_eq_of_lt h]
/--
If `y ≤ x`, then the subtraction `(x - y)` does not overflow.
Thus, `(x - y).toNat = x.toNat - y.toNat`
@@ -2186,6 +2609,88 @@ theorem toNat_sub_of_le {x y : BitVec n} (h : y ≤ x) :
· have : 2 ^ n - y.toNat + x.toNat = 2 ^ n + (x.toNat - y.toNat) := by omega
rw [this, Nat.add_mod_left, Nat.mod_eq_of_lt (by omega)]
/--
If `y > x`, then the subtraction `(x - y)` *does* overflow, and the result is the wraparound.
Thus, `(x - y).toNat = 2^w - (y.toNat - x.toNat)`.
-/
theorem toNat_sub_of_lt {x y : BitVec w} (h : x < y) :
(x - y).toNat = 2^w - (y.toNat - x.toNat) := by
simp only [toNat_sub]
rw [Nat.mod_eq_of_lt (by bv_omega)]
bv_omega
/-- If `x.toNat * y.toNat < 2^w`, then the multiplication `(x * y)` does not overflow.
Thus, `(x * y).toNat = x.toNat * y.toNat`.
-/
theorem toNat_mul_of_lt {w} {x y : BitVec w} (h : x.toNat * y.toNat < 2^w) :
(x * y).toNat = x.toNat * y.toNat := by
rw [BitVec.toNat_mul, Nat.mod_eq_of_lt h]
/-! ### Decidable quantifiers -/
theorem forall_zero_iff {P : BitVec 0 Prop} :
( v, P v) P 0#0 := by
constructor
· intro h
apply h
· intro h v
obtain (rfl : v = 0#0) := (by ext i, h; simp at h)
apply h
theorem forall_cons_iff {P : BitVec (n + 1) Prop} :
( v : BitVec (n + 1), P v) ( (x : Bool) (v : BitVec n), P (v.cons x)) := by
constructor
· intro h _ _
apply h
· intro h v
have w : v = (v.setWidth n).cons v.msb := by simp
rw [w]
apply h
instance instDecidableForallBitVecZero (P : BitVec 0 Prop) :
[Decidable (P 0#0)], Decidable ( v, P v)
| .isTrue h => .isTrue fun v => by
obtain (rfl : v = 0#0) := (by ext i, h; cases h)
exact h
| .isFalse h => .isFalse (fun w => h (w _))
instance instDecidableForallBitVecSucc (P : BitVec (n+1) Prop) [DecidablePred P]
[Decidable ( (x : Bool) (v : BitVec n), P (v.cons x))] : Decidable ( v, P v) :=
decidable_of_iff' ( x (v : BitVec n), P (v.cons x)) forall_cons_iff
instance instDecidableExistsBitVecZero (P : BitVec 0 Prop) [Decidable (P 0#0)] :
Decidable ( v, P v) :=
decidable_of_iff (¬ v, ¬ P v) Classical.not_forall_not
instance instDecidableExistsBitVecSucc (P : BitVec (n+1) Prop) [DecidablePred P]
[Decidable ( (x : Bool) (v : BitVec n), ¬ P (v.cons x))] : Decidable ( v, P v) :=
decidable_of_iff (¬ v, ¬ P v) Classical.not_forall_not
/--
For small numerals this isn't necessary (as typeclass search can use the above two instances),
but for large numerals this provides a shortcut.
Note, however, that for large numerals the decision procedure may be very slow,
and you should use `bv_decide` if possible.
-/
instance instDecidableForallBitVec :
(n : Nat) (P : BitVec n Prop) [DecidablePred P], Decidable ( v, P v)
| 0, _, _ => inferInstance
| n + 1, _, _ =>
have := instDecidableForallBitVec n
inferInstance
/--
For small numerals this isn't necessary (as typeclass search can use the above two instances),
but for large numerals this provides a shortcut.
Note, however, that for large numerals the decision procedure may be very slow.
-/
instance instDecidableExistsBitVec :
(n : Nat) (P : BitVec n Prop) [DecidablePred P], Decidable ( v, P v)
| 0, _, _ => inferInstance
| n + 1, _, _ =>
have := instDecidableExistsBitVec n
inferInstance
/-! ### Deprecations -/
set_option linter.missingDocs false

View File

@@ -368,13 +368,14 @@ theorem and_or_inj_left_iff :
/-- convert a `Bool` to a `Nat`, `false -> 0`, `true -> 1` -/
def toNat (b : Bool) : Nat := cond b 1 0
@[simp] theorem toNat_false : false.toNat = 0 := rfl
@[simp, bv_toNat] theorem toNat_false : false.toNat = 0 := rfl
@[simp] theorem toNat_true : true.toNat = 1 := rfl
@[simp, bv_toNat] theorem toNat_true : true.toNat = 1 := rfl
theorem toNat_le (c : Bool) : c.toNat 1 := by
cases c <;> trivial
@[bv_toNat]
theorem toNat_lt (b : Bool) : b.toNat < 2 :=
Nat.lt_succ_of_le (toNat_le _)

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

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

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

@@ -5,6 +5,7 @@ Authors: Jeremy Avigad, Deniz Aydin, Floris van Doorn, Mario Carneiro
-/
prelude
import Init.Data.Int.Lemmas
import Init.Data.Nat.Lemmas
namespace Int
@@ -35,10 +36,24 @@ theorem pow_le_pow_of_le_right {n : Nat} (hx : n > 0) {i : Nat} : ∀ {j}, i ≤
theorem pos_pow_of_pos {n : Nat} (m : Nat) (h : 0 < n) : 0 < n^m :=
pow_le_pow_of_le_right h (Nat.zero_le _)
@[norm_cast]
theorem natCast_pow (b n : Nat) : ((b^n : Nat) : Int) = (b : Int) ^ n := by
match n with
| 0 => rfl
| n + 1 =>
simp only [Nat.pow_succ, Int.pow_succ, natCast_mul, natCast_pow _ n]
@[simp]
protected theorem two_pow_pred_sub_two_pow {w : Nat} (h : 0 < w) :
((2 ^ (w - 1) : Nat) - (2 ^ w : Nat) : Int) = - ((2 ^ (w - 1) : Nat) : Int) := by
rw [ Nat.two_pow_pred_add_two_pow_pred h]
omega
@[simp]
protected theorem two_pow_pred_sub_two_pow' {w : Nat} (h : 0 < w) :
(2 : Int) ^ (w - 1) - (2 : Int) ^ w = - (2 : Int) ^ (w - 1) := by
norm_cast
rw [ Nat.two_pow_pred_add_two_pow_pred h]
simp [h]
end Int

View File

@@ -1314,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
@@ -1649,6 +1654,11 @@ theorem filterMap_eq_cons_iff {l} {b} {bs} :
/-! ### append -/
@[simp] theorem nil_append_fun : (([] : List α) ++ ·) = id := rfl
@[simp] theorem cons_append_fun (a : α) (as : List α) :
(fun bs => ((a :: as) ++ bs)) = fun bs => a :: (as ++ bs) := rfl
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'
@@ -2387,6 +2397,12 @@ theorem map_eq_replicate_iff {l : List α} {f : α → β} {b : β} :
theorem map_const' (l : List α) (b : β) : map (fun _ => b) l = replicate l.length b :=
map_const l b
@[simp] theorem set_replicate_self : (replicate n a).set i a = replicate n a := by
apply ext_getElem
· simp
· intro i h₁ h₂
simp [getElem_set]
@[simp] theorem append_replicate_replicate : replicate n a ++ replicate m a = replicate (n + m) a := by
rw [eq_replicate_iff]
constructor

View File

@@ -51,6 +51,27 @@ theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α)
@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α m β) {l₁ l₂ : List α} :
(l₁ ++ l₂).mapM f = (return ( l₁.mapM f) ++ ( l₂.mapM f)) := by induction l₁ <;> simp [*]
/-- Auxiliary lemma for `mapM_eq_reverse_foldlM_cons`. -/
theorem foldlM_cons_eq_append [Monad m] [LawfulMonad m] (f : α m β) (as : List α) (b : β) (bs : List β) :
(as.foldlM (init := b :: bs) fun acc a => return (( f a) :: acc)) =
(· ++ b :: bs) <$> as.foldlM (init := []) fun acc a => return (( f a) :: acc) := by
induction as generalizing b bs with
| nil => simp
| cons a as ih =>
simp only [bind_pure_comp] at ih
simp [ih, _root_.map_bind, Functor.map_map, Function.comp_def]
theorem mapM_eq_reverse_foldlM_cons [Monad m] [LawfulMonad m] (f : α m β) (l : List α) :
mapM f l = reverse <$> (l.foldlM (fun acc a => return (( f a) :: acc)) []) := by
rw [ mapM'_eq_mapM]
induction l with
| nil => simp
| cons a as ih =>
simp only [mapM'_cons, ih, bind_map_left, foldlM_cons, LawfulMonad.bind_assoc, pure_bind,
foldlM_cons_eq_append, _root_.map_bind, Functor.map_map, Function.comp_def, reverse_append,
reverse_cons, reverse_nil, nil_append, singleton_append]
simp [bind_pure_comp]
/-! ### forM -/
-- We use `List.forM` as the simp normal form, rather that `ForM.forM`.
@@ -66,4 +87,16 @@ theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α)
(l₁ ++ l₂).forM f = (do l₁.forM f; l₂.forM f) := by
induction l₁ <;> simp [*]
/-! ### allM -/
theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α m Bool) (as : List α) :
allM p as = (! ·) <$> anyM ((! ·) <$> p ·) as := by
induction as with
| nil => simp
| cons a as ih =>
simp only [allM, anyM, bind_map_left, _root_.map_bind]
congr
funext b
split <;> simp_all
end List

View File

@@ -725,12 +725,21 @@ theorem infix_iff_suffix_prefix {l₁ l₂ : List α} : l₁ <:+: l₂ ↔ ∃ t
theorem IsInfix.eq_of_length (h : l₁ <:+: l₂) : l₁.length = l₂.length l₁ = l₂ :=
h.sublist.eq_of_length
theorem IsInfix.eq_of_length_le (h : l₁ <:+: l₂) : l₂.length l₁.length l₁ = l₂ :=
h.sublist.eq_of_length_le
theorem IsPrefix.eq_of_length (h : l₁ <+: l₂) : l₁.length = l₂.length l₁ = l₂ :=
h.sublist.eq_of_length
theorem IsPrefix.eq_of_length_le (h : l₁ <+: l₂) : l₂.length l₁.length l₁ = l₂ :=
h.sublist.eq_of_length_le
theorem IsSuffix.eq_of_length (h : l₁ <:+ l₂) : l₁.length = l₂.length l₁ = l₂ :=
h.sublist.eq_of_length
theorem IsSuffix.eq_of_length_le (h : l₁ <:+ l₂) : l₂.length l₁.length l₁ = l₂ :=
h.sublist.eq_of_length_le
theorem prefix_of_prefix_length_le :
{l₁ l₂ l₃ : List α}, l₁ <+: l₃ l₂ <+: l₃ length l₁ length l₂ l₁ <+: l₂
| [], l₂, _, _, _, _ => nil_prefix
@@ -829,6 +838,24 @@ theorem isPrefix_iff : l₁ <+: l₂ ↔ ∀ i (h : i < l₁.length), l₂[i]? =
rw (config := {occs := .pos [2]}) [ Nat.and_forall_add_one]
simp [Nat.succ_lt_succ_iff, eq_comm]
theorem isPrefix_iff_getElem {l₁ l₂ : List α} :
l₁ <+: l₂ (h : l₁.length l₂.length), x (hx : x < l₁.length),
l₁[x] = l₂[x]'(Nat.lt_of_lt_of_le hx h) where
mp h := h.length_le, fun _ _ h.getElem _
mpr h := by
obtain hl, h := h
induction l₂ generalizing l₁ with
| nil =>
simpa using hl
| cons _ _ tail_ih =>
cases l₁ with
| nil =>
exact nil_prefix
| cons _ _ =>
simp only [length_cons, Nat.add_le_add_iff_right, Fin.getElem_fin] at hl h
simp only [cons_prefix_cons]
exact h 0 (zero_lt_succ _), tail_ih hl fun a ha h a.succ (succ_lt_succ ha)
-- See `Init.Data.List.Nat.Sublist` for `isSuffix_iff` and `ifInfix_iff`.
theorem isPrefix_filterMap_iff {β} {f : α Option β} {l₁ : List α} {l₂ : List β} :

View File

@@ -634,6 +634,8 @@ theorem lt_succ_of_lt (h : a < b) : a < succ b := le_succ_of_le h
theorem lt_add_one_of_lt (h : a < b) : a < b + 1 := le_succ_of_le h
@[simp] theorem lt_one_iff : n < 1 n = 0 := Nat.lt_succ_iff.trans <| by rw [le_zero_eq]
theorem succ_pred_eq_of_ne_zero : {n}, n 0 succ (pred n) = n
| _+1, _ => rfl

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

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.

View File

@@ -605,6 +605,9 @@ theorem add_mod (a b n : Nat) : (a + b) % n = ((a % n) + (b % n)) % n := by
| zero => simp_all
| succ k => omega
@[simp] theorem mod_mul_mod {a b c : Nat} : (a % c * b) % c = a * b % c := by
rw [mul_mod, mod_mod, mul_mod]
/-! ### pow -/
theorem pow_succ' {m n : Nat} : m ^ n.succ = m * m ^ n := by
@@ -767,6 +770,16 @@ protected theorem two_pow_pred_mod_two_pow (h : 0 < w) :
rw [mod_eq_of_lt]
apply Nat.pow_pred_lt_pow (by omega) h
protected theorem pow_lt_pow_iff_pow_mul_le_pow {a n m : Nat} (h : 1 < a) :
a ^ n < a ^ m a ^ n * a a ^ m := by
rw [Nat.pow_add_one, Nat.pow_le_pow_iff_right (by omega), Nat.pow_lt_pow_iff_right (by omega)]
omega
@[simp]
theorem two_pow_pred_mul_two (h : 0 < w) :
2 ^ (w - 1) * 2 = 2 ^ w := by
simp [ Nat.pow_succ, Nat.sub_add_cancel h]
/-! ### log2 -/
@[simp]

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

@@ -35,4 +35,4 @@ theorem neZero_iff {n : R} : NeZero n ↔ n ≠ 0 :=
fun h h.out, NeZero.mk
@[simp] theorem neZero_zero_iff_false {α : Type _} [Zero α] : NeZero (0 : α) False :=
fun h h.ne rfl, fun h h.elim
fun _ NeZero.ne (0 : α) rfl, fun h h.elim

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

@@ -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
@@ -1210,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).
@@ -1364,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.
@@ -2065,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.
@@ -2568,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 ::
@@ -2582,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
@@ -2709,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
@@ -2725,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

@@ -149,26 +149,27 @@ syntax (name := assumption) "assumption" : tactic
/--
`contradiction` closes the main goal if its hypotheses are "trivially contradictory".
- Inductive type/family with no applicable constructors
```lean
example (h : False) : p := by contradiction
```
```lean
example (h : False) : p := by contradiction
```
- Injectivity of constructors
```lean
example (h : none = some true) : p := by contradiction --
```
```lean
example (h : none = some true) : p := by contradiction --
```
- Decidable false proposition
```lean
example (h : 2 + 2 = 3) : p := by contradiction
```
```lean
example (h : 2 + 2 = 3) : p := by contradiction
```
- Contradictory hypotheses
```lean
example (h : p) (h' : ¬ p) : q := by contradiction
```
```lean
example (h : p) (h' : ¬ p) : q := by contradiction
```
- Other simple contradictions such as
```lean
example (x : Nat) (h : x ≠ x) : p := by contradiction
```
```lean
example (x : Nat) (h : x ≠ x) : p := by contradiction
```
-/
syntax (name := contradiction) "contradiction" : tactic
@@ -363,31 +364,24 @@ syntax (name := fail) "fail" (ppSpace str)? : tactic
syntax (name := eqRefl) "eq_refl" : tactic
/--
`rfl` tries to close the current goal using reflexivity.
This is supposed to be an extensible tactic and users can add their own support
for new reflexive relations.
Remark: `rfl` is an extensible tactic. We later add `macro_rules` to try different
reflexivity theorems (e.g., `Iff.rfl`).
This tactic applies to a goal whose target has the form `x ~ x`,
where `~` is equality, heterogeneous equality or any relation that
has a reflexivity lemma tagged with the attribute @[refl].
-/
macro "rfl" : tactic => `(tactic| case' _ => fail "The rfl tactic failed. Possible reasons:
- The goal is not a reflexive relation (neither `=` nor a relation with a @[refl] lemma).
- The arguments of the relation are not equal.
Try using the reflexivity lemma for your relation explicitly, e.g. `exact Eq.refl _` or
`exact HEq.rfl` etc.")
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
syntax "rfl" : tactic
/--
This tactic applies to a goal whose target has the form `x ~ x`,
where `~` is a reflexive relation other than `=`,
that is, a relation which has a reflexive lemma tagged with the attribute @[refl].
The same as `rfl`, but without trying `eq_refl` at the end.
-/
syntax (name := applyRfl) "apply_rfl" : tactic
-- We try `apply_rfl` first, beause it produces a nice error message
macro_rules | `(tactic| rfl) => `(tactic| apply_rfl)
-- But, mostly for backward compatibility, we try `eq_refl` too (reduces more aggressively)
macro_rules | `(tactic| rfl) => `(tactic| eq_refl)
-- Als for backward compatibility, because `exact` can trigger the implicit lambda feature (see #5366)
macro_rules | `(tactic| rfl) => `(tactic| exact HEq.rfl)
/--
`rfl'` is similar to `rfl`, but disables smart unfolding and unfolds all kinds of definitions,
theorems included (relevant for declarations defined by well-founded recursion).
@@ -456,7 +450,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
@@ -794,7 +788,7 @@ syntax inductionAlt := ppDedent(ppLine) inductionAltLHS+ " => " (hole <|> synth
After `with`, there is an optional tactic that runs on all branches, and
then a list of alternatives.
-/
syntax inductionAlts := " with" (ppSpace tactic)? withPosition((colGe inductionAlt)+)
syntax inductionAlts := " with" (ppSpace colGt tactic)? withPosition((colGe inductionAlt)+)
/--
Assuming `x` is a variable in the local context with an inductive type,
@@ -1589,7 +1583,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`.
@@ -1599,7 +1593,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

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

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

@@ -411,21 +411,23 @@ private def finalize : M Expr := do
synthesizeAppInstMVars
return e
/-- Return `true` if there is a named argument that depends on the next argument. -/
private def anyNamedArgDependsOnCurrent : M Bool := do
/--
Returns a named argument that depends on the next argument, otherwise `none`.
-/
private def findNamedArgDependsOnCurrent? : M (Option NamedArg) := do
let s get
if s.namedArgs.isEmpty then
return false
return none
else
forallTelescopeReducing s.fType fun xs _ => do
let curr := xs[0]!
for i in [1:xs.size] do
let xDecl xs[i]!.fvarId!.getDecl
if s.namedArgs.any fun arg => arg.name == xDecl.userName then
if let some arg := s.namedArgs.find? fun arg => arg.name == xDecl.userName then
/- Remark: a default value at `optParam` does not count as a dependency -/
if ( exprDependsOn xDecl.type.cleanupAnnotations curr.fvarId!) then
return true
return false
return arg
return none
/-- Return `true` if there are regular or named arguments to be processed. -/
@@ -433,11 +435,13 @@ private def hasArgsToProcess : M Bool := do
let s get
return !s.args.isEmpty || !s.namedArgs.isEmpty
/-- Return `true` if the next argument at `args` is of the form `_` -/
private def isNextArgHole : M Bool := do
/--
Returns the argument syntax if the next argument at `args` is of the form `_`.
-/
private def nextArgHole? : M (Option Syntax) := do
match ( get).args with
| Arg.stx (Syntax.node _ ``Lean.Parser.Term.hole _) :: _ => pure true
| _ => pure false
| Arg.stx stx@(Syntax.node _ ``Lean.Parser.Term.hole _) :: _ => pure stx
| _ => pure none
/--
Return `true` if the next argument to be processed is the outparam of a local instance, and it the result type
@@ -512,8 +516,9 @@ where
mutual
/--
Create a fresh local variable with the current binder name and argument type, add it to `etaArgs` and `f`,
and then execute the main loop.-/
Create a fresh local variable with the current binder name and argument type, add it to `etaArgs` and `f`,
and then execute the main loop.
-/
private partial def addEtaArg (argName : Name) : M Expr := do
let n getBindingName
let type getArgExpectedType
@@ -522,6 +527,9 @@ mutual
addNewArg argName x
main
/--
Create a fresh metavariable for the implicit argument, add it to `f`, and thn execute the main loop.
-/
private partial def addImplicitArg (argName : Name) : M Expr := do
let argType getArgExpectedType
let arg if ( isNextOutParamOfLocalInstanceAndResult) then
@@ -539,35 +547,47 @@ mutual
main
/--
Process a `fType` of the form `(x : A) → B x`.
This method assume `fType` is a function type -/
Process a `fType` of the form `(x : A) → B x`.
This method assume `fType` is a function type.
-/
private partial def processExplicitArg (argName : Name) : M Expr := do
match ( get).args with
| arg::args =>
if ( anyNamedArgDependsOnCurrent) then
-- Note: currently the following test never succeeds in explicit mode since `@x.f` notation does not exist.
if let some true := NamedArg.suppressDeps <$> ( findNamedArgDependsOnCurrent?) then
/-
We treat the explicit argument `argName` as implicit if we have named arguments that depend on it.
The idea is that this explicit argument can be inferred using the type of the named argument one.
Note that we also use this approach in the branch where there are no explicit arguments left.
This is important to make sure the system behaves in a uniform way.
Moreover, users rely on this behavior. For example, consider the example on issue #1851
We treat the explicit argument `argName` as implicit
if we have a named arguments that depends on it whose `suppressDeps` flag set to `true`.
The motivation for this is class projections (issue #1851).
In some cases, class projections can have explicit parameters. For example, in
```
class Approx {α : Type} (a : α) (X : Type) : Type where
val : X
variable {α β X Y : Type} {f' : α → β} {x' : α} [f : Approx f' (X → Y)] [x : Approx x' X]
#check f.val
#check f.val x.val
```
The type of `Approx.val` is `{α : Type} → (a : α) → {X : Type} → [self : Approx a X] → X`
Note that the argument `a` is explicit since there is no way to infer it from the expected
type or the type of other explicit arguments.
Recall that `f.val` is sugar for `Approx.val (self := f)`. In both `#check` commands above
the user assumed that `a` does not need to be provided since it can be inferred from the type
of `self`.
We used to that only in the branch where `(← get).args` was empty, but it created an asymmetry
because `#check f.val` worked as expected, but one would have to write `#check f.val _ x.val`
the type of `Approx.val` is `{α : Type} → (a : α) → {X : Type} → [self : Approx a X] → X`.
Note that the parameter `a` is explicit since there is no way to infer it from the expected
type or from the types of other explicit parameters.
Being a parameter of the class, `a` is determined by the type of `self`.
Consider
```
variable {α β X Y : Type} {f' : α → β} {x' : α} [f : Approx f' (X → Y)]
```
Recall that `f.val` is, to first approximation, sugar for `Approx.val (self := f)`.
Without further refinement, this would expand to `fun f'' : α → β => Approx.val f'' f`,
which is a type error, since `f''` must be defeq to `f'`.
Furthermore, with projection notation, users expect all structure parameters
to be uniformly implicit; after all, they are determined by `self`.
To handle this, the `(self := f)` named argument is annotated with the `suppressDeps` flag.
This causes the `a` parameter to become implicit, and `f.val` instead expands to `Approx.val f' f`.
This feature previously was enabled for *all* explicit arguments, which confused users
and was frequently reported as a bug (issue #1867).
Now it is only enabled for the `self` argument in structure projections.
We used to do this only when `(← get).args` was empty,
but it created an asymmetry because `f.val` worked as expected,
yet one would have to write `f.val _ x` when there are further arguments.
-/
return ( addImplicitArg argName)
propagateExpectedType arg
@@ -584,7 +604,6 @@ mutual
match evalSyntaxConstant env opts tacticDecl with
| Except.error err => throwError err
| Except.ok tacticSyntax =>
-- TODO(Leo): does this work correctly for tactic sequences?
let tacticBlock `(by $(tacticSyntax))
/-
We insert position information from the current ref into `stx` everywhere, simulating this being
@@ -596,24 +615,32 @@ mutual
-/
let info := ( getRef).getHeadInfo
let tacticBlock := tacticBlock.raw.rewriteBottomUp (·.setInfo info)
let argNew := Arg.stx tacticBlock
let mvar mkTacticMVar argType.consumeTypeAnnotations tacticBlock (.autoParam argName)
-- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
-- We should look into removing this since terminfo for synthetic syntax is suspect,
-- but we noted it was necessary to preserve the behavior of the unused variable linter.
addTermInfo' tacticBlock mvar
let argNew := Arg.expr mvar
propagateExpectedType argNew
elabAndAddNewArg argName argNew
main
| false, _, some _ =>
throwError "invalid autoParam, argument must be a constant"
| _, _, _ =>
if !( get).namedArgs.isEmpty then
if ( anyNamedArgDependsOnCurrent) then
addImplicitArg argName
else if ( read).ellipsis then
if ( read).ellipsis then
addImplicitArg argName
else if !( get).namedArgs.isEmpty then
if let some _ findNamedArgDependsOnCurrent? then
/-
Dependencies of named arguments cannot be turned into eta arguments
since they are determined by the named arguments.
Instead we can turn them into implicit arguments.
-/
addImplicitArg argName
else
addEtaArg argName
else if !( read).explicit then
if ( read).ellipsis then
addImplicitArg argName
else if ( fTypeHasOptAutoParams) then
if ( fTypeHasOptAutoParams) then
addEtaArg argName
else
finalize
@@ -641,24 +668,30 @@ mutual
finalize
/--
Process a `fType` of the form `[x : A] → B x`.
This method assume `fType` is a function type -/
Process a `fType` of the form `[x : A] → B x`.
This method assume `fType` is a function type.
-/
private partial def processInstImplicitArg (argName : Name) : M Expr := do
if ( read).explicit then
if ( isNextArgHole) then
/- Recall that if '@' has been used, and the argument is '_', then we still use type class resolution -/
let arg mkFreshExprMVar ( getArgExpectedType) MetavarKind.synthetic
if let some stx nextArgHole? then
-- We still use typeclass resolution for `_` arguments.
-- This behavior can be suppressed with `(_)`.
let ty getArgExpectedType
let arg mkInstMVar ty
addTermInfo' stx arg ty
modify fun s => { s with args := s.args.tail! }
addInstMVar arg.mvarId!
addNewArg argName arg
main
else
processExplicitArg argName
else
let arg mkFreshExprMVar ( getArgExpectedType) MetavarKind.synthetic
discard <| mkInstMVar ( getArgExpectedType)
main
where
mkInstMVar (ty : Expr) : M Expr := do
let arg mkFreshExprMVar ty MetavarKind.synthetic
addInstMVar arg.mvarId!
addNewArg argName arg
main
return arg
/-- Elaborate function application arguments. -/
partial def main : M Expr := do
@@ -689,6 +722,104 @@ end
end ElabAppArgs
/-! # Eliminator-like function application elaborator -/
/--
Information about an eliminator used by the elab-as-elim elaborator.
This is not to be confused with `Lean.Meta.ElimInfo`, which is for `induction` and `cases`.
The elab-as-elim routine is less restrictive in what counts as an eliminator, and it doesn't need
to have a strict notion of what is a "target" — all it cares about are
1. that the return type of a function is of the form `m ...` where `m` is a parameter
(unlike `induction` and `cases` eliminators, the arguments to `m`, known as "discriminants",
can be any expressions, not just parameters), and
2. which arguments should be eagerly elaborated, to make discriminants be as elaborated as
possible for the expected type generalization procedure,
and which should be postponed (since they are the "minor premises").
Note that the routine isn't doing induction/cases *on* particular expressions.
The purpose of elab-as-elim is to successfully solve the higher-order unification problem
between the return type of the function and the expected type.
-/
structure ElabElimInfo where
/-- The eliminator. -/
elimExpr : Expr
/-- The type of the eliminator. -/
elimType : Expr
/-- The position of the motive parameter. -/
motivePos : Nat
/--
Positions of "major" parameters (those that should be eagerly elaborated
because they can contribute to the motive inference procedure).
All parameters that are neither the motive nor a major parameter are "minor" parameters.
The major parameters include all of the parameters that transitively appear in the motive's arguments,
as well as "first-order" arguments that include such parameters,
since they too can help with elaborating discriminants.
For example, in the following theorem the argument `h : a = b`
should be elaborated eagerly because it contains `b`, which occurs in `motive b`.
```
theorem Eq.subst' {α} {motive : α → Prop} {a b : α} (h : a = b) : motive a → motive b
```
For another example, the term `isEmptyElim (α := α)` is an underapplied eliminator, and it needs
argument `α` to be elaborated eagerly to create a type-correct motive.
```
def isEmptyElim [IsEmpty α] {p : α → Sort _} (a : α) : p a := ...
example {α : Type _} [IsEmpty α] : id (α → False) := isEmptyElim (α := α)
```
-/
majorsPos : Array Nat := #[]
deriving Repr, Inhabited
def getElabElimExprInfo (elimExpr : Expr) : MetaM ElabElimInfo := do
let elimType inferType elimExpr
trace[Elab.app.elab_as_elim] "eliminator {indentExpr elimExpr}\nhas type{indentExpr elimType}"
forallTelescopeReducing elimType fun xs type => do
let motive := type.getAppFn
let motiveArgs := type.getAppArgs
unless motive.isFVar do
throwError "unexpected eliminator resulting type{indentExpr type}"
let motiveType inferType motive
forallTelescopeReducing motiveType fun motiveParams motiveResultType => do
unless motiveParams.size == motiveArgs.size do
throwError "unexpected number of arguments at motive type{indentExpr motiveType}"
unless motiveResultType.isSort do
throwError "motive result type must be a sort{indentExpr motiveType}"
let some motivePos pure (xs.indexOf? motive) |
throwError "unexpected eliminator type{indentExpr elimType}"
/-
Compute transitive closure of fvars appearing in arguments to the motive.
These are the primary set of major parameters.
-/
let initMotiveFVars : CollectFVars.State := motiveArgs.foldl (init := {}) collectFVars
let motiveFVars xs.size.foldRevM (init := initMotiveFVars) fun i s => do
let x := xs[i]!
if s.fvarSet.contains x.fvarId! then
return collectFVars s ( inferType x)
else
return s
/- Collect the major parameter positions -/
let mut majorsPos := #[]
for i in [:xs.size] do
let x := xs[i]!
unless motivePos == i do
let xType x.fvarId!.getType
/-
We also consider "first-order" types because we can reliably "extract" information from them.
We say a term is "first-order" if all applications are of the form `f ...` where `f` is a constant.
-/
let isFirstOrder (e : Expr) : Bool := Option.isNone <| e.find? fun e => e.isApp && !e.getAppFn.isConst
if motiveFVars.fvarSet.contains x.fvarId!
|| (isFirstOrder xType
&& Option.isSome (xType.find? fun e => e.isFVar && motiveFVars.fvarSet.contains e.fvarId!)) then
majorsPos := majorsPos.push i
trace[Elab.app.elab_as_elim] "motivePos: {motivePos}"
trace[Elab.app.elab_as_elim] "majorsPos: {majorsPos}"
return { elimExpr, elimType, motivePos, majorsPos }
def getElabElimInfo (elimName : Name) : MetaM ElabElimInfo := do
getElabElimExprInfo ( mkConstWithFreshMVarLevels elimName)
builtin_initialize elabAsElim : TagAttribute
registerTagAttribute `elab_as_elim
"instructs elaborator that the arguments of the function application should be elaborated as were an eliminator"
@@ -703,33 +834,15 @@ builtin_initialize elabAsElim : TagAttribute ←
let info getConstInfo declName
if ( hasOptAutoParams info.type) then
throwError "[elab_as_elim] attribute cannot be used in declarations containing optional and auto parameters"
discard <| getElimInfo declName
discard <| getElabElimInfo declName
go.run' {} {}
/-! # Eliminator-like function application elaborator -/
namespace ElabElim
/-- Context of the `elab_as_elim` elaboration procedure. -/
structure Context where
elimInfo : ElimInfo
elimInfo : ElabElimInfo
expectedType : Expr
/--
Position of additional arguments that should be elaborated eagerly
because they can contribute to the motive inference procedure.
For example, in the following theorem the argument `h : a = b`
should be elaborated eagerly because it contains `b` which occurs
in `motive b`.
```
theorem Eq.subst' {α} {motive : α → Prop} {a b : α} (h : a = b) : motive a → motive b
```
For another example, the term `isEmptyElim (α := α)` is an underapplied eliminator, and it needs
argument `α` to be elaborated eagerly to create a type-correct motive.
```
def isEmptyElim [IsEmpty α] {p : α → Sort _} (a : α) : p a := ...
example {α : Type _} [IsEmpty α] : id (α → False) := isEmptyElim (α := α)
```
-/
extraArgsPos : Array Nat
/-- State of the `elab_as_elim` elaboration procedure. -/
structure State where
@@ -741,8 +854,6 @@ structure State where
namedArgs : List NamedArg
/-- User-provided arguments that still have to be processed. -/
args : List Arg
/-- Discriminants (targets) processed so far. -/
discrs : Array (Option Expr)
/-- Instance implicit arguments collected so far. -/
instMVars : Array MVarId := #[]
/-- Position of the next argument to be processed. We use it to decide whether the argument is the motive or a discriminant. -/
@@ -788,7 +899,7 @@ def finalize : M Expr := do
let some motive := ( get).motive?
| throwError "failed to elaborate eliminator, insufficient number of arguments"
trace[Elab.app.elab_as_elim] "motive: {motive}"
forallTelescope ( get).fType fun xs _ => do
forallTelescope ( get).fType fun xs fType => do
trace[Elab.app.elab_as_elim] "xs: {xs}"
let mut expectedType := ( read).expectedType
trace[Elab.app.elab_as_elim] "expectedType:{indentD expectedType}"
@@ -797,6 +908,7 @@ def finalize : M Expr := do
let mut f := ( get).f
if xs.size > 0 then
-- under-application, specialize the expected type using `xs`
-- Note: if we ever wanted to support optParams and autoParams, this is where it could be.
assert! ( get).args.isEmpty
for x in xs do
let .forallE _ t b _ whnf expectedType | throwInsufficient
@@ -813,18 +925,11 @@ def finalize : M Expr := do
trace[Elab.app.elab_as_elim] "expectedType after processing:{indentD expectedType}"
let result := mkAppN f xs
trace[Elab.app.elab_as_elim] "result:{indentD result}"
let mut discrs := ( get).discrs
let idx := ( get).idx
if discrs.any Option.isNone then
for i in [idx:idx + xs.size], x in xs do
if let some tidx := ( read).elimInfo.targetsPos.indexOf? i then
discrs := discrs.set! tidx x
if let some idx := discrs.findIdx? Option.isNone then
-- This should not happen.
trace[Elab.app.elab_as_elim] "Internal error, missing target with index {idx}"
throwError "failed to elaborate eliminator, insufficient number of arguments"
trace[Elab.app.elab_as_elim] "discrs: {discrs.map Option.get!}"
let motiveVal mkMotive (discrs.map Option.get!) expectedType
unless fType.getAppFn == ( get).motive? do
throwError "Internal error, eliminator target type isn't an application of the motive"
let discrs := fType.getAppArgs
trace[Elab.app.elab_as_elim] "discrs: {discrs}"
let motiveVal mkMotive discrs expectedType
unless ( isTypeCorrect motiveVal) do
throwError "failed to elaborate eliminator, motive is not type correct:{indentD motiveVal}"
unless ( isDefEq motive motiveVal) do
@@ -858,10 +963,6 @@ def getNextArg? (binderName : Name) (binderInfo : BinderInfo) : M (LOption Arg)
def setMotive (motive : Expr) : M Unit :=
modify fun s => { s with motive? := motive }
/-- Push the given expression into the `discrs` field in the state, where `i` is which target it is for. -/
def addDiscr (i : Nat) (discr : Expr) : M Unit :=
modify fun s => { s with discrs := s.discrs.set! i discr }
/-- Elaborate the given argument with the given expected type. -/
private def elabArg (arg : Arg) (argExpectedType : Expr) : M Expr := do
match arg with
@@ -904,18 +1005,13 @@ partial def main : M Expr := do
mkImplicitArg binderType binderInfo
setMotive motive
addArgAndContinue motive
else if let some tidx := ( read).elimInfo.targetsPos.indexOf? idx then
else if ( read).elimInfo.majorsPos.contains idx then
match ( getNextArg? binderName binderInfo) with
| .some arg => let discr elabArg arg binderType; addDiscr tidx discr; addArgAndContinue discr
| .some arg => let discr elabArg arg binderType; addArgAndContinue discr
| .undef => finalize
| .none => let discr mkImplicitArg binderType binderInfo; addDiscr tidx discr; addArgAndContinue discr
| .none => let discr mkImplicitArg binderType binderInfo; addArgAndContinue discr
else match ( getNextArg? binderName binderInfo) with
| .some (.stx stx) =>
if ( read).extraArgsPos.contains idx then
let arg elabArg (.stx stx) binderType
addArgAndContinue arg
else
addArgAndContinue ( postponeElabTerm stx binderType)
| .some (.stx stx) => addArgAndContinue ( postponeElabTerm stx binderType)
| .some (.expr val) => addArgAndContinue ( ensureArgType ( get).f val binderType)
| .undef => finalize
| .none => addArgAndContinue ( mkImplicitArg binderType binderInfo)
@@ -969,13 +1065,10 @@ def elabAppArgs (f : Expr) (namedArgs : Array NamedArg) (args : Array Arg)
let some expectedType := expectedType? | throwError "failed to elaborate eliminator, expected type is not available"
let expectedType instantiateMVars expectedType
if expectedType.getAppFn.isMVar then throwError "failed to elaborate eliminator, expected type is not available"
let extraArgsPos getElabAsElimExtraArgsPos elimInfo
trace[Elab.app.elab_as_elim] "extraArgsPos: {extraArgsPos}"
ElabElim.main.run { elimInfo, expectedType, extraArgsPos } |>.run' {
ElabElim.main.run { elimInfo, expectedType } |>.run' {
f, fType
args := args.toList
namedArgs := namedArgs.toList
discrs := mkArray elimInfo.targetsPos.size none
}
else
ElabAppArgs.main.run { explicit, ellipsis, resultIsOutParamSupport } |>.run' {
@@ -986,12 +1079,12 @@ def elabAppArgs (f : Expr) (namedArgs : Array NamedArg) (args : Array Arg)
}
where
/-- Return `some info` if we should elaborate as an eliminator. -/
elabAsElim? : TermElabM (Option ElimInfo) := do
elabAsElim? : TermElabM (Option ElabElimInfo) := do
unless ( read).heedElabAsElim do return none
if explicit || ellipsis then return none
let .const declName _ := f | return none
unless ( shouldElabAsElim declName) do return none
let elimInfo getElimInfo declName
let elimInfo getElabElimInfo declName
forallTelescopeReducing ( inferType f) fun xs _ => do
/- Process arguments similar to `Lean.Elab.Term.ElabElim.main` to see if the motive has been
provided, in which case we use the standard app elaborator.
@@ -1022,41 +1115,6 @@ where
return none
| _, _ => return some elimInfo
/--
Collect extra argument positions that must be elaborated eagerly when using `elab_as_elim`.
The idea is that they contribute to motive inference. See comment at `ElamElim.Context.extraArgsPos`.
-/
getElabAsElimExtraArgsPos (elimInfo : ElimInfo) : MetaM (Array Nat) := do
forallTelescope elimInfo.elimType fun xs type => do
let targets := type.getAppArgs
/- Compute transitive closure of fvars appearing in the motive and the targets. -/
let initMotiveFVars : CollectFVars.State := targets.foldl (init := {}) collectFVars
let motiveFVars xs.size.foldRevM (init := initMotiveFVars) fun i s => do
let x := xs[i]!
if elimInfo.motivePos == i || elimInfo.targetsPos.contains i || s.fvarSet.contains x.fvarId! then
return collectFVars s ( inferType x)
else
return s
/- Collect the extra argument positions -/
let mut extraArgsPos := #[]
for i in [:xs.size] do
let x := xs[i]!
unless elimInfo.motivePos == i || elimInfo.targetsPos.contains i do
let xType x.fvarId!.getType
/- We only consider "first-order" types because we can reliably "extract" information from them. -/
if motiveFVars.fvarSet.contains x.fvarId!
|| (isFirstOrder xType
&& Option.isSome (xType.find? fun e => e.isFVar && motiveFVars.fvarSet.contains e.fvarId!)) then
extraArgsPos := extraArgsPos.push i
return extraArgsPos
/-
Helper function for implementing `elab_as_elim`.
We say a term is "first-order" if all applications are of the form `f ...` where `f` is a constant.
-/
isFirstOrder (e : Expr) : Bool :=
Option.isNone <| e.find? fun e =>
e.isApp && !e.getAppFn.isConst
/-- Auxiliary inductive datatype that represents the resolution of an `LVal`. -/
inductive LValResolution where
@@ -1221,7 +1279,7 @@ private partial def mkBaseProjections (baseStructName : Name) (structName : Name
let mut e := e
for projFunName in path do
let projFn mkConst projFunName
e elabAppArgs projFn #[{ name := `self, val := Arg.expr e }] (args := #[]) (expectedType? := none) (explicit := false) (ellipsis := false)
e elabAppArgs projFn #[{ name := `self, val := Arg.expr e, suppressDeps := true }] (args := #[]) (expectedType? := none) (explicit := false) (ellipsis := false)
return e
private def typeMatchesBaseName (type : Expr) (baseName : Name) : MetaM Bool := do
@@ -1305,10 +1363,10 @@ private def elabAppLValsAux (namedArgs : Array NamedArg) (args : Array Arg) (exp
let projFn mkConst info.projFn
let projFn addProjTermInfo lval.getRef projFn
if lvals.isEmpty then
let namedArgs addNamedArg namedArgs { name := `self, val := Arg.expr f }
let namedArgs addNamedArg namedArgs { name := `self, val := Arg.expr f, suppressDeps := true }
elabAppArgs projFn namedArgs args expectedType? explicit ellipsis
else
let f elabAppArgs projFn #[{ name := `self, val := Arg.expr f }] #[] (expectedType? := none) (explicit := false) (ellipsis := false)
let f elabAppArgs projFn #[{ name := `self, val := Arg.expr f, suppressDeps := true }] #[] (expectedType? := none) (explicit := false) (ellipsis := false)
loop f lvals
else
unreachable!

View File

@@ -9,18 +9,22 @@ import Lean.Elab.Term
namespace Lean.Elab.Term
/--
Auxiliary inductive datatype for combining unelaborated syntax
and already elaborated expressions. It is used to elaborate applications. -/
Auxiliary inductive datatype for combining unelaborated syntax
and already elaborated expressions. It is used to elaborate applications.
-/
inductive Arg where
| stx (val : Syntax)
| expr (val : Expr)
deriving Inhabited
/-- Named arguments created using the notation `(x := val)` -/
/-- Named arguments created using the notation `(x := val)`. -/
structure NamedArg where
ref : Syntax := Syntax.missing
name : Name
val : Arg
/-- If `true`, then make all parameters that depend on this one become implicit.
This is used for projection notation, since structure parameters might be explicit for classes. -/
suppressDeps : Bool := false
deriving Inhabited
/--

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

@@ -150,26 +150,10 @@ private def getMVarFromUserName (ident : Syntax) : MetaM Expr := do
elabTerm b expectedType?
| _ => throwUnsupportedSyntax
private def mkTacticMVar (type : Expr) (tacticCode : Syntax) : TermElabM Expr := do
let mvar mkFreshExprMVar type MetavarKind.syntheticOpaque
let mvarId := mvar.mvarId!
let ref getRef
registerSyntheticMVar ref mvarId <| SyntheticMVarKind.tactic tacticCode ( saveContext)
return mvar
register_builtin_option debug.byAsSorry : Bool := {
defValue := false
group := "debug"
descr := "replace `by ..` blocks with `sorry` IF the expected type is a proposition"
}
@[builtin_term_elab byTactic] def elabByTactic : TermElab := fun stx expectedType? => do
match expectedType? with
| some expectedType =>
if pure (debug.byAsSorry.get ( getOptions)) <&&> isProp expectedType then
mkSorry expectedType false
else
mkTacticMVar expectedType stx
mkTacticMVar expectedType stx .term
| none =>
tryPostpone
throwError ("invalid 'by' tactic, expected type has not been provided")

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

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

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

View File

@@ -126,7 +126,7 @@ def simpEqnType (eqnType : Expr) : MetaM Expr := do
for y in ys.reverse do
trace[Elab.definition] ">> simpEqnType: {← inferType y}, {type}"
if proofVars.contains y.fvarId! then
let some (_, Expr.fvar fvarId, rhs) matchEq? ( inferType y) | throwError "unexpected hypothesis in altenative{indentExpr eqnType}"
let some (_, Expr.fvar fvarId, rhs) matchEq? ( inferType y) | throwError "unexpected hypothesis in alternative{indentExpr eqnType}"
eliminated := eliminated.insert fvarId
type := type.replaceFVarId fvarId rhs
else if eliminated.contains y.fvarId! then

View File

@@ -53,6 +53,64 @@ private def getMVarsAtPreDef (preDef : PreDefinition) : MetaM (Array MVarId) :=
let (_, s) (collectMVarsAtPreDef preDef).run {}
pure s.result
/--
Set any lingering level mvars to `.zero`, for error recovery.
-/
private def setLevelMVarsAtPreDef (preDef : PreDefinition) : PreDefinition :=
if preDef.value.hasLevelMVar then
let value' :=
preDef.value.replaceLevel fun l =>
match l with
| .mvar _ => levelZero
| _ => none
{ preDef with value := value' }
else
preDef
private partial def ensureNoUnassignedLevelMVarsAtPreDef (preDef : PreDefinition) : TermElabM PreDefinition := do
if !preDef.value.hasLevelMVar then
return preDef
else
let pendingLevelMVars := (collectLevelMVars {} ( instantiateMVars preDef.value)).result
if ( logUnassignedLevelMVarsUsingErrorInfos pendingLevelMVars) then
return setLevelMVarsAtPreDef preDef
else if !( MonadLog.hasErrors) then
-- This is a fallback in case we don't have an error info available for the universe level metavariables.
-- We try to produce an error message containing an expression with one of the universe level metavariables.
let rec visitLevel (u : Level) (e : Expr) : TermElabM Unit := do
if u.hasMVar then
let e' exposeLevelMVars e
throwError "\
declaration '{preDef.declName}' contains universe level metavariables at the expression\
{indentExpr e'}\n\
in the declaration body{indentExpr <| ← exposeLevelMVars preDef.value}"
let withExpr (e : Expr) (m : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit) :=
withReader (fun _ => e) m
let rec visit (e : Expr) (head := false) : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit := do
if e.hasLevelMVar then
checkCache { val := e : ExprStructEq } fun _ => do
match e with
| .forallE n d b c | .lam n d b c => withExpr e do visit d; withLocalDecl n c d fun x => visit (b.instantiate1 x)
| .letE n t v b _ => withExpr e do visit t; visit v; withLetDecl n t v fun x => visit (b.instantiate1 x)
| .mdata _ b => withExpr e do visit b
| .proj _ _ b => withExpr e do visit b
| .sort u => visitLevel u ( read)
| .const _ us => (if head then id else withExpr e) <| us.forM (visitLevel · ( read))
| .app .. => withExpr e do
if let some (args, n, t, v, b) := e.letFunAppArgs? then
visit t; visit v; withLocalDeclD n t fun x => visit (b.instantiate1 x); args.forM visit
else
e.withApp fun f args => do visit f true; args.forM visit
| _ => pure ()
try
visit preDef.value |>.run preDef.value |>.run {}
catch e =>
logException e
return setLevelMVarsAtPreDef preDef
throwAbortCommand
else
return setLevelMVarsAtPreDef preDef
private def ensureNoUnassignedMVarsAtPreDef (preDef : PreDefinition) : TermElabM PreDefinition := do
let pendingMVarIds getMVarsAtPreDef preDef
if ( logUnassignedUsingErrorInfos pendingMVarIds) then
@@ -62,7 +120,7 @@ private def ensureNoUnassignedMVarsAtPreDef (preDef : PreDefinition) : TermElabM
else
throwAbortCommand
else
return preDef
ensureNoUnassignedLevelMVarsAtPreDef preDef
/--
Letrec declarations produce terms of the form `(fun .. => ..) d` where `d` is a (partial) application of an auxiliary declaration for a letrec declaration.
@@ -104,7 +162,7 @@ Checks consistency of a clique of TerminationHints:
* If not all have a hint, the hints are ignored (log error)
* If one has `structural`, check that all have it, (else throw error)
* A `structural` shold not have a `decreasing_by` (else log error)
* A `structural` should not have a `decreasing_by` (else log error)
-/
def checkTerminationByHints (preDefs : Array PreDefinition) : CoreM Unit := do

View File

@@ -269,7 +269,7 @@ def inferBRecOnFTypes (recArgInfos : Array RecArgInfo) (positions : Positions)
let brecOnType inferType brecOn
-- Skip the indices and major argument
let packedFTypes forallBoundedTelescope brecOnType (some (recArgInfo.indicesPos.size + 1)) fun _ brecOnType =>
-- And return the types of of the next arguments
-- And return the types of the next arguments
arrowDomainsN numTypeFormers brecOnType
let mut FTypes := Array.mkArray positions.numIndices (Expr.sort 0)

View File

@@ -119,7 +119,7 @@ def getRecArgInfos (fnName : Name) (xs : Array Expr) (value : Expr)
(termArg? : Option TerminationArgument) : MetaM (Array RecArgInfo × MessageData) := do
lambdaTelescope value fun ys _ => do
if let .some termArg := termArg? then
-- User explictly asked to use a certain argument, so throw errors eagerly
-- User explicitly asked to use a certain argument, so throw errors eagerly
let recArgInfo withRef termArg.ref do
mapError (f := (m!"cannot use specified parameter for structural recursion:{indentD ·}")) do
getRecArgInfo fnName xs.size (xs ++ ys) ( termArg.structuralArg)
@@ -189,7 +189,7 @@ def argsInGroup (group : IndGroupInst) (xs : Array Expr) (value : Expr)
if ( group.isDefEq recArgInfo.indGroupInst) then
return (.some recArgInfo)
-- Can this argument be understood as the auxillary type former of a nested inductive?
-- Can this argument be understood as the auxiliary type former of a nested inductive?
if nestedTypeFormers.isEmpty then return .none
lambdaTelescope value fun ys _ => do
let x := (xs++ys)[recArgInfo.recArgPos]!

View File

@@ -13,7 +13,7 @@ This module contains the types
* `IndGroupInst` which extends `IndGroupInfo` with levels and parameters
to indicate a instantiation of the group.
One purpose of this abstraction is to make it clear when a fuction operates on a group as
One purpose of this abstraction is to make it clear when a function operates on a group as
a whole, rather than a specific inductive within the group.
-/

View File

@@ -17,7 +17,7 @@ private def shouldBetaReduce (e : Expr) (recFnNames : Array Name) : Bool :=
false
/--
Preprocesses the expessions to improve the effectiveness of `elimRecursion`.
Preprocesses the expressions to improve the effectiveness of `elimRecursion`.
* Beta reduce terms where the recursive function occurs in the lambda term.
Example:

View File

@@ -31,7 +31,7 @@ structure RecArgInfo where
indGroupInst : IndGroupInst
/--
index of the inductive datatype of the argument we are recursing on.
If `< indAll.all`, a normal data type, else an auxillary data type due to nested recursion
If `< indAll.all`, a normal data type, else an auxiliary data type due to nested recursion
-/
indIdx : Nat
deriving Inhabited
@@ -52,7 +52,7 @@ def RecArgInfo.pickIndicesMajor (info : RecArgInfo) (xs : Array Expr) : (Array E
return (indexMajorArgs, otherArgs)
/--
Name of the recursive data type. Assumes that it is not one of the auxillary ones.
Name of the recursive data type. Assumes that it is not one of the auxiliary ones.
-/
def RecArgInfo.indName! (info : RecArgInfo) : Name :=
info.indGroupInst.all[info.indIdx]!

View File

@@ -112,7 +112,7 @@ def TerminationArgument.delab (arity : Nat) (extraParams : Nat) (termArg : Termi
let stxBody Delaborator.delab
let hole : TSyntax `Lean.Parser.Term.hole `(hole|_)
-- any variable not mentioned syntatically (it may appear in the `Expr`, so do not just use
-- any variable not mentioned syntactically (it may appear in the `Expr`, so do not just use
-- `e.bindingBody!.hasLooseBVar`) should be delaborated as a hole.
let vars : TSyntaxArray [`ident, `Lean.Parser.Term.hole] :=
Array.map (fun (i : Ident) => if stxBody.raw.hasIdent i.getId then i else hole) vars

View File

@@ -45,7 +45,7 @@ structure TerminationHints where
decreasingBy? : Option DecreasingBy
/--
Here we record the number of parameters past the `:`. It is set by
`TerminationHints.rememberExtraParams` and used as folows:
`TerminationHints.rememberExtraParams` and used as follows:
* When we guess the termination argument in `GuessLex` and want to print it in surface-syntax
compatible form.

View File

@@ -12,7 +12,7 @@ namespace Lean.Elab.WF
register_builtin_option debug.rawDecreasingByGoal : Bool := {
defValue := false
descr := "Shows the raw `decreasing_by` goal including internal implementation detail \
intead of cleaning it up with the `clean_wf` tactic. Can be enabled for debugging \
instead of cleaning it up with the `clean_wf` tactic. Can be enabled for debugging \
purposes. Please report an issue if you have to use this option for other reasons."
}

View File

@@ -66,7 +66,7 @@ private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
else if let some mvarIds splitTarget? mvarId then
mvarIds.forM go
else
-- At some point in the past, we looked for occurences of Wf.fix to fold on the
-- At some point in the past, we looked for occurrences of Wf.fix to fold on the
-- LHS (introduced in 096e4eb), but it seems that code path was never used,
-- so #3133 removed it again (and can be recovered from there if this was premature).
throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"

View File

@@ -29,7 +29,7 @@ if given, or the default `decreasing_tactic`.
For mutual recursion, a single measure is not just one parameter, but one from each recursive
function. Enumerating these can lead to a combinatoric explosion, so we bound
the nubmer of measures tried.
the number of measures tried.
In addition to measures derived from `sizeOf xᵢ`, it also considers measures
that assign an order to the functions themselves. This way we can support mutual
@@ -42,7 +42,7 @@ guessed lexicographic order.
The following optimizations are applied to make this feasible:
1. The crucial optimiziation is to look at each argument of each recursive call
1. The crucial optimization is to look at each argument of each recursive call
_once_, try to prove `<` and (if that fails `≤`), and then look at that table to
pick a suitable measure.
@@ -80,7 +80,7 @@ register_builtin_option showInferredTerminationBy : Bool := {
/--
Given a predefinition, return the variabe names in the outermost lambdas.
Given a predefinition, return the variable names in the outermost lambdas.
Includes the “fixed prefix”.
The length of the returned array is also used to determine the arity
@@ -550,7 +550,7 @@ where
failure
/--
Enumerate all meausures we want to try.
Enumerate all measures we want to try.
All arguments (resp. combinations thereof) and
possible orderings of functions (if more than one)

View File

@@ -17,7 +17,7 @@ private def shouldBetaReduce (e : Expr) (recFnNames : Array Name) : Bool :=
false
/--
Preprocesses the expessions to improve the effectiveness of `wfRecursion`.
Preprocesses the expressions to improve the effectiveness of `wfRecursion`.
* Floats out the RecApp markers.
Example:

View File

@@ -605,7 +605,7 @@ private partial def hasNoErrorIfUnused : Syntax → Bool
/--
Given `rhss` the right-hand-sides of a `match`-syntax notation,
We tag them with with fresh identifiers `alt_idx`. We use them to detect whether an alternative
We tag them with fresh identifiers `alt_idx`. We use them to detect whether an alternative
has been used or not.
The result is a triple `(altIdxMap, ignoreIfUnused, rhssNew)` where
- `altIdxMap` is a mapping from the `alt_idx` identifiers to right-hand-side indices.

View File

@@ -29,7 +29,7 @@ def getRecAppSyntax? (e : Expr) : Option Syntax :=
| _ => none
/--
Checks if the `MData` is for a recursive applciation.
Checks if the `MData` is for a recursive application.
-/
def MData.isRecApp (d : MData) : Bool :=
d.contains recAppKey

View File

@@ -682,7 +682,12 @@ private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : Term
-- We add info to get reliable positions for messages from evaluating the tactic script.
let info := field.ref.getHeadInfo
let stx := stx.raw.rewriteBottomUp (·.setInfo info)
cont ( elabTermEnsuringType stx (d.getArg! 0).consumeTypeAnnotations) field
let type := (d.getArg! 0).consumeTypeAnnotations
let mvar mkTacticMVar type stx (.fieldAutoParam fieldName s.structName)
-- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
-- (See the aformentioned `processExplicitArg` for a comment about this.)
addTermInfo' stx mvar
cont mvar field
| _ =>
if bi == .instImplicit then
let val withRef field.ref <| mkFreshExprMVar d .synthetic

View File

@@ -468,7 +468,8 @@ where
if h : i < view.parents.size then
let parentStx := view.parents.get i, h
withRef parentStx do
let parentType Term.elabType parentStx
let parentType Term.withSynthesize <| Term.elabType parentStx
let parentType whnf parentType
let parentStructName getStructureName parentType
if let some existingFieldName findExistingField? infos parentStructName then
if structureDiamondWarning.get ( getOptions) then
@@ -772,7 +773,7 @@ private partial def mkCoercionToCopiedParent (levelParams : List Name) (params :
let some fieldInfo := getFieldInfo? env parentStructName fieldName | unreachable!
if fieldInfo.subobject?.isNone then throwError "failed to build coercion to parent structure"
let resultType whnfD ( inferType result)
unless resultType.isForall do throwError "failed to build coercion to parent structure, unexpect type{indentExpr resultType}"
unless resultType.isForall do throwError "failed to build coercion to parent structure, unexpected type{indentExpr resultType}"
let fieldVal copyFields resultType.bindingDomain!
result := mkApp result fieldVal
return result

View File

@@ -21,7 +21,7 @@ private def resumeElabTerm (stx : Syntax) (expectedType? : Option Expr) (errToSo
elabTerm stx expectedType? false
/--
Try to elaborate `stx` that was postponed by an elaboration method using `Expection.postpone`.
Try to elaborate `stx` that was postponed by an elaboration method using `Exception.postpone`.
It returns `true` if it succeeded, and `false` otherwise.
It is used to implement `synthesizeSyntheticMVars`. -/
private def resumePostponed (savedContext : SavedContext) (stx : Syntax) (mvarId : MVarId) (postponeOnError : Bool) : TermElabM Bool :=
@@ -86,7 +86,7 @@ private def synthesizePendingInstMVar (instMVar : MVarId) (extraErrorMsg? : Opti
example (a : Int) (b c : Nat) : a = ↑b - ↑c := sorry
```
We have two pending coercions for the `↑` and `HSub ?m.220 ?m.221 ?m.222`.
When we did not use a backtracking search here, then the homogenous default instance for `HSub`.
When we did not use a backtracking search here, then the homogeneous default instance for `HSub`.
```
instance [Sub α] : HSub α α α where
```
@@ -306,7 +306,7 @@ inductive PostponeBehavior where
| no
/--
Synthectic metavariables associated with type class resolution can be postponed.
Motivation: this kind of metavariable are not synthethic opaque, and can be assigned by `isDefEq`.
Motivation: this kind of metavariable are not synthetic opaque, and can be assigned by `isDefEq`.
Unviverse constraints can also be postponed.
-/
| «partial»
@@ -316,6 +316,18 @@ def PostponeBehavior.ofBool : Bool → PostponeBehavior
| true => .yes
| false => .no
private def TacticMVarKind.logError (tacticCode : Syntax) (kind : TacticMVarKind) : TermElabM Unit := do
match kind with
| term => pure ()
| autoParam argName => logErrorAt tacticCode m!"could not synthesize default value for parameter '{argName}' using tactics"
| fieldAutoParam fieldName structName => logErrorAt tacticCode m!"could not synthesize default value for field '{fieldName}' of '{structName}' using tactics"
private def TacticMVarKind.maybeWithoutRecovery (kind : TacticMVarKind) (m : TacticM α) : TacticM α := do
if kind matches .autoParam .. | .fieldAutoParam .. then
withoutErrToSorry <| Tactic.withoutRecover <| m
else
m
mutual
/--
@@ -325,7 +337,7 @@ mutual
If `report := false`, then `runTactic` will not capture exceptions nor will report unsolved goals. Unsolved goals become exceptions.
-/
partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) (report := true) : TermElabM Unit := withoutAutoBoundImplicit do
partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) (kind : TacticMVarKind) (report := true) : TermElabM Unit := withoutAutoBoundImplicit do
instantiateMVarDeclMVars mvarId
/-
TODO: consider using `runPendingTacticsAt` at `mvarId` local context and target type.
@@ -342,7 +354,7 @@ mutual
in more complicated scenarios.
-/
tryCatchRuntimeEx
(do let remainingGoals withInfoHole mvarId <| Tactic.run mvarId do
(do let remainingGoals withInfoHole mvarId <| Tactic.run mvarId <| kind.maybeWithoutRecovery do
withTacticInfoContext tacticCode do
-- also put an info node on the `by` keyword specifically -- the token may be `canonical` and thus shown in the info
-- view even though it is synthetic while a node like `tacticCode` never is (#1990)
@@ -354,10 +366,13 @@ mutual
synthesizeSyntheticMVars (postpone := .no)
unless remainingGoals.isEmpty do
if report then
kind.logError tacticCode
reportUnsolvedGoals remainingGoals
else
throwError "unsolved goals\n{goalsToMessageData remainingGoals}")
fun ex => do
if report then
kind.logError tacticCode
if report && ( read).errToSorry then
for mvarId in ( getMVars (mkMVar mvarId)) do
mvarId.admit
@@ -385,10 +400,10 @@ mutual
return false
-- NOTE: actual processing at `synthesizeSyntheticMVarsAux`
| .postponed savedContext => resumePostponed savedContext mvarSyntheticDecl.stx mvarId postponeOnError
| .tactic tacticCode savedContext =>
| .tactic tacticCode savedContext kind =>
withSavedContext savedContext do
if runTactics then
runTactic mvarId tacticCode
runTactic mvarId tacticCode kind
return true
else
return false
@@ -512,7 +527,7 @@ private partial def withSynthesizeLightImp (k : TermElabM α) : TermElabM α :=
finally
modify fun s => { s with pendingMVars := s.pendingMVars ++ pendingMVarsSaved }
/-- Similar to `withSynthesize`, but uses `postpone := .true`, does not use use `synthesizeUsingDefault` -/
/-- Similar to `withSynthesize`, but uses `postpone := .true`, does not use `synthesizeUsingDefault` -/
@[inline] def withSynthesizeLight [MonadFunctorT TermElabM m] (k : m α) : m α :=
monadMap (m := TermElabM) (withSynthesizeLightImp ·) k
@@ -529,9 +544,9 @@ the result of a tactic block.
def runPendingTacticsAt (e : Expr) : TermElabM Unit := do
for mvarId in ( getMVars e) do
let mvarId getDelayedMVarRoot mvarId
if let some { kind := .tactic tacticCode savedContext, .. } getSyntheticMVarDecl? mvarId then
if let some { kind := .tactic tacticCode savedContext kind, .. } getSyntheticMVarDecl? mvarId then
withSavedContext savedContext do
runTactic mvarId tacticCode
runTactic mvarId tacticCode kind
markAsResolved mvarId
builtin_initialize

View File

@@ -71,7 +71,7 @@ For the second kind more steps are involved:
3. Verify that algorithm in `Std.Tactic.BVDecide.Bitblast.BVExpr.Circuit.Lemmas`.
4. Integrate it with either the expression or predicate bitblaster and use the proof above to verify it.
5. Add simplification lemmas for the primitive to `bv_normalize` in `Std.Tactic.BVDecide.Normalize`.
If there are mutliple ways to write the primitive (e.g. with TC based notation and without) you
If there are multiple ways to write the primitive (e.g. with TC based notation and without) you
should normalize for one notation here.
6. Add the reflection code to `Lean.Elab.Tactic.BVDecide.Frontend.BVDecide`
7. Add a test!

View File

@@ -24,7 +24,7 @@ register_builtin_option sat.solver : String := {
defValue := ""
descr :=
"Name of the SAT solver used by Lean.Elab.Tactic.BVDecide tactics.\n
1. If this is set to something besides the emtpy string they will use that binary.\n
1. If this is set to something besides the empty string they will use that binary.\n
2. If this is set to the empty string they will check if there is a cadical binary next to the\
executing program. Usually that program is going to be `lean` itself and we do ship a\
`cadical` next to it.\n

View File

@@ -44,7 +44,7 @@ def bvCheck (g : MVarId) (cfg : TacticContext) : MetaM Unit := do
let unsatProver : UnsatProver := fun reflectionResult _ => do
withTraceNode `sat (fun _ => return "Preparing LRAT reflection term") do
let proof lratChecker cfg reflectionResult.bvExpr
return proof, ""
return .ok proof, ""
let _ closeWithBVReflection g unsatProver
return ()

View File

@@ -79,18 +79,26 @@ structure ReflectionResult where
proveFalse : Expr M Expr
unusedHypotheses : Std.HashSet FVarId
/--
A counter example generated from the bitblaster.
-/
structure CounterExample where
/--
The set of unused but potentially relevant hypotheses. Useful for diagnosing spurious counter
examples.
-/
unusedHypotheses : Std.HashSet FVarId
/--
The actual counter example as a list of equations denoted as `expr = value` pairs.
-/
equations : Array (Expr × BVExpr.PackedBitVec)
structure UnsatProver.Result where
proof : Expr
lratCert : LratCert
abbrev UnsatProver := ReflectionResult Std.HashMap Nat (Nat × Expr) MetaM UnsatProver.Result
/--
Contains values that will be used to diagnose spurious counter examples.
-/
structure DiagnosisInput where
unusedHypotheses : Std.HashSet FVarId
atomsAssignment : Std.HashMap Nat (Nat × Expr)
abbrev UnsatProver := ReflectionResult Std.HashMap Nat (Nat × Expr)
MetaM (Except CounterExample UnsatProver.Result)
/--
The result of a spurious counter example diagnosis.
@@ -99,20 +107,19 @@ structure Diagnosis where
uninterpretedSymbols : Std.HashSet Expr := {}
unusedRelevantHypotheses : Std.HashSet FVarId := {}
abbrev DiagnosisM : Type Type := ReaderT DiagnosisInput <| StateRefT Diagnosis MetaM
abbrev DiagnosisM : Type Type := ReaderT CounterExample <| StateRefT Diagnosis MetaM
namespace DiagnosisM
def run (x : DiagnosisM Unit) (unusedHypotheses : Std.HashSet FVarId)
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) : MetaM Diagnosis := do
let (_, issues) ReaderT.run x { unusedHypotheses, atomsAssignment } |>.run {}
def run (x : DiagnosisM Unit) (counterExample : CounterExample) : MetaM Diagnosis := do
let (_, issues) ReaderT.run x counterExample |>.run {}
return issues
def unusedHyps : DiagnosisM (Std.HashSet FVarId) := do
return ( read).unusedHypotheses
def atomsAssignment : DiagnosisM (Std.HashMap Nat (Nat × Expr)) := do
return ( read).atomsAssignment
def equations : DiagnosisM (Array (Expr × BVExpr.PackedBitVec)) := do
return ( read).equations
def addUninterpretedSymbol (e : Expr) : DiagnosisM Unit :=
modify fun s => { s with uninterpretedSymbols := s.uninterpretedSymbols.insert e }
@@ -131,7 +138,7 @@ Diagnose spurious counter examples, currently this checks:
- Whether all hypotheses which contain any variable that was bitblasted were included
-/
def diagnose : DiagnosisM Unit := do
for (_, (_, expr)) in atomsAssignment do
for (expr, _) in equations do
match_expr expr with
| BitVec.ofBool x =>
match x with
@@ -157,9 +164,8 @@ def unusedRelevantHypothesesExplainer (d : Diagnosis) : Option MessageData := do
def explainers : List (Diagnosis Option MessageData) :=
[uninterpretedExplainer, unusedRelevantHypothesesExplainer]
def explainCounterExampleQuality (unusedHypotheses : Std.HashSet FVarId)
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) : MetaM MessageData := do
let diagnosis DiagnosisM.run DiagnosisM.diagnose unusedHypotheses atomsAssignment
def explainCounterExampleQuality (counterExample : CounterExample) : MetaM MessageData := do
let diagnosis DiagnosisM.run DiagnosisM.diagnose counterExample
let folder acc explainer := if let some m := explainer diagnosis then acc.push m else acc
let explanations := explainers.foldl (init := #[]) folder
@@ -173,7 +179,7 @@ def explainCounterExampleQuality (unusedHypotheses : Std.HashSet FVarId)
def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
(atomsAssignment : Std.HashMap Nat (Nat × Expr)) :
MetaM UnsatProver.Result := do
MetaM (Except CounterExample UnsatProver.Result) := do
let bvExpr := reflectionResult.bvExpr
let entry
withTraceNode `bv (fun _ => return "Bitblasting BVLogicalExpr to AIG") do
@@ -201,13 +207,10 @@ def lratBitblaster (cfg : TacticContext) (reflectionResult : ReflectionResult)
match res with
| .ok cert =>
let proof cert.toReflectionProof cfg bvExpr ``verifyBVExpr ``unsat_of_verifyBVExpr_eq_true
return proof, cert
return .ok proof, cert
| .error assignment =>
let reconstructed := reconstructCounterExample map assignment aigSize atomsAssignment
let mut error explainCounterExampleQuality reflectionResult.unusedHypotheses atomsAssignment
for (var, value) in reconstructed do
error := error ++ m!"{var} = {value.bv}\n"
throwError error
let equations := reconstructCounterExample map assignment aigSize atomsAssignment
return .error { unusedHypotheses := reflectionResult.unusedHypotheses, equations }
def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
@@ -219,23 +222,24 @@ def reflectBV (g : MVarId) : M ReflectionResult := g.withContext do
sats := sats.push reflected
else
unusedHypotheses := unusedHypotheses.insert hyp
if sats.size = 0 then
if h : sats.size = 0 then
let mut error := "None of the hypotheses are in the supported BitVec fragment.\n"
error := error ++ "There are two potential fixes for this:\n"
error := error ++ "1. If you are using custom BitVec constructs simplify them to built-in ones.\n"
error := error ++ "2. If your problem is using only built-in ones it might currently be out of reach.\n"
error := error ++ " Consider expressing it in terms of different operations that are better supported."
throwError error
let sat := sats.foldl (init := SatAtBVLogical.trivial) SatAtBVLogical.and
return {
bvExpr := sat.bvExpr,
proveFalse := sat.proveFalse,
unusedHypotheses := unusedHypotheses
}
else
let sat := sats[1:].foldl (init := sats[0]) SatAtBVLogical.and
return {
bvExpr := sat.bvExpr,
proveFalse := sat.proveFalse,
unusedHypotheses := unusedHypotheses
}
def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
MetaM LratCert := M.run do
MetaM (Except CounterExample LratCert) := M.run do
g.withContext do
let reflectionResult
withTraceNode `bv (fun _ => return "Reflecting goal into BVLogicalExpr") do
@@ -244,26 +248,54 @@ def closeWithBVReflection (g : MVarId) (unsatProver : UnsatProver) :
let atomsPairs := ( getThe State).atoms.toList.map (fun (expr, width, ident) => (ident, (width, expr)))
let atomsAssignment := Std.HashMap.ofList atomsPairs
let bvExprUnsat, cert unsatProver reflectionResult atomsAssignment
let proveFalse reflectionResult.proveFalse bvExprUnsat
g.assign proveFalse
return cert
match unsatProver reflectionResult atomsAssignment with
| .ok bvExprUnsat, cert =>
let proveFalse reflectionResult.proveFalse bvExprUnsat
g.assign proveFalse
return .ok cert
| .error counterExample => return .error counterExample
def bvUnsat (g : MVarId) (cfg : TacticContext) : MetaM LratCert := M.run do
def bvUnsat (g : MVarId) (cfg : TacticContext) : MetaM (Except CounterExample LratCert) := M.run do
let unsatProver : UnsatProver := fun reflectionResult atomsAssignment => do
withTraceNode `bv (fun _ => return "Preparing LRAT reflection term") do
lratBitblaster cfg reflectionResult atomsAssignment
closeWithBVReflection g unsatProver
/--
The result of calling `bv_decide`.
-/
structure Result where
/--
Trace of the `simp` used in `bv_decide`'s normalization procedure.
-/
simpTrace : Simp.Stats
/--
If the normalization step was not enough to solve the goal this contains the LRAT proof
certificate.
-/
lratCert : Option LratCert
def bvDecide (g : MVarId) (cfg : TacticContext) : MetaM Result := do
/--
Try to close `g` using a bitblaster. Return either a `CounterExample` if one is found or a `Result`
if `g` is proven.
-/
def bvDecide' (g : MVarId) (cfg : TacticContext) : MetaM (Except CounterExample Result) := do
let g?, simpTrace Normalize.bvNormalize g
let some g := g? | return simpTrace, none
let lratCert bvUnsat g cfg
return simpTrace, some lratCert
let some g := g? | return .ok simpTrace, none
match bvUnsat g cfg with
| .ok lratCert => return .ok simpTrace, some lratCert
| .error counterExample => return .error counterExample
/--
Call `bvDecide'` and throw a pretty error if a counter example ends up being produced.
-/
def bvDecide (g : MVarId) (cfg : TacticContext) : MetaM Result := do
match bvDecide' g cfg with
| .ok result => return result
| .error counterExample =>
let error explainCounterExampleQuality counterExample
let folder := fun error (var, value) => error ++ m!"{var} = {value.bv}\n"
throwError counterExample.equations.foldl (init := error) folder
@[builtin_tactic Lean.Parser.Tactic.bvDecide]
def evalBvTrace : Tactic := fun

View File

@@ -75,9 +75,7 @@ instance : ToExpr Gate where
toExpr x :=
match x with
| .and => mkConst ``Gate.and
| .or => mkConst ``Gate.or
| .xor => mkConst ``Gate.xor
| .imp => mkConst ``Gate.imp
| .beq => mkConst ``Gate.beq
toTypeExpr := mkConst ``Gate

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