Compare commits

...

236 Commits

Author SHA1 Message Date
Scott Morrison
e7cab3c032 chore: upstream Std's material on Ord and Ordering 2024-02-16 13:17:35 +11:00
Scott Morrison
a4e27d3090 chore: upstream HashSet.merge (#3357) 2024-02-16 01:38:16 +00:00
Joe Hendrix
1d9074c524 chore: upstream NatCast and IntCast (#3347)
This upstreams NatCast and IntCast alone independent of norm_cast in
#3322.

This will allow more efficiently upstreaming parts of Std.Data.Int
relevant for omega.

---------

Co-authored-by: Scott Morrison <scott.morrison@gmail.com>
2024-02-16 00:54:22 +00:00
Kyle Miller
e29d75a961 feat: have pp.proofs use for omission (#3241)
By having the `pp.proofs` feature use `⋯` when omitting proofs, when
users copy/paste terms from the InfoView the elaborator can give an
error message explaining why the term cannot be elaborated.

Also adds `pp.proofs.threshold` option to allow users to pretty print
shallow proof terms. By default, only atomic proof terms are pretty
printed.

This adjustment was suggested in PR #3201, which added `⋯` and the
related `pp.deepTerms` option.
2024-02-15 21:49:41 +00:00
Kyle Miller
8aab74e65d fix: make withOverApp annotate the expression position and register TermInfo (#3327)
This makes it so that when `withOverApp` is handling overapplied
functions, the term produced by the supplied delaborator is hoverable in
the Infoview.
2024-02-15 17:40:54 +00:00
Sebastian Ullrich
4e58b428e9 doc: add Kyle Miller as delaborator code owner 2024-02-15 17:42:57 +01:00
Lean stage0 autoupdater
271ae5b8e5 chore: update stage0 2024-02-15 12:32:00 +00:00
Leonardo de Moura
a14bbbffb2 chore: add [ext] basic theorems, add test 2024-02-15 13:26:01 +01:00
Scott Morrison
5a95f91fae chore: update stage0 2024-02-15 13:26:01 +01:00
Scott Morrison
11727a415b chore: upstream ext
and_intros and subst_eqs are not builtin

clarify failure modes

Clarify docString of extCore

clarify

chore: builtin `subst_eqs` tactic

chore: builtin `ext`
2024-02-15 13:26:01 +01:00
Sebastian Ullrich
90a516de09 chore: avoid libleanshared symbol limit (#3346) 2024-02-15 11:39:44 +00:00
Scott Morrison
ae524d465f chore: a missing List lemma in Init (#3344) 2024-02-15 08:55:48 +00:00
Scott Morrison
9a3f0f1909 chore: upstream Std.Data.Array.Init.Lemmas (#3343) 2024-02-15 17:50:07 +11:00
Scott Morrison
fae5b2e87c chore: upstream Std.Data.List.Init.Lemmas (#3341) 2024-02-15 03:19:23 +00:00
Leonardo de Moura
2bd187044f chore: builtin haveI and letI 2024-02-15 14:33:36 +11:00
Scott Morrison
144c1bbbaf chore: update stage0 2024-02-15 14:33:36 +11:00
Scott Morrison
98085661c7 chore: upstream haveI tactic
chore: `haveI` and `letI` builtin parsers
2024-02-15 14:33:36 +11:00
Scott Morrison
9cea1a503e chore: upstream Std.Data.Prod.Lex (#3338) 2024-02-15 02:47:08 +00:00
Joe Hendrix
25147accc8 chore: upstream set notation (#3339)
This upstream Std Set notation except for [set
literals](1b4e6926f0/Std/Classes/SetNotation.lean (L115-L131)).
2024-02-15 02:08:45 +00:00
Scott Morrison
6048ba9832 chore: upstream Std.Classes.LawfulMonad (except SatisfiesM) (#3340) 2024-02-15 01:52:02 +00:00
Scott Morrison
33bb87cd1d chore: upstream Std.Data.Fin.Init.Lemmas (#3337) 2024-02-15 01:50:47 +00:00
Scott Morrison
4aa62a6a9c chore: upstream Std.Data.List.Init.Basic (#3335) 2024-02-15 01:50:33 +00:00
Joe Hendrix
eebdfdf87a chore: upstream of Std.Data.Nat.Init (#3331) 2024-02-15 00:18:41 +00:00
Leonardo de Moura
01c9f4c783 fix: run_meta macro (#3334) 2024-02-15 00:12:45 +00:00
Kyle Miller
a706c3b89a feat: delaboration collapses parent projections (#3326)
When projection functions are delaborated, intermediate parent
projections are no longer printed. For example, rather than pretty
printing as `o.toB.toA.x` with these `toB` and `toA` parent projections,
it pretty prints as `o.x`.

This feature is being upstreamed from mathlib.
2024-02-14 23:44:48 +00:00
Scott Morrison
329e00661a chore: upstream Std.Util.ExtendedBinders (#3320)
This is not a complete upstreaming of that file (it also supports `∀ᵉ (x
< 2) (y < 3), p x y` as shorthand for `∀ x < 2, ∀ y < 3, p x y`, but I
don't think we need this; it is used in Mathlib).

Syntaxes still need to be made built-in.

---------

Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-02-14 11:36:00 +00:00
Joe Hendrix
8b0dd2e835 chore: upstream Std.Logic (#3312)
This will collect definitions from Std.Logic

---------

Co-authored-by: David Thrane Christiansen <david@davidchristiansen.dk>
Co-authored-by: Scott Morrison <scott.morrison@gmail.com>
2024-02-14 09:40:55 +00:00
Leonardo de Moura
88a5d27d65 chore: upstream run_cmd and fixes bugs (#3324)
Co-authored-by: Scott Morrison <scott.morrison@gmail.com>
2024-02-14 04:15:28 +00:00
Scott Morrison
232b2b6300 chore: upstream replace tactic (#3321)
Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-02-14 01:53:25 +00:00
Scott Morrison
fdc64def1b feat: upstream 'Try this:' widgets (#3266)
There is a test file in Std that should later be reunited with this
code.

---------

Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2024-02-13 21:58:36 +00:00
Leonardo de Moura
644d4263f1 fix: #eval command was leaking auxiliary declarations into the environment (#3323) 2024-02-13 21:44:52 +00:00
Mario Carneiro
56d703db8e fix: trailing whitespace in location formatter (#3318)
This causes problems when used in conjunction with `#guard_msgs` (which
checks whitespace) and trailing whitespace removal. Discovered by
@PatrickMassot in verbose-lean4.
2024-02-13 15:53:29 +00:00
Henrik Böving
50d661610d perf: LLVM backend, put all allocas in the first BB to enable mem2reg (#3244)
Again co-developed with @bollu.

Based on top of: #3225 

While hunting down the performance discrepancy on qsort.lean between C
and LLVM we noticed there was a single, trivially optimizeable, alloca
(LLVM's stack memory allocation instruction) that had load/stores in the
hot code path. We then found:
https://groups.google.com/g/llvm-dev/c/e90HiFcFF7Y.

TLDR: `mem2reg`, the pass responsible for getting rid of allocas if
possible, only triggers on an alloca if it is in the first BB. The
allocas of the current implementation get put right at the location
where they are needed -> they are ignored by mem2reg.

Thus we decided to add functionality that allows us to push all allocas
up into the first BB.
We initially wanted to write `buildPrologueAlloca` in a `withReader`
style so:
1. get the current position of the builder
2. jump to first BB and do the thing
3. revert position to the original

However the LLVM C API does not expose an option to obtain the current
position of an IR builder. Thus we ended up at the current
implementation which resets the builder position to the end of the BB
that the function was called from. This is valid because we never
operate anywhere but the end of the current BB in the LLVM emitter.

The numbers on the qsort benchmark got improved by the change as
expected, however we are not fully there yet:
```
C:
Benchmark 1: ./qsort.lean.out 400
  Time (mean ± σ):      2.005 s ±  0.013 s    [User: 1.996 s, System: 0.003 s]
  Range (min … max):    1.993 s …  2.036 s    10 runs

LLVM before aligning the types
Benchmark 1: ./qsort.lean.out 400
  Time (mean ± σ):      2.151 s ±  0.007 s    [User: 2.146 s, System: 0.001 s]
  Range (min … max):    2.142 s …  2.161 s    10 runs

LLVM after aligning the types
Benchmark 1: ./qsort.lean.out 400
  Time (mean ± σ):      2.073 s ±  0.011 s    [User: 2.067 s, System: 0.002 s]
  Range (min … max):    2.060 s …  2.097 s    10 runs

LLVM after this
Benchmark 1: ./qsort.lean.out 400
  Time (mean ± σ):      2.038 s ±  0.009 s    [User: 2.032 s, System: 0.001 s]
  Range (min … max):    2.027 s …  2.052 s    10 runs
```

Note: If you wish to merge this PR independently from its predecessor,
there is no technical dependency between the two, I'm merely stacking
them so we can see the performance impacts of each more clearly.
2024-02-13 14:54:40 +00:00
Eric Wieser
0554ab39aa doc: Add a docstring to Simp.Result and its fields (#3319) 2024-02-13 13:57:24 +00:00
Scott Morrison
3a6ebd88bb chore: upstream repeat/split_ands/subst_eqs (#3305)
Small tactics used in the implementation of `ext`.

---------

Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-02-13 12:21:14 +00:00
Henrik Böving
06f73d621b fix: type mismatches in the LLVM backend (#3225)
Debugged and authored in collaboration with @bollu.

This PR fixes several performance regressions of the LLVM backend
compared to the C backend
as described in #3192. We are now at the point where some benchmarks
from `tests/bench` achieve consistently equal and sometimes ever so
slightly better performance when using LLVM instead of C. However there
are still a few testcases where we are lacking behind ever so slightly.

The PR contains two changes:
1. Using the same types for `lean.h` runtime functions in the LLVM
backend as in `lean.h` it turns out that:
a) LLVM does not throw an error if we declare a function with a
different type than it actually has. This happened on multiple occasions
here, in particular when the function used `unsigned`, as it was
wrongfully assumed to be `size_t` sized.
b) Refuses to inline a function to the call site if such a type mismatch
occurs. This means that we did not inline important functionality such
as `lean_ctor_set` and were thus slowed down compared to the C backend
which did this correctly.
2. While developing this change we noticed that LLVM does treat the
following as invalid: Having a function declared with a certain type but
called with integers of a different type. However this will manifest in
completely nonsensical errors upon optimizing the bitcode file through
`leanc` such as:
```
error: Invalid record (Producer: 'LLVM15.0.7' Reader: 'LLVM 15.0.7')
```
Presumably because the generate .bc file is invalid in the first place.
Thus we added a call to `LLVMVerifyModule` before serializing the module
into a bitcode file. This ended producing the expected type errors from
LLVM an aborting the bitcode file generation as expected.

We manually checked each function in `lean.h` that is mentioned in
`EmitLLVM.lean` to make sure that all of their types align correctly
now.

Quick overview of the fast benchmarks as measured on my machine, 2 runs
of LLVM and 2 runs of C to get a feeling for how far the averages move:
- binarytrees: basically equal performance
- binarytrees.st: basically equal performance
- const_fold: equal if not slightly better for LLVM
- deriv: LLVM has 8% more instructions than C but same wall clock time
- liasolver: basically equal performance
- qsort: LLVM is slower by 7% instructions, 4% time. We have identified
why the generated code is slower (there is a store/load in a hot loop in
LLVM that is not in C) but not figured out why that happens/how to
address it.
- rbmap: LLVM has 3% less instructions and 13% less wall-clock time than
C (woop woop)
- rbmap_1 and rbmap_10 show similar behavior
- rbmap_fbip: LLVM has 2% more instructions but 2% better wall time
- rbmap_library: equal if not slightly better for LLVM
- unionfind: LLVM has 5% more instructions but 4% better wall time

Leaving out benchmarks related to the compiler itself as I was too lazy
to keep recompiling it from scratch until we are on a level with C.

Summing things up, it appears that LLVM has now caught up or surpassed
the C backend in the microbenchmarks for the most part. Next steps from
our side are:
- trying to win the qsort benchmark
- figuring out why/how LLVM runs more instructions for less wall-clock
time. My current guesses would be measurement noise and/or better use of
micro architecture?
- measuring the larger benchmarks as well
2024-02-13 10:57:35 +00:00
Scott Morrison
c27474341e chore: upstream change tactic (#3308)
We previously had the syntax for `change` and `change at`, but no
implementation.

This moves Kyle's implementation from Std.

This also changes the `changeLocalDecl` function to push nodes to the
infotree about FVar aliases.

---------

Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
Co-authored-by: David Thrane Christiansen <david@davidchristiansen.dk>
2024-02-13 04:47:11 +00:00
Scott Morrison
27b962f14d chore: upstream liftCommandElabM (#3304)
These are used in the implementation of `ext`.
2024-02-13 04:17:19 +00:00
Scott Morrison
2032ffa3fc chore: DiscrTree helper functions (#3303)
`DiscrTree` helper functions from `Std`, used in `ext`, `exact?`, and
`aesop`.

(There are a few more to follow later, with other Std dependencies.)
2024-02-13 03:46:31 +00:00
Scott Morrison
c424d99cc9 chore: upstream left/right tactics (#3307)
Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
2024-02-13 03:45:59 +00:00
Mario Carneiro
fbedb79b46 fix: add_decl_doc should check that declarations are local (#3311)
This was causing a panic previously, [reported on
Zulip](https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/CI.20errors.20that.20are.20not.20local.20errors/near/420986393).
2024-02-12 12:04:51 +00:00
Eric Wieser
1965a022eb doc: fix typos around inductiveCheckResultingUniverse (#3309)
The unpaired backtick was causing weird formatting in vscode doc hovers.

Also closes an unpaired `(` in an error message.
2024-02-12 10:11:50 +00:00
Scott Morrison
90b08ef22e feat: upstream guard_expr (#3297)
Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-02-11 23:25:04 +00:00
Wojciech Nawrocki
66e8cb7966 doc: implicit type arguments are indexed in the discrtree (#3301)
A small fix to the `DiscrTree` documentation to reflect the fact that
implicit type arguments *are* indexed and do not become `star` or
`other`. The following is a reproduction:
```lean
import Lean
open Lean Meta Elab Tactic

elab "test_tac" t:term : tactic => do
  Tactic.withMainContext do
    let e ← Term.elabTerm t none
    let a : DiscrTree Nat ← DiscrTree.empty.insert e 1 {}
    logInfo m!"{a}"

example (α : Type) (ringAdd : Add α) : True := by
  /- (Add.add => (node (Nat => (node (* => (node (0 => (node (1 => (node #[1])))))))))) -/
  test_tac @Add.add Nat instAddNat 0 1
  /- (Add.add => (node (_uniq.1154 => (node (* => (node ( => (node ( => (node #[1])))))))))) -/
  test_tac @Add.add α ringAdd ?_ ?_
```
2024-02-11 21:42:54 +00:00
Scott Morrison
4718af5474 chore: upstream rcases (#3292)
This moves the `rcases` and `obtain` tactics from Std, and makes them
built-in tactics.

We will separately move the test cases from Std after #3297
(`guard_expr`).

---------

Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-02-10 05:22:02 +00:00
Leonardo de Moura
c138801c3a chore: rwa tactic macro (#3299) 2024-02-10 04:59:24 +00:00
Leonardo de Moura
5b4c24ff97 chore: add nomatch tactic (#3294) 2024-02-10 04:59:06 +00:00
Leonardo de Moura
1cb7450f40 fix: nomatch regression (#3296) 2024-02-10 04:58:48 +00:00
Leonardo de Moura
02d1ebb564 fix: extended coe notation and delaborator (#3295) 2024-02-10 04:58:28 +00:00
Lean stage0 autoupdater
488bfe2128 chore: update stage0 2024-02-09 12:46:12 +00:00
Sebastian Ullrich
55402a5899 feat: add [builtin_code_action_provider] (#3289) 2024-02-09 11:51:40 +00:00
Sebastian Ullrich
659218cf17 feat: add [builtin_widget_module] (#3288) 2024-02-09 11:20:46 +00:00
Scott Morrison
904239ae61 feat: upstream some Syntax/Position helper functions used in code actions in Std (#3260)
Co-authored-by: David Thrane Christiansen <david@davidchristiansen.dk>
2024-02-09 10:50:19 +00:00
Sebastian Ullrich
b548b4faae refactor: make Promise implementation opaque (#3273)
This follows the standard `Ref` recipe and moves the `unsafeCast` into
C++
2024-02-09 10:43:41 +00:00
Scott Morrison
a7364499d2 chore: update line numbers in test after rebase 2024-02-09 10:05:54 +01:00
Leonardo de Moura
003835111d chore: fix tests 2024-02-09 18:23:46 +11:00
Scott Morrison
61a8695ab1 chore: update stage0 2024-02-09 18:23:46 +11:00
Leonardo de Moura
127214bd18 chore: cleanup and move unsafe term elaborator to BuiltinNotation 2024-02-09 18:23:46 +11:00
Scott Morrison
b1944b662c chore: update stage0 2024-02-09 18:23:46 +11:00
Leonardo de Moura
a17832ba14 chore: add unsafe term builtin parser 2024-02-09 18:23:46 +11:00
Scott Morrison
561ac09d61 chore: make mkAuxName private, add comment about alternatives 2024-02-09 18:23:46 +11:00
Scott Morrison
f68429d3a7 chore: move syntax to Init/Notation, make builtin_term_elab 2024-02-09 18:23:46 +11:00
Scott Morrison
a58232b820 core: upstream Std.Util.TermUnsafe 2024-02-09 18:23:46 +11:00
Scott Morrison
696b08dca2 chore: upstream Std.Tactic.CoeExt to Lean.Elab.CoeExt (#3280)
Moves the `@[coe]` attribute and associated elaborators/delaborators
from Std to Lean.

---------

Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-02-09 04:55:49 +00:00
Scott Morrison
3a63b72eea chore: update stage0 2024-02-09 15:56:57 +11:00
Leonardo de Moura
9c160b8030 feat: nofun tactic and term
closes #3279
2024-02-09 15:56:57 +11:00
Scott Morrison
4bd75825b4 chore: update stage0 2024-02-09 15:56:57 +11:00
Leonardo de Moura
709e9909e7 feat: add nofun term parser
This new syntax suggested by @semorrison for the `fun.` Std macro.
2024-02-09 15:56:57 +11:00
Scott Morrison
83dd720337 chore: upstream MetavarContext helpers (#3284)
These are from Std, but mostly used in Aesop.
2024-02-09 03:58:10 +00:00
Scott Morrison
ac631f4736 feat: allow overriding getSimpTheorems in mkSimpContext (#3281)
The `push_cast` tactic in Std currently uses a copy-paste version of
`mkSimpContext` that allows overriding `getSimpTheorems`. However it has
been diverging from the version in Lean.

This is one way of generalizing `mkSimpContext` in Lean to allow what is
needed downstream., but I'm not at all set on this one. As far as I can
see there are no other tactics currently using this.

`push_cast` itself just replaces `getSimpTheorems` with
`pushCastExt.getTheorems`, where `pushCastExt` is a simp extension. If
there is another approach that suits that situation it would be fine.

I've tested that the change in this PR works downstream.
2024-02-09 03:57:40 +00:00
Leonardo de Moura
1f547225d1 feat: nary nomatch (#3285)
Base for https://github.com/leanprover/lean4/pull/3279

---------

Co-authored-by: Scott Morrison <scott.morrison@gmail.com>
2024-02-09 00:28:34 +00:00
Leonardo de Moura
09a43990aa refactor: move if-then-else tactic to Init 2024-02-09 09:57:57 +11:00
Leonardo de Moura
819848a0db chore: update stage0 2024-02-09 09:57:57 +11:00
Leonardo de Moura
8f8b0a8322 chore: fix proofs and test 2024-02-09 09:57:57 +11:00
Leonardo de Moura
9f633dcba2 chore: add register_parser_alias for matchRhs 2024-02-09 09:57:57 +11:00
Leonardo de Moura
cd4c7e4c35 refactor: move by_cases to Init/Classical.lean 2024-02-09 09:57:57 +11:00
Scott Morrison
9908823764 chore: upstream Std.Tactic.ByCases 2024-02-09 09:57:57 +11:00
Joe Hendrix
3e313d38f4 chore: upstream Std.Data.Array.Init.Basic (#3282)
This migrates the handful of array operations in
[Std.Data.Array.Init.Basic](https://github.com/leanprover/std4/blob/main/Std/Data/Array/Init/Basic.lean).
2024-02-08 19:30:47 +00:00
Scott Morrison
1b101a3d43 chore: upstream Std.Lean.Tactic (#3278)
A simple one, a small variant on `evalTacticAt`.

Perhaps a rename is in order?
2024-02-08 19:30:08 +00:00
Joe Hendrix
adcec8e67a chore: upstream Divides class and syntax (#3283)
This just upstreams the class and notation. Instances will be provided
with Nat/Int upstream
2024-02-08 08:09:02 +00:00
Scott Morrison
86d032ebf9 chore: upstream Std.Lean.LocalContext (#3275) 2024-02-08 07:43:25 +00:00
Scott Morrison
92ca504903 feat: upstreaming the json% term elaborator (#3265)
This is used in the "Try this:" widget machinery powering `simp?`.

There is a test file in Std, which I am not upstreaming at the same
time, as that relies on more code actions / #guard_msgs material. That
test file will still of course test things from Std, and later it can be
reunited with the code it is testing.

---------

Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
2024-02-08 03:30:41 +00:00
Scott Morrison
021dd2d509 feat: additional options for Format.pretty (#3264)
These additional options are currently implemented in Std in a function
`Format.prettyExtra` (via `open private`), and used to implement the
`simp?` functionality.

This just adds the options to the core function.
2024-02-07 23:25:21 +00:00
Scott Morrison
2ad3c6406e feat: upstream TSyntax helper functions (#3261)
From Std.Lean.Syntax.
2024-02-07 22:53:27 +00:00
Scott Morrison
211770e2f9 feat: upstream helper functions for Name (#3263)
This does not completely empty `Std.Lean.Name`, as working out how to
document the difference between `Name.isInternalDetail` and
`Name.isImplementationDetail` requires further thought.
2024-02-07 21:51:58 +00:00
Leonardo de Moura
760e824b9f fix: we should not crash when simp loops (#3269)
see #3267
2024-02-07 02:30:28 +00:00
Scott Morrison
17722369c6 feat: InfoTree helper function used in code actions (#3262)
Co-authored-by: David Thrane Christiansen <david@davidchristiansen.dk>
2024-02-06 23:31:28 +00:00
Joachim Breitner
64688d4cee fix: let induction handle parameters (#3256)
The induction principle used by `induction` may have explicit parameters
that are
not motive, target or “real” alternatives (that have the `motive` as
conclusion), e.g. restrictions on the `motive` or other parameters.

Previously, `induction` would treat them as normal alternatives, and try
to re-introduce the automatically reverted hypotheses. But this only
works when the `motive` is actually the conclusion in the type of that
alternative.

We now pay attention to that, thread that information through, and only
revert when needed.

Fixes #3212.
2024-02-06 20:32:12 +00:00
Scott Morrison
69d462623e fix: don't drop doc-comments on simprocs (#3259) 2024-02-06 20:31:36 +00:00
Leonardo de Moura
17520fa0b8 fix: cache issue at split tatic (#3258)
closes #3229

---------

Co-authored-by: Scott Morrison <scott.morrison@gmail.com>
Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
2024-02-06 19:44:28 +00:00
Jesse Wright
0055baf73a doc: add links to folder references (#3249)
This PR adds links to some folder references in the docs, making them
easier to navigate.

Please advise if these need to be made to be full URIs rather than
relative paths in order to work correctly with the doc generation
tooling that is in place.
2024-02-05 13:30:48 +00:00
Joachim Breitner
f40c999f68 feat: improve termination_by error messages (#3255)
as suggested in

<https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/termination_by.20regression/near/419786430>

Also refactored the code a bit and removed the code smell around
`GuessLex`-produced termination arguments (which may not be
surface-syntactically expressible) a bit by introducing an explicit flag
for those.
2024-02-05 13:13:53 +00:00
Leonardo de Moura
cf092e7941 refactor: add helper function evalPropStep (#3252) 2024-02-04 21:50:34 +00:00
Scott Morrison
43bbedca46 chore: begin development cycle for v4.7.0 (#3243) 2024-02-01 23:29:32 +00:00
Marcus Rossel
509f35df02 doc: fix typos (#3236) 2024-02-01 19:03:58 +00:00
Sebastian Ullrich
732b266de0 chore: CI: do not fail on broken links (#3238) 2024-02-01 13:40:27 +00:00
Kyle Miller
1d8cf38ff9 feat: pp.numericTypes option for printing number literals with type ascriptions (#2933)
Implements the pretty printer option `pp.numericTypes` for including a
type ascription for numeric literals. For example, `(2 : Nat)`, `(-2 :
Int)`, and `(-2 / 3 : Rat)`. This is useful for debugging how arithmetic
expressions have elaborated or have been otherwise transformed. For
example, with exponentiation is is helpful knowing whether it is `x ^ (2
: Nat)` or `x ^ (2 : Real)`. This is like the Lean 3 option
`pp.numeralTypes` but it has a wider notion of a numeric literal.

Also implements the pretty printer option `pp.natLit` for including the
`nat_lit` prefix for raw natural number literals.

Closes #3021
2024-02-01 17:23:32 +11:00
Leonardo de Moura
a4226a4f6d fix: tolerate missing simp and simproc sets
When we declare a `simp` set using `register_simp_attr`, we
automatically create `simproc` set. However, users may create `simp`
sets programmatically, and the associated `simproc` set may be missing
and vice-versa.
2024-02-01 16:58:54 +11:00
Leonardo de Moura
76224e409b fix: Mathlib regressions reported by Scott 2024-02-01 16:58:54 +11:00
Leonardo de Moura
c3383de6ff feat: add helper method withDischarger 2024-02-01 16:58:54 +11:00
Scott Morrison
e5b1c87606 chore: update stage0 2024-02-01 16:58:54 +11:00
Leonardo de Moura
da072c2ec8 fix: simp cache issue 2024-02-01 16:58:54 +11:00
Leonardo de Moura
d3c71ce2ff refactor: remove unfoldGround and cacheGround workarounds from simp 2024-02-01 16:58:54 +11:00
Scott Morrison
da21ef4fe8 chore: update stage0 2024-02-01 16:58:54 +11:00
Leonardo de Moura
168217b2bd chore: remove TODOs 2024-02-01 16:58:54 +11:00
Leonardo de Moura
8deb1838aa feat: add seval 2024-02-01 16:58:54 +11:00
Leonardo de Moura
3d1b3c6b44 chore: getSimpCongrTheorems to CoreM 2024-02-01 16:58:54 +11:00
Leonardo de Moura
676121c71d chore: style 2024-02-01 16:58:54 +11:00
Leonardo de Moura
6439d93389 chore: remove dead code 2024-02-01 16:58:54 +11:00
Scott Morrison
e4e6601546 chore: update stage0 2024-02-01 16:58:54 +11:00
Leonardo de Moura
01469bdbd6 refactor: remove workaround
We don't need to keep passing `discharge?` method around anymore.
2024-02-01 16:58:54 +11:00
Leonardo de Moura
01750e2139 chore: mark simprocs that are relevant for the symbolic evaluator 2024-02-01 16:58:54 +11:00
Scott Morrison
8037a8733d chore: update stage0 2024-02-01 16:58:54 +11:00
Leonardo de Moura
c4e6e48690 feat: builtin seval simproc attribute 2024-02-01 16:58:54 +11:00
Leonardo de Moura
9cfca51257 chore: register seval simp set 2024-02-01 16:58:54 +11:00
Leonardo de Moura
de886c617d feat: simproc sets
The command `register_simp_attr` now also declares a `simproc` set.
2024-02-01 16:58:54 +11:00
Leonardo de Moura
755b59c2cf chore: update RELEASES.md 2024-02-01 16:58:54 +11:00
Leonardo de Moura
266075b8a4 chore: fix tests 2024-02-01 16:58:54 +11:00
Scott Morrison
8db28ac32f chore: update stage0 2024-02-01 16:58:54 +11:00
Leonardo de Moura
b4a290a203 refactor: simp Step and Simproc types
Before this commit, `Simproc`s were defined as `Expr -> SimpM (Option Step)`, where `Step` is inductively defined as follows:
```
inductive Step where
  | visit : Result → Step
  | done  : Result → Step
```
Here, `Result` is a structure containing the resulting expression and a proof demonstrating its equality to the input. Notably, the proof is optional; in its absence, `simp` assumes reflexivity.

A simproc can:
- Fail by returning `none`, indicating its inapplicability. In this case, the next suitable simproc is attempted, along with other simp extensions.
- Succeed and invoke further simplifications using the `.visit`
constructor. This action returns control to the beginning of the
simplification loop.
- Succeed and indicate that the result should not undergo further
simplifications. However, I find the current approach unsatisfactory, as it does not align with the methodology employed in `Transform.lean`, where we have the type:

```
inductive TransformStep where
  /-- Return expression without visiting any subexpressions. -/
  | done (e : Expr)
  /--
  Visit expression (which should be different from current expression) instead.
  The new expression `e` is passed to `pre` again.
  -/
  | visit (e : Expr)
  /--
  Continue transformation with the given expression (defaults to current expression).
  For `pre`, this means visiting the children of the expression.
  For `post`, this is equivalent to returning `done`. -/
  | continue (e? : Option Expr := none)
```
This type makes it clearer what is going on. The new `Simp.Step` type is similar but use `Result` instead of `Expr` because we need a proof.
2024-02-01 16:58:54 +11:00
Matthew Robert Ballard
03f344a35f feat: use supplied structure fields left to right and eta reduce terms in structure instance elaboration (#2478)
Modifies the structure instance elaborator to
1. Fill in missing fields from sources in strict left-to-right order. In
`{a, b with}`, sometimes the elaborator
would ignore `a` even if both `a` and `b` provided the same field,
depending on what subobject fields they had.
2. Use the sources, or subobjects of the sources, to fill in entire
subobjects of the target structure as much as possible.
Currently, a field cannot be filled directly by a source itself
resulting in the term being eta expanded.
This change avoids this unnecessary and surprisingly costly extra eta
expansion.

Adds two new tests to illustrate the performance benefit (one courtesy
@semorrison). These are currently failing on master and succeed on this
branch.

There is one additional test to exercise the changes to the elaboration
of structure instances.

Changes to make mathlib build are in leanprover-community/mathlib4#9843

Closes #2451
2024-02-01 03:42:39 +00:00
Mac Malone
a48ca7b0a4 feat: lake: improved platform information & control (#3226)
This combines a few platform-related changes:

* Add a ternary `platformIndependent` Lean configuration option to
assert whether Lake should assume Lean code is platform-independent. If
`true`, Lake will exclude platform-independent objects like external
libraries or dynlibs created through `precompileModules` from module
traces. If `false`, Lake will add the platform to module traces. If
`none` (the default), Lake will retain the current behavior (modules are
platform-dependent if and only if it depends on native objects).
* Use `System.Platform.target` from #3207 as the platform descriptor in
Lake for the configuration file trace, the cloud release archive, and as
the platform trace in Lean modules and native artifacts (e.g., object
files, and static and shared libraries).
* Do not add the platform descriptor into custom build archive names
(i.e., a user-set `buildArchive` configuration). This allows users to
create cross-platform / platform-independent archives via a name
override should they so desire.

Closes #2754.
2024-01-31 23:56:33 +00:00
Jon Eugster
1cb1602977 doc: add doc for FileMap (#3221) 2024-01-31 21:51:37 +00:00
Mario Carneiro
c98deeb709 feat: @[unused_variables_ignore_fn] attribute (#3184)
This replaces the no-op `unusedVariablesIgnoreFnsExt` environment
extension with an actual environment extension which can be extended
using either `@[unused_variables_ignore_fn]` or
`@[builtin_unused_variables_ignore_fn]` (although for the present all
the builtin `unused_variables_ignore_fn`s are being added using direct
calls to `builtin_initialize addBuiltinUnusedVariablesIgnoreFn`, because
this also works and a stage0 update is required before the attribute can
be used).

We would like to use this attribute to disable unused variables in
syntaxes defined in std and mathlib, like
[`proof_wanted`](https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Unused.20variables.20and.20proof_wanted/near/408554690).
2024-01-31 19:27:32 +00:00
Marc Huisinga
cd0be38bb4 feat: elidible subterms (#3201)
This PR adds two new delaboration settings: `pp.deepTerms : Bool`
(default: `true`) and `pp.deepTerms.threshold : Nat` (default: `20`).

Setting `pp.deepTerms` to `false` will make the delaborator terminate
early after `pp.deepTerms.threshold` layers of recursion and replace the
omitted subterm with the symbol `⋯` if the subterm is deeper than
`pp.deepTerms.threshold / 4` (i.e. it is not shallow). To display the
omitted subterm in the InfoView, `⋯` can be clicked to open a popup with
the delaborated subterm.

<details>
<summary>InfoView with pp.deepTerms set to false (click to show
image)</summary>


![image](https://github.com/leanprover/lean4/assets/10852073/f6df8b2c-d769-41c8-821e-efd0af23ccfa)
</details>

### Implementation

- The delaborator is adjusted to use the new configuration settings and
terminate early if the threshold is exceeded and the corresponding term
to omit is shallow.
- To be able to distinguish `⋯` from regular terms, a new constructor
`Lean.Elab.Info.ofOmissionInfo` is added to `Lean.Elab.Info` that takes
a value of a new type `Lean.Elab.OmissionInfo`.
- `ofOmissionInfo` is needed in `Lean.Widget.makePopup` for the
`Lean.Widget.InteractiveDiagnostics.infoToInteractive` RPC procedure
that is used to display popups when clicking on terms in the InfoView.
It ensures that the expansion of an omitted subterm is delaborated using
`explicit := false`, which is typically set to `true` in popups for
regular terms.
- Several `Info` widget utility functions are adjusted to support
`ofOmissionInfo`.
- The list delaborator is adjusted with special support for `⋯` so that
long lists `[x₁, ..., xₖ, ..., xₙ]` are shortened to `[x₁, ..., xₖ, ⋯]`.
2024-01-31 17:28:29 +00:00
Lean stage0 autoupdater
578a2308b1 chore: update stage0 2024-01-31 15:48:29 +00:00
Joachim Breitner
279607f5f8 refactor: forallAltTelescope to take altNumParams (#3230)
this way this function does not have to peek at the `altType` to see
when there are no more arguments, which makes it a bit more explicit,
and also a bit more robust should one apply this function to the type of
an alternative with the motive already instantiated.

It seems this uncovered a variable shadow bug, where the counter `i` was
accidentially reset after removing the `i`’th entry in `ys`.
2024-01-31 11:03:03 +00:00
Sebastian Ullrich
456e435fe0 chore: remove unused GH Pages deployment (#3217) 2024-01-31 10:39:15 +00:00
Kyle Miller
31981090e4 feat: make intro be aware of let_fun (#3115)
Adds support for `let_fun` to the `intro` and `intros` tactics. Also
adds support to `intro` for anonymous binder names, since the default
variable name for a `letFun` with an eta reduced body is anonymous.
2024-01-31 08:55:52 +00:00
David Thrane Christiansen
dd77dbdc11 chore: add GitHub token to manual link checker (#3235)
Hopefully this will avoid [429 errors from
GitHub](da4c46370d)
2024-01-31 06:44:00 +00:00
Kyle Miller
fcb30c269b doc: expand docstring for intros (#2777)
The docstring for `intros` did not explain the difference between the
zero-argument and the one-or-more-argument cases.
2024-01-30 22:59:02 +00:00
Sebastian Ullrich
5f59d7f7b4 fix: do not throw C++ heartbeat exceptions in pure functions (#3224) 2024-01-29 20:27:27 +00:00
Marc Huisinga
1364157e91 doc: adjust RELEASES.md call hierarchy url (#3220)
This links a better description of what the call hierarchy does.
2024-01-26 15:54:18 +00:00
David Thrane Christiansen
a524fd4be8 doc: update link target (#3218)
This fixes a link target found by the link checker CI for lean-lang.org
2024-01-26 10:20:22 +00:00
Joachim Breitner
de23226d0c refactor: fuse nested mkCongrArg calls (#3203)
Encouraged by the performance gains from making `rewrite` produce
smaller proof objects
(#3121) I am here looking for low-hanging fruit in `simp`.

Consider this typical example:

```
set_option pp.explicit true

theorem test
  (a : Nat)
  (b : Nat)
  (c : Nat)
  (heq : a = b)
  (h : (c.add (c.add ((c.add b).add c))).add c = c)
  : (c.add (c.add ((c.add a).add c))).add c = c
```
We get a rather nice proof term when using
```
  := by rw [heq]; assumption
```
namely
```
theorem test : ∀ (a b c : Nat),
  @Eq Nat a b →
    @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) c →
      @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c) c :=
fun a b c heq h =>
  @Eq.mpr (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c) c)
    (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) c)
    (@congrArg Nat Prop a b (fun _a => @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c _a) c))) c) c) heq) h
```
(this is with #3121).

But with `by simp only [heq]; assumption`, it looks rather different:

```
theorem test : ∀ (a b c : Nat),
  @Eq Nat a b →
    @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) c →
      @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c) c :=
fun a b c heq h =>
  @Eq.mpr (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c) c)
    (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) c)
    (@id
      (@Eq Prop (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c) c)
        (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) c))
      (@congrFun Nat (fun a => Prop) (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c))
        (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c))
        (@congrArg Nat (Nat → Prop) (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c)
          (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) (@Eq Nat)
          (@congrFun Nat (fun a => Nat) (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))))
            (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))))
            (@congrArg Nat (Nat → Nat) (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c)))
              (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) Nat.add
              (@congrArg Nat Nat (Nat.add c (Nat.add (Nat.add c a) c)) (Nat.add c (Nat.add (Nat.add c b) c)) (Nat.add c)
                (@congrArg Nat Nat (Nat.add (Nat.add c a) c) (Nat.add (Nat.add c b) c) (Nat.add c)
                  (@congrFun Nat (fun a => Nat) (Nat.add (Nat.add c a)) (Nat.add (Nat.add c b))
                    (@congrArg Nat (Nat → Nat) (Nat.add c a) (Nat.add c b) Nat.add
                      (@congrArg Nat Nat a b (Nat.add c) heq))
                    c))))
            c))
        c))
    h
```
Since simp uses only single-step `congrArg`/`congrFun` congruence lemmas
here, the proof
term grows very large, likely quadratic in this case.

Can we do better? Every nesting of `congrArg` (and it's little brother
`congrFun`) can be
turned into a single `congrArg` call. 

In this PR I make making the smart app builders `Meta.mkCongrArg` and
`Meta.mkCongrFun` a bit
smarter and not only fuse with `Eq.refl`, but also with
`congrArg`/`congrFun`.

Now we get, in this simple example,
```
theorem test : ∀ (a b c : Nat),
  @Eq Nat a b →
    @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) c →
      @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c) c :=
fun a b c heq h =>
  @Eq.mpr (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c a) c))) c) c)
    (@Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c b) c))) c) c)
    (@congrArg Nat Prop a b (fun x => @Eq Nat (Nat.add (Nat.add c (Nat.add c (Nat.add (Nat.add c x) c))) c) c) heq) h
```

Let’s see if it works and how much we gain.
2024-01-25 17:48:27 +00:00
Joachim Breitner
550fa6994e feat: induction using <term> (#3188)
right now, the `induction` tactic accepts a custom eliminator using the
`using <ident>` syntax, but is restricted to identifiers. This
limitation becomes annoying when the elminator has explicit parameters
that are not targets, and the user (naturally) wants to be able to write
```
induction a, b, c using foo (x := …)
```

This generalizes the syntax to expressions and changes the code
accordingly.

This can be used to instantiate a multi-motive induction:
```
example (a : A) : True := by
  induction a using A.rec (motive_2 := fun b => True)
  case mkA b IH => exact trivial
  case A => exact trivial
  case mkB b IH => exact trivial
```

For this to work the term elaborator learned the `heedElabAsElim` flag,
`true` by default. But in the default setting, `A.rec (motive_2 := fun b
=> True)`
would fail to elaborate, because there is no expected type. So the
induction
tactic will elaborate in a mode where that attribute is simply ignored.

As a side effect, the “failed to infer implicit target” error message 
is improved and prints the name of the implicit target that could not be
instantiated.
2024-01-25 16:57:41 +00:00
Marc Huisinga
f9e5f1f1fd feat: add call hierarchy support (#3082)
This PR adds support for the "call hierarchy" feature of LSP that allows
quickly navigating both inbound and outbound call sites of functions. In
this PR, "call" is taken to mean "usage", so inbound and outbound
references of all kinds of identifiers (e.g. functions or types) can be
navigated. To implement the call hierarchy feature, this PR implements
the LSP requests `textDocument/prepareCallHierarchy`,
`callHierarchy/incomingCalls` and `callHierarchy/outgoingCalls`.

<details>
  <summary>Showing the call hierarchy (click to show image)</summary>
  

![show_call_hierarchy](https://github.com/leanprover/lean4/assets/10852073/add13943-013c-4d0a-a2d4-a7c57ad2ae26)
  
</details>

<details>
  <summary>Incoming calls (click to show image)</summary>
  

![incoming_calls](https://github.com/leanprover/lean4/assets/10852073/9a803cb4-6690-42b4-9c5c-f301f76367a7)
  
</details>

<details>
  <summary>Outgoing calls (click to show image)</summary>
  

![outgoing_calls](https://github.com/leanprover/lean4/assets/10852073/a7c4f193-51ab-4365-9473-0309319b1cfe)
  
</details>

It is based on #3159, which should be merged before this PR.

To route the parent declaration name through to the language server, the
`.ilean` format is adjusted, breaking backwards compatibility with
version 1 of the ILean format and yielding version 2.

This PR also makes the following more minor adjustments:
- `Lean.Server.findModuleRefs` now also combines the identifiers of
constants and FVars and prefers constant over FVars for the combined
identifier. This is necessary because e.g. declarations declared using
`where` yield both a constant (for usage outside of the function) and an
FVar (for usage inside of the function) with the same range, whereas we
would typically like all references to refer to the former. This also
fixes a bug introduced in #2462 where renaming a declaration declared
using `where` would not rename usages outside of the function, as well
as a bug in the unused variable linter where `where` declarations would
be reported as unused even if they were being used outside of the
function.
- The function converting `Lean.Server.RefInfo` to `Lean.Lsp.RefInfo`
now also computes the `Lean.DeclarationRanges` for parent declaration
names via `MetaM` and must hence be in `IO` now.
- Add a utility function `Array.groupByKey` to `HashMap.lean`.
- Stylistic refactoring of `Watchdog.lean` and `LanguageFeatures.lean`.
2024-01-25 14:43:23 +00:00
Sebastian Ullrich
6b0e7e1f46 feat: synchronous execution of task continuations (#3013)
In the new snapshot design, we have a tree of `Task`s that represents
the asynchronously processed document structure. When transforming this
tree in response to a user edit, we want to quickly run through
reusable, already computed nodes of the tree synchronously and then
spawn new tasks for the new parts. The new flag allows us to do such
mixed sync/async tree transformations uniformly. This flag exists as
e.g.
[`ExecuteSynchronously`](https://learn.microsoft.com/en-us/dotnet/api/system.threading.tasks.taskcontinuationoptions?view=net-8.0)
in other runtimes.
2024-01-25 13:54:20 +00:00
Sebastian Ullrich
9fb44fae29 doc: remove nightly and other outdated references (#3027) 2024-01-25 13:53:36 +00:00
David Thrane Christiansen
1f4359cc80 fix: broken internal links in the docs (#3216)
I deleted internal links that seemed to have the character of "TODO". I
think that the residual TODO is of little value, given that we plan a
big revamp and revision soon anyway, but I could do it some other way as
well.
2024-01-25 09:56:20 +00:00
Joe Hendrix
8293fd4e09 feat: cleanups to ACI and Identity classes (#3195)
This makes changes to the definitions of Associativity, Commutativity,
Idempotence and Identity classes to be more aligned with Mathlib's
versions.

The changes are:
*  Move classes are moved from `Lean` to root namespace.
* Drop `Is` prefix from names.
* Rename `IsNeutral` to `LawfulIdentity` and add Left and Right
subclasses.
* Change neutral/identity element to outParam.
* Introduce `HasIdentity` for operations not intended for proofs to
implement

The identity changes are to make this compatible with
[Mathlib](718042db9d/Mathlib/Init/Algebra/Classes.lean)
and to enable nicer fold operations in Std that can use type classes to
infer the identity/initial element on binary operations.

---------

Co-authored-by: Kyle Miller <kmill31415@gmail.com>
2024-01-24 21:46:58 +00:00
Sebastian Ullrich
2beb948a3b feat: System.Platform.target (#3207)
Makes the LLVM triple of the current platform available to Lean code
towards a solution for #2754.

Defaults to the empty string if the compiler is not clang, which can
introduce some divergence between CI and local builds but should not be
noticeable in most cases and is not really possible to avoid.
2024-01-24 12:11:00 +00:00
Joachim Breitner
409c6cac4c fix: predefinition preprocessing: float .mdata out of non-unary applications (#3204)
Recursive predefinitions contains “rec app” markers as mdata in the
predefinitions,
but sometimes these get in the way of termination checking, when you
have
```
  [mdata (fun x => f)] arg
```

Therefore, the `preprocess` pass floats them out of applications
(originally
only for structural recursion, since #2818 also for well-founded
recursion).

But the code was incomplete: Because `Meta.transform` calls `post` on `f
x y` only
once (and not also on `f x`) one has to float out of nested applications
as well.

A consequence of this can be that in a recursive proof, `rw [foo]` does
not work
although `rw [foo _ _]` does.

Also adding the testcase where @david-christiansen and I stumbled over
this


(Maybe the two preprocess modules can be combined, now that #2973 is
landed, will try that
in a follow-up).
2024-01-24 08:37:16 +00:00
Eric Wieser
ec39de8cae fix: allow generalization in let (#3060)
As suggested by @kmill, removing an unnecessary `let` (possibly only
there in the first place for copy/paste reasons) seems to fix the
included test.

This makes `~q()` matching in quote4 noticeably more useful in things
like `norm_num` (as it fixes
https://github.com/leanprover-community/quote4/issues/29)

It also makes a quote4 bug slightly more visible
(https://github.com/leanprover-community/quote4/issues/30), but the bug
there already existed anyway, and isn't caused by this patch.

Fixes #3065
2024-01-23 09:02:05 +00:00
Kyle Miller
586c3f9140 feat: make mkApp, mkApp2, ..., mkApp10 have @[match_pattern] attribute (#2900)
Give n-ary `Expr.app` constructors such as `mkApp2`, `mkApp3`, ...,
`mkApp10` the `@[match_pattern]` attribute so that it is easier to read
and write pattern matching for applications.
2024-01-23 08:56:15 +00:00
David Renshaw
feda615ed5 doc: add missing 'not' in simprocs example in RELEASES.md (#3206) 2024-01-22 16:14:18 +00:00
Marc Huisinga
4f41ccfcbf doc: update RELEASES.md for #3159 (#3205) 2024-01-22 13:47:25 +00:00
Marc Huisinga
e9f69d1068 feat: partial context info (#3159)
This PR facilitates augmenting the context of an `InfoTree` with
*partial* contexts while elaborating a command. Using partial contexts,
this PR also adds support for tracking the parent declaration name of a
term in the `InfoTree`. The parent declaration name is needed to compute
the call hierarchy in #3082.

Specifically, the `Lean.Elab.InfoTree.context` constructor is refactored
to take a value of the new type `Lean.Elab.PartialContextInfo` instead
of a `Lean.Elab.ContextInfo`, which now refers to a full `InfoTree`
context. The `PartialContextInfo` is then merged into a `ContextInfo`
while traversing the tree using
`Lean.Elab.PartialContextInfo.mergeIntoOuter?`. The partial context
after executing `liftTermElabM` is stored in values of a new type
`Lean.Elab.CommandContextInfo`.

As a result of this, `Lean.Elab.ContextInfo.save` moves to
`Lean.Elab.CommandContextInfo.save`.

For obtaining the parent declaration for a term, a new typeclass
`MonadParentDecl` is introduced to save the parent declaration in
`Lean.Elab.withSaveParentDeclInfoContext`. `Lean.Elab.Term.withDeclName
x` now calls `withSaveParentDeclInfoContext x` to save the declaration
name.

### Migration

**The changes to the `InfoTree.context` constructor break backwards
compatibility with all downstream users that traverse the `InfoTree`
manually instead of going through the functions in `InfoUtils.lean`.**
To fix this, you can merge the outer `ContextInfo` in a traversal with
the `PartialContextInfo` of an `InfoTree.context` node using
`PartialContextInfo.mergeIntoOuter?`. See e.g.
`Lean.Elab.InfoTree.foldInfo` for an example:
```lean
partial def InfoTree.foldInfo (f : ContextInfo → Info → α → α) (init : α) : InfoTree → α :=
  go none init
where go ctx? a
  | context ctx t => go (ctx.mergeIntoOuter? ctx?) a t
  | node i ts =>
    let a := match ctx? with
      | none => a
      | some ctx => f ctx i a
    ts.foldl (init := a) (go <| i.updateContext? ctx?)
  | _ => a
```

Downstream users that manually save `InfoTree`s may need to adjust calls
to `ContextInfo.save` to use `CommandContextInfo.save` instead and
potentially wrap their `CommandContextInfo` in a
`PartialContextInfo.commandCtx` constructor when storing it in an
`InfoTree` or `ContextInfo.mk` when creating a full context.

### Motivation

As of now, `ContextInfo`s are always *full* contexts, constructed as if
they were always created in `liftTermElabM` after running the
`TermElabM` action. This is not strictly true; we already create
`ContextInfo`s in several places other than `liftTermElabM` and work
around the limitation that `ContextInfo`s are always full contexts in
certain places (e.g. `Info.updateContext?` is a crux that we need
because we can't always create partial contexts at the term-level), but
it has mostly worked out so far. Note that one must be very careful when
saving a `ContextInfo` in places other than `liftTermElabM` because the
context may not be as complete as we would like (e.g. it may lack
meta-variable assignments, potentially leading to a language server
panic).

Unfortunately, the parent declaration of a term is another example of a
context that cannot be provided in `liftTermElabM`: The parent
declaration is usually set via `withDeclName`, which itself lives in
`TermElabM`. So by the time we are trying to save the full
`ContextInfo`, the declaration name is already gone. There is no easy
fix for this like in the other cases where we would really just like to
augment the context with an extra field.

The refactor that we decided on to resolve the issue is to refactor the
`InfoTree` to take a `PartialContextInfo` instead of a `ContextInfo` and
have code that traverses the `InfoTree` merge inner contexts with outer
contexts to produce a full `ContextInfo` value.

### Bumps for downstream projects

- `lean-pr-testing-3159` branch at Std, not yet opened as a PR
- `lean-pr-testing-3159` branch at Mathlib, not yet opened as a PR
- https://github.com/leanprover/LeanInk/pull/57
- https://github.com/hargoniX/LeanInk/pull/1
- https://github.com/tydeu/lean4-alloy/pull/7
- https://github.com/leanprover-community/repl/pull/29

---------

Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2024-01-22 12:34:20 +00:00
Scott Morrison
5cc9f6f9cb chore: CI creates lean-pr-testing-NNNN branches at Std too (#3200)
Currently we create `lean-pr-testing-NNNN` branches at Mathlib
automatically for each Lean PR.

We don't automatically create one at Std; mostly simply because Std
fails less often, so it has been okay to do this manually as needed. It
is conceptually simpler, however, if this is done uniformly.

This PR:
* does not proceed with Std/Mathlib CI unless the appropriate
`nightly-testing-YYYY-MM-DD` tag exists at Std (like it already doesn't
proceed if that tag is missing at Mathlib)
* creates `lean-pr-testing-NNNN` branches at Std
* when it creates `lean-pr-testing-NNNN` branches at Mathlib, updates
the Std dependency to use the `lean-pr-testing-NNNN` branch at Std

- [x] depends on #3199

Note that because most users do not have write access at Std, in order
to make updates to `lean-pr-testing-NNNN` branches there they will need
to make PRs. These will be merged with a very low bar, and feel free to
ping me for assistance on this. If this is annoying we will automate.
Also, frequent contributors to Lean may ask @digama0 or @joehendrix for
write access in order to easily work on these branches.

This PR requires that we have a secret here with write access at Std.
I'm arranging that [on
zulip](https://leanprover.zulipchat.com/#narrow/stream/348111-std4/topic/bot.20access/near/416686090).

I will update the documentation at
https://leanprover-community.github.io/contribute/tags_and_branches.html
to reflect these changes when they are merged.

---------

Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
2024-01-22 03:06:59 +00:00
Kyle Miller
09aa845940 doc: clarify and expand docstrings for the instantiate functions (#3183)
Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2024-01-22 02:58:29 +00:00
Scott Morrison
73b87f2558 chore: CI looks for nightly-testing-YYYY-MM-DD at Mathlib as either a branch or tag (#3199)
As discussed during the FRO meeting 2024-01-18, we are changing the
`nightly-testing-YYYY-MM-DD` branches at Std and Mathlib from branches
to tags, in:

* https://github.com/leanprover/std4/pull/545
* https://github.com/leanprover-community/mathlib4/pull/9842

This PR updates the script that creates the `lean-pr-testing-NNNN`
branches at Mathlib so it is agnostic about whether
`nightly-testing-YYYY-MM-DD` will be a branch or a tag.

---------

Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
2024-01-20 23:50:03 +00:00
Joachim Breitner
c0f264ffe0 fix: reducing out-of-bounds swap! should return a, not default (#3197)
`Array.set!` and `Array.swap!` are fairly similar operations, both
modify an array, both take an index that it out of bounds.

But they behave different; all of these return `true`
```
#eval #[1,2].set! 2 42 == #[1,2]    -- with panic
#reduce #[1,2].set! 2 42 == #[1,2]  -- no panic

#eval #[1,2].swap! 0 2 == #[1,2]    -- with panic
#reduce #[1,2].swap! 0 2 == default -- no panic
```

The implementations are
```
@[extern "lean_array_set"]
def Array.set! (a : Array α) (i : @& Nat) (v : α) : Array α :=
  Array.setD a i v
```
but
```
@[extern "lean_array_swap"]
def swap! (a : Array α) (i j : @& Nat) : Array α :=
  if h₁ : i < a.size then
  if h₂ : j < a.size then swap a ⟨i, h₁⟩ ⟨j, h₂⟩
  else panic! "index out of bounds"
  else panic! "index out of bounds"
```

It seems to be more consistent to unify the behaviors, and define
```
@[extern "lean_array_swap"]
def swap! (a : Array α) (i j : @& Nat) : Array α :=
  if h₁ : i < a.size then
  if h₂ : j < a.size then swap a ⟨i, h₁⟩ ⟨j, h₂⟩
  else a
  else a
```

Also adds docstrings.

Fixes #3196
2024-01-19 18:29:18 +00:00
Joachim Breitner
52d0f715c3 refactor: rewrite: produce simpler proof terms (#3121)
Consider
```
import Std.Tactic.ShowTerm

opaque a : Nat
opaque b : Nat
axiom a_eq_b : a = b
opaque P : Nat → Prop

set_option pp.explicit true

-- Using rw
example (h : P b) : P a := by show_term rw [a_eq_b]; assumption
```

Before, a typical proof term for `rewrite` looked like this:
```
-- Using the proof term that rw produces
example (h : P b) : P a :=
  @Eq.mpr (P a) (P b)
  (@id (@Eq Prop (P a) (P b))
    (@Eq.ndrec Nat a (fun _a => @Eq Prop (P a) (P _a))
      (@Eq.refl Prop (P a)) b a_eq_b))
  h
```
which is rather round-about, applying `ndrec` to `refl`. It would be
more direct to write
```
example (h : P b) : P a :=
  @Eq.mpr (P a) (P b)
  (@id (@Eq Prop (P a) (P b))
    (@congrArg Nat Prop a b (fun _a => (P _a)) a_eq_b))
  h
```
which this change does.

This makes proof terms smaller, causing mild general speed up throughout
the code; if the brenchmarks don’t lie the highlights are

* olean size -2.034 %
* lint wall-clock -3.401 %
* buildtactic execution s -10.462 %

H'T to @digama0 for advice and help.

NB: One might even expect the even simpler
```
-- Using the proof term that I would have expected
example (h : P b) : P a :=
  @Eq.ndrec Nat b (fun _a => P _a) h a a_eq_b.symm
```
but that would require non-local changes to the source code, so one step
at a time.
2024-01-19 07:20:58 +00:00
Leonardo de Moura
ec30da8af7 feat: new implementation for simp (config := { ground := true }) (#3187) 2024-01-18 17:39:06 +00:00
Joachim Breitner
27b7002138 fix: checkTargets check for duplicate target (#3171)
The `checkTargets` function introduced in 4a0f8bf2 as
```
  checkTargets (targets : Array Expr) : MetaM Unit := do
    let mut foundFVars : FVarIdSet := {}
    for target in targets do
      unless target.isFVar do
        throwError "index in target's type is not a variable (consider using the `cases` tactic instead){indentExpr target}"
      if foundFVars.contains target.fvarId! then
        throwError "target (or one of its indices) occurs more than once{indentExpr target}"
```
looks like it tries to check for duplicate indices, but it doesn’t
actually, as `foundFVars` is never written to.

This adds
```
      foundFVars := foundFVars.insert target.fvarId!
```
and a test case.

Maybe a linter that warns about `let mut` that are never writen to would
be useful?
2024-01-18 09:44:17 +00:00
Arthur Adjedj
a2ed4db562 fix: derive BEq on structure with Prop-fields (#3191)
Closes #3140

---------

Co-authored-by: Joachim Breitner <mail@joachim-breitner.de>
2024-01-18 02:32:51 +00:00
Joachim Breitner
628633d02e test: failed to infer implicit target (#3189)
The `induction` tactic complains if implicit targets cannot be inferred,
let’s test that.
2024-01-17 11:17:34 +00:00
Joachim Breitner
f8edf452de chore: CI: add actionlint action, fix actions (#3156)
I keep messing things up, so time for some guard rails, so check them
using
[actionlint](https://github.com/raven-actions/actionlint).

This also runs [shellcheck](https://www.shellcheck.net/) on the files.
Shellcheck
is a bit picky about putting double quotes around variables, and will
flag many
cases where we know it’s safe, but why not simply always write the safer
variant.

Unfortunately, actionlint does not (yet) check `actions/github-script`
scripts, which is
unfortunate. Maybe they will in the future
(https://github.com/rhysd/actionlint/issues/389)
2024-01-15 17:53:04 +00:00
Marcus Rossel
12dc171c48 doc: fix typos (#3178) 2024-01-14 14:02:51 +00:00
Mario Carneiro
42e6214a42 feat: lake: GNU/BSD OS detection in test scripts (#3180)
fixes #3179
2024-01-14 02:49:38 +00:00
Joachim Breitner
53af5ead53 fix: Fix/GuessLex: refine through more casesOnApp/matcherApp (#3176)
there was a check

if !Structural.recArgHasLooseBVarsAt recFnName fixedPrefixSize e then

that would avoid going through `.refineThrough`/`.addArg` for
matcher/casesOn applications. It seems it tries to detect when refining
the motive/param is pointless, but it was too eager, and cause confusion
with, for example, this reasonably reasonable function:

    def foo : (n : Nat) → (i : Fin n) → Bool
      | 0, _ => false
      | 1, _ => false
      | _+2, _ => foo 1 ⟨0, Nat.zero_lt_one⟩
    decreasing_by simp_wf; simp_arith

In particular, the `GuessLex` code later expects that the (implict)
`PProd.casesOn` in the implementation of `foo._unary` will refine the
paramter, because else the (rather picky) `unpackArg` fails. But it also
prevents this from being provable.

So let's try without this shortcut.

Fixing this also revealed that `withRecApps` wasn’t looking in all
corners
of a matcherApp/casesOnApp.

Fixes #3175
2024-01-13 18:02:41 +00:00
Joachim Breitner
b706c0064e chore: pr-release: more robust comment id recognition (#3173)
this didn’t recognize the new comments with an intro, and thus the bot
would post multiple comments.

The code was also out of sync with mathlib, fixing.

The `first(…)` in the `jq` program makes it more robust in case this
went wrong once (as on #3171) and there are now multiple PRs matching.
2024-01-13 02:48:42 +00:00
Joachim Breitner
8e1b51701b chore: pr-release.yml: parentheses are significant in jq (#3169) 2024-01-12 10:20:53 +00:00
Joe Hendrix
ad068824d0 chore: use termination_by in Nat.gcd (#3164)
This uses the improved termination_by syntax to give Nat.gcd a cleaner
definition. It removes the last explicit use of WellFounded.fix in Init.

This was also partly motivated by leanprover/std4#520 so that unfold
Nat.gcd gives a sensible definition.
2024-01-11 21:31:27 +00:00
Joe Hendrix
7c4c57759d chore: use more specific import in OfScientific (#3165)
This just removes a spurious import of `Init.Data.Nat`. That's the only
non-aggregating import of that file in Init.
2024-01-11 18:23:43 +00:00
Joe Hendrix
1118931516 feat: add bitwise operations to reduceNat? and kernel (#3134)
This adds bitwise operations to reduceNat? and the kernel. It
incorporates some basic test cases to validate the correct operations
are associated.
2024-01-11 18:12:45 +00:00
Mac Malone
7150638836 feat: lake update from unsupported manifest versions (#3149)
If the current manifest is from unsupported (or has errors), a bare
`lake update` will now discard it and create a new one from scratch
rather than erroring and requiring you to manually delete the manifest.
Lake will produce warnings noting it is ignoring such invalid manifests.
2024-01-11 00:30:56 +00:00
Joachim Breitner
30693a2dae doc: mention termination_by and decreasing_by (#3016)
so far, our reference manual did not mention these at all, this takes
the discussion of recursive definition out of the “equation compiler”
section, put it into its own section, and expands it a bit.

This is more a MVP doc change to at least mention the features briefly,
and not the most polished and thought through didactic exposition. But
it provides a start for more improvements.

---------

Co-authored-by: Arthur Adjedj <arthur.adjedj@gmail.com>
Co-authored-by: Scott Morrison <scott.morrison@gmail.com>
Co-authored-by: David Thrane Christiansen <david@davidchristiansen.dk>
2024-01-10 16:35:19 +00:00
Joachim Breitner
368ead54b2 refactor: termination_by changes in stdlib 2024-01-10 17:27:35 +01:00
Joachim Breitner
7c10415cd8 chore: update stage0 2024-01-10 17:27:35 +01:00
Joachim Breitner
b5122b6a7b feat: per-function termination hints
This change

 * moves `termination_by` and `decreasing_by` next to the function they
   apply to
 * simplify the syntax of `termination_by`
 * apply the `decreasing_by` goal to all goals at once, for better
   interactive use.

See the section in `RELEASES.md` for more details and migration advise.

This is a hard breaking change, requiring developers to touch every
`termination_by` in their code base. We decided to still do it as a
hard-breaking change, because supporting both old and new syntax at the
same time would be non-trivial, and not save that much. Moreover, this
requires changes to some metaprograms that developers might have
written, and supporting both syntaxes at the same time would make
_their_ migration harder.
2024-01-10 17:27:35 +01:00
Sebastian Ullrich
8bc1a9c4ba chore: actually include full build in benchmark (#3158)
I must have reverted too much while testing #3104
2024-01-10 14:33:27 +00:00
Eric Wieser
4169cac51f fix: do not strip dotted components from lean module names (#2994)
This introduces `FilePath.addExtension` to take a path that we know has
no prior extension, and append a new extension to it.
As this function is simpler than `FilePath.withExtension`, this change
eagerly replaces uses of the latter with the former, except in a few
cases where stripping the extension really is the right thing to do.

This should fix the bug described at
https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Import.20file.20with.20multiple.20dots.20in.20file.20name/near/404508048,
where `import «A.B».«C.D.lean»` is needed to import `A.B/C.D.lean`.

Closes #2999

---------

Co-authored-by: Mac Malone <tydeu@hatpress.net>
Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2024-01-10 14:24:26 +00:00
Kyle Miller
c394a834c3 feat: extract delabAppCore, define withOverApp, and make over-applied projections pretty print (#3083)
To handle delaborating notations that are functions that can be applied
to arguments, extracts the core function application delaborator as a
separate function that accepts the number of arguments to process and a
delaborator to apply to the "head" of the expression.

Defines `withOverApp`, which has the same interface as the combinator of
the same name from std4, but it uses this core function application
delaborator.

Uses `withOverApp` to improve a number of application delaborators,
notably projections. This means Mathlib can stop using `pp_dot` for
structure fields that have function types.

Incidentally fixes `getParamKinds` to specialize default values to use
supplied arguments, which impacts how default arguments are delaborated.

---------

Co-authored-by: Sebastian Ullrich <sebasti@nullri.ch>
2024-01-10 13:24:28 +00:00
Geoffrey Irving
9069c538ad doc: state that Float is IEEE compliant (#3157)
Github discussion:
https://github.com/leanprover/lean4/pull/3147#discussion_r1446735973
2024-01-10 12:16:42 +00:00
Scott Morrison
4e16eb0476 chore: fix typo from #3148 in pr-release bot (#3154) 2024-01-10 03:14:43 +00:00
Leonardo de Moura
e924ef229c doc: add simproc release notes 2024-01-09 12:57:15 +01:00
Scott Morrison
8012eedab5 test: timeout in Mathlib.Computability.PartrecCode 2024-01-09 12:57:15 +01:00
Leonardo de Moura
33c53a2418 fix: panic at ite and dite simprocs 2024-01-09 12:57:15 +01:00
Scott Morrison
3b9b13b706 test: test for panic in simprocs 2024-01-09 12:57:15 +01:00
Leonardo de Moura
94d51b2321 chore: cleanup builtin simprocs using OptionT 2024-01-09 12:57:15 +01:00
Leonardo de Moura
0342d62109 chroe: fix tests 2024-01-09 12:57:15 +01:00
Leonardo de Moura
4e5ce6b65d chore: update stage0 2024-01-09 12:57:15 +01:00
Leonardo de Moura
e11b320cd6 chore: use mathlib naming convention 2024-01-09 12:57:15 +01:00
Leonardo de Moura
cb6bfefc7a chore: better method names 2024-01-09 12:57:15 +01:00
Leonardo de Moura
25ea5f6fa1 chore: add default parameter value for (simprocs : Simprocs) 2024-01-09 12:57:15 +01:00
Leonardo de Moura
4958404f37 chore: add another simproc test 2024-01-09 12:57:15 +01:00
Leonardo de Moura
3e11b5fe15 fix: trace used builtin simprocs even if they are not in the environment 2024-01-09 12:57:15 +01:00
Leonardo de Moura
57bc058209 chore: fix tests 2024-01-09 12:57:15 +01:00
Leonardo de Moura
610fa69f15 chore: update stage0 2024-01-09 12:57:15 +01:00
Leonardo de Moura
3a9b594fc5 chore: remove staging workaround 2024-01-09 12:57:15 +01:00
Leonardo de Moura
0bc8fe48e3 chore: update stage0 2024-01-09 12:57:15 +01:00
Leonardo de Moura
7350d0a3ff chore: remove staging workaround 2024-01-09 12:57:15 +01:00
Leonardo de Moura
b376b1594e test: builtin simproc option that is not in the environment 2024-01-09 12:57:15 +01:00
Leonardo de Moura
88801166b6 chore: update stage0 2024-01-09 12:57:15 +01:00
Leonardo de Moura
ad58deeae3 fix: allow builtin simprocs to be provided to simp even if they are not in the environment
Motivation: `simp?`
2024-01-09 12:57:15 +01:00
Leonardo de Moura
666d454b42 test: Int simprocs 2024-01-09 12:57:15 +01:00
Leonardo de Moura
b7efd200f0 chore: typo 2024-01-09 12:57:15 +01:00
Leonardo de Moura
e83e467667 feat: add simprocs for Int 2024-01-09 12:57:15 +01:00
Leonardo de Moura
2efa9de78a feat: add simprocs for UInt 2024-01-09 12:57:15 +01:00
Leonardo de Moura
25baf73005 feat: replace ite and dite shortcircuit theorems with simproc
Motivation: better `simp` cache behavior. Recall that `simp` cache
uses `dischargeDepth`.
2024-01-09 12:57:15 +01:00
Leonardo de Moura
0bd424b5e6 feat: add simprocs for Fin 2024-01-09 12:57:15 +01:00
Leonardo de Moura
d841ef5eb5 chore: update stage0 2024-01-09 12:57:15 +01:00
Leonardo de Moura
188ff2dd20 chore: remove bogus registerSimproc 2024-01-09 12:57:15 +01:00
Leonardo de Moura
7564b204ec feat: add basic simprocs for Nat 2024-01-09 12:57:15 +01:00
Leonardo de Moura
6fd7350c7b chore: update stage0 2024-01-09 12:57:15 +01:00
Leonardo de Moura
7ed4d1c432 feat: add builtin simproc support 2024-01-09 12:57:15 +01:00
Leonardo de Moura
5f847c4ce3 chore: missing copyright 2024-01-09 12:57:15 +01:00
Leonardo de Moura
090d158fb9 feat: add simp option - <simproc-name>
We can now disable `simproc`s using the same notation we use to
disable rewriting rules in the simplifier.
2024-01-09 12:57:15 +01:00
Leonardo de Moura
81ced3bd0f feat: trace simprocs 2024-01-09 12:57:15 +01:00
Leonardo de Moura
ab721c64b3 feat: add option simprocs
It is true by default. Packages can set it to false to disable
simplification procedue support for backward compatibility.
2024-01-09 12:57:15 +01:00
Leonardo de Moura
93369e8773 chore: fix test 2024-01-09 12:57:15 +01:00
Leonardo de Moura
23f2314da7 chore: update stage0
`Origin.decl` constructor has an extra field.
2024-01-09 12:57:15 +01:00
Leonardo de Moura
8a23c294a4 fix: simp.trace missing pre annotation 2024-01-09 12:57:15 +01:00
Leonardo de Moura
a7a3ae13dd feat: allow extra simprocs to be provided as simp arguments 2024-01-09 12:57:15 +01:00
Leonardo de Moura
5edd59806c feat: simp only should not use default simproc set 2024-01-09 12:57:15 +01:00
Leonardo de Moura
a2aadee28f feat: simproc declaration vs simproc attribute
Allow `simproc`s to be declared without setting the `[simproc]`
attribute. A `simproc` declaration is function + pattern.

Motivation: allow them to be provided as arguments to `simp` **and** `simp only`.

TODO: track their use in `simp`.
TODO: builtin simprocs
2024-01-09 12:57:15 +01:00
Leonardo de Moura
923216f9a9 feat: add simprocs
TODO:
- `builtin_simproc` attribute
- more tests
2024-01-09 12:57:15 +01:00
Leonardo de Moura
0f9702f4b4 chore: address feedback 2024-01-09 12:57:15 +01:00
Leonardo de Moura
df53e6c4cf refactor: simplify simpImpl 2024-01-09 12:57:15 +01:00
Leonardo de Moura
916c97b625 refactor: simplify match-expressions at pre simp method 2024-01-09 12:57:15 +01:00
Leonardo de Moura
439689b219 chore: simplify mutual at simpImpl 2024-01-09 12:57:15 +01:00
Leonardo de Moura
1d78712b6c refactor: use unsafe code to break recursion in simp implementation
Motivations:
- We can simplify the big mutual recursion and the implementation.
- We can implement the support for `match`-expressions in the `pre` method.
- It is easier to define and simplify `Simprocs`.
2024-01-09 12:57:15 +01:00
Leonardo de Moura
39f716f902 chore: fix regression due to changes in previous commits
The example was looping with the new `simp` reduction strategy. Here
is the looping trace.
```
List.reverseAux (List.reverseAux as []) bs
==> rewrite using reverseAux_reverseAux
List.reverseAux [] (List.reverseAux (List.reverseAux as []) bs)
==> unfold reverseAux
List.reverseAux (List.reverseAux as []) bs
==> rewrite using reverseAux_reverseAux
List.reverseAux [] (List.reverseAux (List.reverseAux as []) bs)
==> ...
```
2024-01-09 12:57:15 +01:00
Leonardo de Moura
22c8154811 feat: add pre simp lemmas for if-then-else terms
See new test for example that takes exponential time without new simp
theorems.
TODO: replace auxiliary theorems with simprocs as soon as we implement them.
2024-01-09 12:57:15 +01:00
Leonardo de Moura
05e9983e25 feat: better support for match-application in the simplifier
The new test exposes a performance problem found in software
verification applications.
2024-01-09 12:57:15 +01:00
Leonardo de Moura
f51b356002 feat: add Expr.getAppArgsN 2024-01-09 12:57:15 +01:00
Leonardo de Moura
ec9570fdd0 feat: add Expr.getAppPrefix 2024-01-09 12:57:15 +01:00
Leonardo de Moura
b37fdea5bf feat: add reduceStep, and try pre simp steps again if term was reduced 2024-01-09 12:57:15 +01:00
Leonardo de Moura
29c245ceba perf: (try to) fix regression introduced by #3139 2024-01-09 12:57:15 +01:00
Joachim Breitner
b8b49c50b9 refactor: WF.Eqns: remove unreachable fix-folding (#3133)
I was about to to address the TODO

/- TODO: check arity of the given function. If it takes a PSigma as the
last argument,
        this function will produce incorrect results. -/

because we now have an arity-observing variant of `decodePackedArg?` in
`unpackArg` in `PackMutual`, and it would be prudent to use it here.

But I first wanted to create a test case that would actually exhibit
this corner case, and failed.

This code was added in 096e4eb6d0 and it had a test case, but not even
that test case seems to be actually using the `decodePackedArg?`
function, neither back then nor now.

Also, mathlib works without this code.

So this seems to be dead code, possibly due to other changes to the
system, and thus can be removed. A strategically place comments points
back to this PR in case we need to resurrect that code.
2024-01-09 08:17:36 +00:00
Geoffrey Irving
127b309a0d doc: Document that Float corresponds to 64-bit double in C (#3147)
Closes #3142.

---------

Co-authored-by: Scott Morrison <scott@tqft.net>
2024-01-09 08:07:38 +00:00
Arthur Adjedj
b7c3ff6e6d fix: manage all declarations in a given derive (#3058)
Closes #3057
2024-01-09 07:42:06 +00:00
Joachim Breitner
0aa2b83450 chore: pr-release.yml: Suggest nightly-with-mathlib (#3148)
and suggest rebasing instead of waiting, for a more actionable
suggestion.
2024-01-09 03:11:18 +00:00
Joachim Breitner
684f32fabe feat: let get_elem_tactic_trivial handle [a]'h.2 (#3132)
The pattern
```
    for h : i in [:xs.size] do
      let x := xs[i]'h.2
```
is occassionally useful to iterate over an array with the index in
hand. This PR extends the `get_elem_tactic_trivial` so that one can
simply write
```
    for h : i in [:xs.size] do
      let x := xs[i]
```

fixes #3032.
2024-01-08 16:23:09 +00:00
Joachim Breitner
eefcbbb37b chore: pr-release.yaml: indicate information using github status (#3137)
When looking at a PR I sometimes wonder which `nightly` release is this
based on, and is used for the mathlib testing.

Right now, the action uses a label (`toolchain-available`) for this, but
a label cannot easily carry more information.

It seems a rather simple way to communicate extra information is by
setting [commit
statuses](https://docs.github.com/en/rest/commits/statuses?apiVersion=2022-11-28#create-a-commit-status);
with this change the following statuses will appear in the PR:


![statusses](https://github.com/leanprover/lean4/assets/148037/e32a24da-065e-406a-adb3-8dca8c0f157f)

One could also use
[checks](https://docs.github.com/en/rest/checks/runs?apiVersion=2022-11-28#create-a-check-run)
to add more information, even with a nicely formatted markdown
description as in [this
example](https://github.com/nomeata/lean4/pull/1/checks?check_run_id=20165137082),
but it seems there you can’t set a summary that’s visible without an
extra click, and Github seems to associate these checks to “the first
workflow”, which is odd. So using statuses seems fine here.

Often one uses bots writing PR comments for this purpose, but that's a
bit noisy (extra notifications etc.), especially for stuff that happens
on every PR, but isn’t always interesting/actionable

If this works well, we can use this for more pieces of information, and
a link can be added as well.
2024-01-08 06:44:01 +00:00
790 changed files with 17580 additions and 3585 deletions

22
.github/workflows/actionlint.yml vendored Normal file
View File

@@ -0,0 +1,22 @@
name: Actionlint
on:
push:
branches:
- 'master'
paths:
- '.github/**'
pull_request:
paths:
- '.github/**'
merge_group:
jobs:
actionlint:
runs-on: ubuntu-latest
steps:
- name: Checkout
uses: actions/checkout@v3
- name: actionlint
uses: raven-actions/actionlint@v1
with:
pyflakes: false # we do not use python scripts

View File

@@ -46,7 +46,7 @@ jobs:
github.event_name == 'pull_request' && !contains( github.event.pull_request.labels.*.name, 'full-ci')
}}
run: |
echo "quick=${{env.quick}}" >> $GITHUB_OUTPUT
echo "quick=${{env.quick}}" >> "$GITHUB_OUTPUT"
- name: Configure build matrix
id: set-matrix
@@ -124,10 +124,11 @@ jobs:
"release": true,
"quick": false,
"cross": true,
"cross_target": "aarch64-apple-darwin",
"shell": "bash -euxo pipefail {0}",
"CMAKE_OPTIONS": "-DUSE_GMP=OFF -DLEAN_INSTALL_SUFFIX=-darwin_aarch64",
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-apple-darwin.tar.zst https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-apple-darwin.tar.zst",
"prepare-llvm": "EXTRA_FLAGS=--target=aarch64-apple-darwin ../script/prepare-llvm-macos.sh lean-llvm-aarch64-* lean-llvm-x86_64-*",
"prepare-llvm": "../script/prepare-llvm-macos.sh lean-llvm-aarch64-* lean-llvm-x86_64-*",
"binary-check": "otool -L",
"tar": "gtar" // https://github.com/actions/runner-images/issues/2619
},
@@ -151,9 +152,10 @@ jobs:
"release": true,
"quick": false,
"cross": true,
"cross_target": "aarch64-unknown-linux-gnu",
"shell": "nix-shell --arg pkgsDist \"import (fetchTarball \\\"channel:nixos-19.03\\\") {{ localSystem.config = \\\"aarch64-unknown-linux-gnu\\\"; }}\" --run \"bash -euxo pipefail {0}\"",
"llvm-url": "https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-x86_64-linux-gnu.tar.zst https://github.com/leanprover/lean-llvm/releases/download/15.0.1/lean-llvm-aarch64-linux-gnu.tar.zst",
"prepare-llvm": "EXTRA_FLAGS=--target=aarch64-unknown-linux-gnu ../script/prepare-llvm-linux.sh lean-llvm-aarch64-* lean-llvm-x86_64-*"
"prepare-llvm": "../script/prepare-llvm-linux.sh lean-llvm-aarch64-* lean-llvm-x86_64-*"
},
{
"name": "Linux 32bit",
@@ -201,8 +203,8 @@ jobs:
git fetch nightly --tags
LEAN_VERSION_STRING="nightly-$(date -u +%F)"
# do nothing if commit already has a different tag
if [[ $(git name-rev --name-only --tags --no-undefined HEAD 2> /dev/null || echo $LEAN_VERSION_STRING) == $LEAN_VERSION_STRING ]]; then
echo "nightly=$LEAN_VERSION_STRING" >> $GITHUB_OUTPUT
if [[ "$(git name-rev --name-only --tags --no-undefined HEAD 2> /dev/null || echo "$LEAN_VERSION_STRING")" == "$LEAN_VERSION_STRING" ]]; then
echo "nightly=$LEAN_VERSION_STRING" >> "$GITHUB_OUTPUT"
fi
fi
@@ -210,7 +212,7 @@ jobs:
if: startsWith(github.ref, 'refs/tags/') && github.repository == 'leanprover/lean4'
id: set-release
run: |
TAG_NAME=${GITHUB_REF##*/}
TAG_NAME="${GITHUB_REF##*/}"
# From https://github.com/fsaintjacques/semver-tool/blob/master/src/semver
@@ -227,11 +229,13 @@ jobs:
if [[ ${TAG_NAME} =~ ${SEMVER_REGEX} ]]; then
echo "Tag ${TAG_NAME} matches SemVer regex, with groups ${BASH_REMATCH[1]} ${BASH_REMATCH[2]} ${BASH_REMATCH[3]} ${BASH_REMATCH[4]}"
echo "LEAN_VERSION_MAJOR=${BASH_REMATCH[1]}" >> $GITHUB_OUTPUT
echo "LEAN_VERSION_MINOR=${BASH_REMATCH[2]}" >> $GITHUB_OUTPUT
echo "LEAN_VERSION_PATCH=${BASH_REMATCH[3]}" >> $GITHUB_OUTPUT
echo "LEAN_SPECIAL_VERSION_DESC=${BASH_REMATCH[4]##-}" >> $GITHUB_OUTPUT
echo "RELEASE_TAG=$TAG_NAME" >> $GITHUB_OUTPUT
{
echo "LEAN_VERSION_MAJOR=${BASH_REMATCH[1]}"
echo "LEAN_VERSION_MINOR=${BASH_REMATCH[2]}"
echo "LEAN_VERSION_PATCH=${BASH_REMATCH[3]}"
echo "LEAN_SPECIAL_VERSION_DESC=${BASH_REMATCH[4]##-}"
echo "RELEASE_TAG=$TAG_NAME"
} >> "$GITHUB_OUTPUT"
else
echo "Tag ${TAG_NAME} did not match SemVer regex."
fi
@@ -319,9 +323,15 @@ jobs:
mkdir build
cd build
ulimit -c unlimited # coredumps
# arguments passed to `cmake`
# this also enables githash embedding into stage 1 library
OPTIONS=(-DCHECK_OLEAN_VERSION=ON)
OPTIONS+=(-DLEAN_EXTRA_MAKE_OPTS=-DwarningAsError=true)
if [[ -n '${{ matrix.cross_target }}' ]]; then
# used by `prepare-llvm`
export EXTRA_FLAGS=--target=${{ matrix.cross_target }}
OPTIONS+=(-DLEAN_PLATFORM_TARGET=${{ matrix.cross_target }})
fi
if [[ -n '${{ matrix.prepare-llvm }}' ]]; then
wget -q ${{ matrix.llvm-url }}
PREPARE="$(${{ matrix.prepare-llvm }})"
@@ -405,7 +415,7 @@ jobs:
- name: CCache stats
run: ccache -s
- name: Show stacktrace for coredumps
if: ${{ failure() }} && matrix.os == 'ubuntu-latest'
if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
run: |
for c in coredumps/*; do
progbin="$(file $c | sed "s/.*execfn: '\([^']*\)'.*/\1/")"
@@ -413,7 +423,7 @@ jobs:
done
- name: Upload coredumps
uses: actions/upload-artifact@v3
if: ${{ failure() }} && matrix.os == 'ubuntu-latest'
if: ${{ failure() && matrix.os == 'ubuntu-latest' }}
with:
name: coredumps-${{ matrix.name }}
path: |
@@ -480,16 +490,16 @@ jobs:
run: |
git remote add nightly https://foo:'${{ secrets.PUSH_NIGHTLY_TOKEN }}'@github.com/${{ github.repository_owner }}/lean4-nightly.git
git fetch nightly --tags
git tag ${{ needs.configure.outputs.nightly }}
git push nightly ${{ needs.configure.outputs.nightly }}
git tag "${{ needs.configure.outputs.nightly }}"
git push nightly "${{ needs.configure.outputs.nightly }}"
git push -f origin refs/tags/${{ needs.configure.outputs.nightly }}:refs/heads/nightly
last_tag=$(git log HEAD^ --simplify-by-decoration --pretty="format:%d" | grep -o "nightly-[-0-9]*" | head -n 1)
last_tag="$(git log HEAD^ --simplify-by-decoration --pretty="format:%d" | grep -o "nightly-[-0-9]*" | head -n 1)"
echo -e "*Changes since ${last_tag}:*\n\n" > diff.md
git show $last_tag:RELEASES.md > old.md
git show "$last_tag":RELEASES.md > old.md
#./script/diff_changelogs.py old.md doc/changes.md >> diff.md
diff --changed-group-format='%>' --unchanged-group-format='' old.md RELEASES.md >> diff.md || true
echo -e "\n*Full commit log*\n" >> diff.md
git log --oneline $last_tag..HEAD | sed 's/^/* /' >> diff.md
git log --oneline "$last_tag"..HEAD | sed 's/^/* /' >> diff.md
- name: Release Nightly
uses: softprops/action-gh-release@v1
with:

View File

@@ -90,6 +90,14 @@ jobs:
# https://github.com/netlify/cli/issues/1809
cp -r --dereference ./result ./dist
if: matrix.name == 'Nix Linux'
- name: Check manual for broken links
id: lychee
uses: lycheeverse/lychee-action@v1.9.0
with:
fail: false # report errors but do not block CI on temporary failures
# gmplib.org consistently times out from GH actions
# the GitHub token is to avoid rate limiting
args: --base './dist' --no-progress --github-token ${{ secrets.GITHUB_TOKEN }} --exclude 'gmplib.org' './dist/**/*.html'
- name: Push to Cachix
run: |
[ -z "${{ secrets.CACHIX_AUTH_TOKEN }}" ] || cachix push -j4 lean4 ./push-* || true
@@ -97,13 +105,6 @@ jobs:
run: |
rm -rf nix-store-cache || true
nix copy ./push-* --to file://$PWD/nix-store-cache?compression=none
- name: Publish manual to GH Pages
uses: peaceiris/actions-gh-pages@v3
with:
github_token: ${{ secrets.GITHUB_TOKEN }}
publish_dir: ./result
destination_dir: ./doc
if: matrix.name == 'Nix Linux' && github.ref == 'refs/heads/master' && github.event_name == 'push'
- id: deploy-info
name: Compute Deployment Metadata
run: |
@@ -112,6 +113,7 @@ jobs:
echo "message=`git log -1 --pretty=format:"%s"`" >> "$GITHUB_OUTPUT"
- name: Publish manual to Netlify
uses: nwtgck/actions-netlify@v2.0
id: publish-manual
with:
publish-dir: ./dist
production-branch: master

View File

@@ -6,6 +6,10 @@
# Instead we use `workflow_run`, which essentially allows us to escalate privileges
# (but only runs the CI as described in the `master` branch, not in the PR branch).
# The main specification/documentation for this workflow is at
# https://leanprover-community.github.io/contribute/tags_and_branches.html
# Keep that in sync!
name: PR release
on:
@@ -37,7 +41,7 @@ jobs:
name: build-.*
name_is_regexp: true
- name: Push branch and tag
- name: Push tag
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
run: |
git init --bare lean4.git
@@ -69,6 +73,20 @@ jobs:
# The token used here must have `workflow` privileges.
GITHUB_TOKEN: ${{ secrets.PR_RELEASES_TOKEN }}
- name: Report release status
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: actions/github-script@v6
with:
script: |
await github.rest.repos.createCommitStatus({
owner: context.repo.owner,
repo: context.repo.repo,
sha: "${{ steps.workflow-info.outputs.sourceHeadSha }}",
state: "success",
context: "PR toolchain",
description: "${{ github.repository_owner }}/lean4-pr-releases:pr-release-${{ steps.workflow-info.outputs.pullRequestNumber }}",
});
- name: Add label
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
uses: actions/github-script@v7
@@ -89,7 +107,7 @@ jobs:
git -C lean4.git remote add nightly https://github.com/leanprover/lean4-nightly.git
git -C lean4.git fetch nightly '+refs/tags/nightly-*:refs/tags/nightly-*'
git -C lean4.git tag --merged "${{ steps.workflow-info.outputs.sourceHeadSha }}" --list "nightly-*" \
| sort -rV | head -n 1 | sed "s/^nightly-*/MOST_RECENT_NIGHTLY=/" | tee -a $GITHUB_ENV
| sort -rV | head -n 1 | sed "s/^nightly-*/MOST_RECENT_NIGHTLY=/" | tee -a "$GITHUB_ENV"
- name: 'Setup jq'
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
@@ -100,22 +118,32 @@ jobs:
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' }}
id: ready
run: |
echo "Most recent nightly in your branch: $MOST_RECENT_NIGHTLY"
echo "Most recent nightly release in your branch: $MOST_RECENT_NIGHTLY"
NIGHTLY_SHA=$(git -C lean4.git rev-parse "nightly-$MOST_RECENT_NIGHTLY^{commit}")
echo "SHA of most recent nightly: $NIGHTLY_SHA"
echo "SHA of most recent nightly release: $NIGHTLY_SHA"
MERGE_BASE_SHA=$(git -C lean4.git merge-base origin/master "${{ steps.workflow-info.outputs.sourceHeadSha }}")
echo "SHA of merge-base: $MERGE_BASE_SHA"
if [ "$NIGHTLY_SHA" = "$MERGE_BASE_SHA" ]; then
echo "Most recent nightly tag agrees with the merge base."
echo "The merge base of this PR coincides with the nightly release"
REMOTE_BRANCHES=$(git ls-remote -h https://github.com/leanprover-community/mathlib4.git nightly-testing-$MOST_RECENT_NIGHTLY)
MATHLIB_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover-community/mathlib4.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
if [[ -n "$REMOTE_BRANCHES" ]]; then
echo "... and Mathlib has a 'nightly-testing-$MOST_RECENT_NIGHTLY' branch."
if [[ -n "$MATHLIB_REMOTE_TAGS" ]]; then
echo "... and Mathlib has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE=""
else
echo "... but Mathlib does not yet have a 'nightly-testing-$MOST_RECENT_NIGHTLY' branch."
MESSAGE="- ❗ Mathlib CI can not be attempted yet, as the 'nightly-testing-$MOST_RECENT_NIGHTLY' branch does not exist there yet. We will retry when you push more commits. It may be necessary to rebase onto 'nightly' tomorrow."
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."
fi
STD_REMOTE_TAGS="$(git ls-remote https://github.com/leanprover/std4.git nightly-testing-"$MOST_RECENT_NIGHTLY")"
if [[ -n "$STD_REMOTE_TAGS" ]]; then
echo "... and Std has a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE=""
else
echo "... but Std does not yet have a 'nightly-testing-$MOST_RECENT_NIGHTLY' tag."
MESSAGE="- ❗ Std 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\`, Std CI should run now."
fi
else
@@ -123,20 +151,24 @@ jobs:
echo "but 'git merge-base origin/master HEAD' reported: $MERGE_BASE_SHA"
git -C lean4.git log -10 origin/master
MESSAGE="- ❗ Mathlib CI will not be attempted unless you rebase your PR onto the 'nightly' branch."
MESSAGE="- ❗ Std/Mathlib CI will not be attempted unless your PR branches off the \`nightly-with-mathlib\` branch."
fi
if [[ -n "$MESSAGE" ]]; then
echo "Checking existing messages"
# The code for updating comments is duplicated in mathlib's
# scripts/lean-pr-testing-comments.sh
# so keep in sync
# Use GitHub API to check if a comment already exists
existing_comment=$(curl -L -s -H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
existing_comment="$(curl -L -s -H "Authorization: token ${{ secrets.MATHLIB4_BOT }}" \
-H "Accept: application/vnd.github.v3+json" \
"https://api.github.com/repos/leanprover/lean4/issues/${{ steps.workflow-info.outputs.pullRequestNumber }}/comments" \
| jq '.[] | select(.body | startswith("- Mathlib") or startswith("- ✅ Mathlib") or startswith("- ❌ Mathlib") or startswith("- 💥 Mathlib") or startswith("- 🟡 Mathlib"))')
existing_comment_id=$(echo "$existing_comment" | jq -r .id)
existing_comment_body=$(echo "$existing_comment" | jq -r .body)
| jq 'first(.[] | select(.body | test("^- . Mathlib") or startswith("Mathlib CI status")) | select(.user.login == "leanprover-community-mathlib4-bot"))')"
existing_comment_id="$(echo "$existing_comment" | jq -r .id)"
existing_comment_body="$(echo "$existing_comment" | jq -r .body)"
if [[ "$existing_comment_body" != *"$MESSAGE"* ]]; then
MESSAGE="$MESSAGE ($(date "+%Y-%m-%d %H:%M:%S"))"
@@ -146,13 +178,14 @@ jobs:
# 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.
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 "Accept: application/vnd.github.v3+json" \
-d "$(jq --null-input --arg val "$MESSAGE" '{"body": $val}')" \
-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"
else
# Append new result to the existing comment
@@ -167,18 +200,93 @@ jobs:
else
echo "The message already exists in the comment body."
fi
echo "mathlib_ready=false" >> $GITHUB_OUTPUT
echo "mathlib_ready=false" >> "$GITHUB_OUTPUT"
else
echo "mathlib_ready=true" >> $GITHUB_OUTPUT
echo "mathlib_ready=true" >> "$GITHUB_OUTPUT"
fi
- name: Report mathlib base
if: ${{ steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true' }}
uses: actions/github-script@v6
with:
script: |
const description =
process.env.MOST_RECENT_NIGHTLY ?
"nightly-" + process.env.MOST_RECENT_NIGHTLY :
"not branched off nightly";
await github.rest.repos.createCommitStatus({
owner: context.repo.owner,
repo: context.repo.repo,
sha: "${{ steps.workflow-info.outputs.sourceHeadSha }}",
state: "success",
context: "PR branched off:",
description: description,
});
# We next automatically create a Std branch using this toolchain.
# Std doesn't itself have a mechanism to report results of CI from this branch back to Lean
# Instead this is taken care of by Mathlib CI, which will fail if Std fails.
- name: Cleanup workspace
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
run: |
sudo rm -rf ./*
# Checkout the Std repository with all branches
- name: Checkout Std repository
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
uses: actions/checkout@v3
with:
repository: leanprover/std4
token: ${{ secrets.MATHLIB4_BOT }}
ref: nightly-testing
fetch-depth: 0 # This ensures we check out all tags and branches.
- name: Check if tag exists
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
id: check_std_tag
run: |
git config user.name "leanprover-community-mathlib4-bot"
git config user.email "leanprover-community-mathlib4-bot@users.noreply.github.com"
if git ls-remote --heads --tags --exit-code origin "nightly-testing-${MOST_RECENT_NIGHTLY}" >/dev/null; then
BASE="nightly-testing-${MOST_RECENT_NIGHTLY}"
else
echo "This shouldn't be possible: couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' tag at Std. Falling back to 'nightly-testing'."
BASE=nightly-testing
fi
echo "Using base branch: $BASE"
EXISTS="$(git ls-remote --heads origin lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} | wc -l)"
echo "Branch exists: $EXISTS"
if [ "$EXISTS" = "0" ]; then
echo "Branch does not exist, creating it."
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
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."
git switch lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}
# The Std `nightly-testing` or `nightly-testing-YYYY-MM-DD` branch 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
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
fi
- name: Push changes
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
run: |
git push origin lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}
# We next automatically create a Mathlib branch using this toolchain.
# Mathlib CI will be responsible for reporting back success or failure
# to the PR comments asynchronously.
- name: Cleanup workspace
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
run: |
sudo rm -rf *
sudo rm -rf ./*
# Checkout the mathlib4 repository with all branches
- name: Checkout mathlib4 repository
@@ -190,37 +298,38 @@ jobs:
ref: nightly-testing
fetch-depth: 0 # This ensures we check out all tags and branches.
- name: Check if branch exists
- name: Check if tag exists
if: steps.workflow-info.outputs.pullRequestNumber != '' && steps.ready.outputs.mathlib_ready == 'true'
id: check_branch
id: check_mathlib_tag
run: |
git config user.name "leanprover-community-mathlib4-bot"
git config user.email "leanprover-community-mathlib4-bot@users.noreply.github.com"
if git branch -r | grep -q "nightly-testing-${MOST_RECENT_NIGHTLY}"; then
BASE=nightly-testing-${MOST_RECENT_NIGHTLY}
if git ls-remote --heads --tags --exit-code origin "nightly-testing-${MOST_RECENT_NIGHTLY}" >/dev/null; then
BASE="nightly-testing-${MOST_RECENT_NIGHTLY}"
else
echo "This shouldn't be possible: couldn't find a 'nightly-testing-${MOST_RECENT_NIGHTLY}' branch at Mathlib. Falling back to 'nightly-testing'."
BASE=nightly-testing
fi
echo "Using base branch: $BASE"
echo "Using base tag: $BASE"
git checkout $BASE
EXISTS=$(git ls-remote --heads origin lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} | wc -l)
EXISTS="$(git ls-remote --heads origin lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }} | wc -l)"
echo "Branch exists: $EXISTS"
if [ "$EXISTS" = "0" ]; then
echo "Branch does not exist, creating it."
git checkout -b lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}
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 std from git \"https:\/\/github.com\/leanprover\/std4\" @ \".\+\"/require std from git \"https:\/\/github.com\/leanprover\/std4\" @ \"nightly-testing-${MOST_RECENT_NIGHTLY}\"/" lakefile.lean
git add lakefile.lean
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."
git checkout lean-pr-testing-${{ steps.workflow-info.outputs.pullRequestNumber }}
# The Mathlib `nightly-testing` or `nightly-testing-YYYY-MM-DD` branch may have moved since this branch was created, so merge their changes.
git merge $BASE --strategy-option ours --no-commit --allow-unrelated-histories
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
git commit --allow-empty -m "Trigger CI for https://github.com/leanprover/lean4/pull/${{ steps.workflow-info.outputs.pullRequestNumber }}"
fi

View File

@@ -17,6 +17,7 @@
/src/Lean/Meta/Tactic/ @leodemoura
/src/Lean/Parser/ @Kha
/src/Lean/PrettyPrinter/ @Kha
/src/Lean/PrettyPrinter/Delaborator/ @kmill
/src/Lean/Server/ @mhuisi
/src/Lean/Widget/ @Vtec234
/src/runtime/io.cpp @joehendrix

View File

@@ -1,13 +1,8 @@
This is the repository for **Lean 4**.
We provide [nightly releases](https://github.com/leanprover/lean4-nightly/releases)
and have just begun regular [stable point releases](https://github.com/leanprover/lean4/releases).
# About
- [Quickstart](https://github.com/leanprover/lean4/blob/master/doc/quickstart.md)
- [Walkthrough installation video](https://www.youtube.com/watch?v=yZo6k48L0VY)
- [Quick tour video](https://youtu.be/zyXtbb_eYbY)
- [Quickstart](https://lean-lang.org/lean4/doc/quickstart.html)
- [Homepage](https://lean-lang.org)
- [Theorem Proving Tutorial](https://lean-lang.org/theorem_proving_in_lean4/)
- [Functional Programming in Lean](https://lean-lang.org/functional_programming_in_lean/)

View File

@@ -8,9 +8,245 @@ This file contains work-in-progress notes for the upcoming release, as well as p
Please check the [releases](https://github.com/leanprover/lean4/releases) page for the current status
of each version.
v4.6.0 (development in progress)
v4.7.0 (development in progress)
---------
* When the `pp.proofs` is false, now omitted proofs use `⋯` rather than `_`,
which gives a more helpful error message when copied from the Infoview.
The `pp.proofs.threshold` option lets small proofs always be pretty printed.
[#3241](https://github.com/leanprover/lean4/pull/3241).
v4.6.0
---------
* Add custom simplification procedures (aka `simproc`s) to `simp`. Simprocs can be triggered by the simplifier on a specified term-pattern. Here is an small example:
```lean
import Lean.Meta.Tactic.Simp.BuiltinSimprocs.Nat
def foo (x : Nat) : Nat :=
x + 10
/--
The `simproc` `reduceFoo` is invoked on terms that match the pattern `foo _`.
-/
simproc reduceFoo (foo _) :=
/- A term of type `Expr → SimpM Step -/
fun e => do
/-
The `Step` type has three constructors: `.done`, `.visit`, `.continue`.
* The constructor `.done` instructs `simp` that the result does
not need to be simplied 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`.
`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`.
-/
/- `simp` uses matching modulo reducibility. So, we ensure the term is a `foo`-application. -/
unless e.isAppOfArity ``foo 1 do
return .continue
/- `Nat.fromExpr?` tries to convert an expression into a `Nat` value -/
let some n Nat.fromExpr? e.appArg!
| return .continue
return .done { expr := Lean.mkNatLit (n+10) }
```
We disable simprocs support by using the command `set_option simprocs false`. This command is particularly useful when porting files to v4.6.0.
Simprocs can be scoped, manually added to `simp` commands, and suppressed using `-`. They are also supported by `simp?`. `simp only` does not execute any `simproc`. Here are some examples for the `simproc` defined above.
```lean
example : x + foo 2 = 12 + x := by
set_option simprocs false in
/- This `simp` command does not make progress since `simproc`s are disabled. -/
fail_if_success simp
simp_arith
example : x + foo 2 = 12 + x := by
/- `simp only` must not use the default simproc set. -/
fail_if_success simp only
simp_arith
example : x + foo 2 = 12 + x := by
/-
`simp only` does not use the default simproc set,
but we can provide simprocs as arguments. -/
simp only [reduceFoo]
simp_arith
example : x + foo 2 = 12 + x := by
/- We can use `-` to disable `simproc`s. -/
fail_if_success simp [-reduceFoo]
simp_arith
```
The command `register_simp_attr <id>` now creates a `simp` **and** a `simproc` set with the name `<id>`. The following command instructs Lean to insert the `reduceFoo` simplification procedure into the set `my_simp`. If no set is specified, Lean uses the default `simp` set.
```lean
simproc [my_simp] reduceFoo (foo _) := ...
```
* The syntax of the `termination_by` and `decreasing_by` termination hints is overhauled:
* They are now placed directly after the function they apply to, instead of
after the whole `mutual` block.
* Therefore, the function name no longer has to be mentioned in the hint.
* If the function has a `where` clause, the `termination_by` and
`decreasing_by` for that function come before the `where`. The
functions in the `where` clause can have their own termination hints, each
following the corresponding definition.
* The `termination_by` clause can only bind “extra parameters”, that are not
already bound by the function header, but are bound in a lambda (`:= fun x
y z =>`) or in patterns (`| x, n + 1 => …`). These extra parameters used to
be understood as a suffix of the function parameters; now it is a prefix.
Migration guide: In simple cases just remove the function name, and any
variables already bound at the header.
```diff
def foo : Nat → Nat → Nat := …
-termination_by foo a b => a - b
+termination_by a b => a - b
```
or
```diff
def foo : Nat → Nat → Nat := …
-termination_by _ a b => a - b
+termination_by a b => a - b
```
If the parameters are bound in the function header (before the `:`), remove them as well:
```diff
def foo (a b : Nat) : Nat := …
-termination_by foo a b => a - b
+termination_by a - b
```
Else, if there are multiple extra parameters, make sure to refer to the right
ones; the bound variables are interpreted from left to right, no longer from
right to left:
```diff
def foo : Nat → Nat → Nat → Nat
| a, b, c => …
-termination_by foo b c => b
+termination_by a b => b
```
In the case of a `mutual` block, place the termination arguments (without the
function name) next to the function definition:
```diff
-mutual
-def foo : Nat → Nat → Nat := …
-def bar : Nat → Nat := …
-end
-termination_by
- foo a b => a - b
- bar a => a
+mutual
+def foo : Nat → Nat → Nat := …
+termination_by a b => a - b
+def bar : Nat → Nat := …
+termination_by a => a
+end
```
Similarly, if you have (mutual) recursion through `where` or `let rec`, the
termination hints are now placed directly after the function they apply to:
```diff
-def foo (a b : Nat) : Nat := …
- where bar (x : Nat) : Nat := …
-termination_by
- foo a b => a - b
- bar x => x
+def foo (a b : Nat) : Nat := …
+termination_by a - b
+ where
+ bar (x : Nat) : Nat := …
+ termination_by x
-def foo (a b : Nat) : Nat :=
- let rec bar (x : Nat) : Nat := …
- …
-termination_by
- foo a b => a - b
- bar x => x
+def foo (a b : Nat) : Nat :=
+ let rec bar (x : Nat) : Nat := …
+ termination_by x
+ …
+termination_by a - b
```
In cases where a single `decreasing_by` clause applied to multiple mutually
recursive functions before, the tactic now has to be duplicated.
* The semantics of `decreasing_by` changed; the tactic is applied to all
termination proof goals together, not individually.
This helps when writing termination proofs interactively, as one can focus
each subgoal individually, for example using `·`. Previously, the given
tactic script had to work for _all_ goals, and one had to resort to tactic
combinators like `first`:
```diff
def foo (n : Nat) := … foo e1 … foo e2 …
-decreasing_by
-simp_wf
-first | apply something_about_e1; …
- | apply something_about_e2; …
+decreasing_by
+all_goals simp_wf
+· apply something_about_e1; …
+· apply something_about_e2; …
```
To obtain the old behaviour of applying a tactic to each goal individually,
use `all_goals`:
```diff
def foo (n : Nat) := …
-decreasing_by some_tactic
+decreasing_by all_goals some_tactic
```
In the case of mutual recursion each `decreasing_by` now applies to just its
function. If some functions in a recursive group do not have their own
`decreasing_by`, the default `decreasing_tactic` is used. If the same tactic
ought to be applied to multiple functions, the `decreasing_by` clause has to
be repeated at each of these functions.
* Modify `InfoTree.context` to facilitate augmenting it with partial contexts while elaborating a command. This breaks backwards compatibility with all downstream projects that traverse the `InfoTree` manually instead of going through the functions in `InfoUtils.lean`, as well as those manually creating and saving `InfoTree`s. See [PR #3159](https://github.com/leanprover/lean4/pull/3159) for how to migrate your code.
* Add language server support for [call hierarchy requests](https://www.youtube.com/watch?v=r5LA7ivUb2c) ([PR #3082](https://github.com/leanprover/lean4/pull/3082)). The change to the .ilean format in this PR means that projects must be fully rebuilt once in order to generate .ilean files with the new format before features like "find references" work correctly again.
* Structure instances with multiple sources (for example `{a, b, c with x := 0}`) now have their fields filled from these sources
in strict left-to-right order. Furthermore, the structure instance elaborator now aggressively use sources to fill in subobject
fields, which prevents unnecessary eta expansion of the sources,
and hence greatly reduces the reliance on costly structure eta reduction. This has a large impact on mathlib,
reducing total CPU instructions by 3% and enabling impactful refactors like leanprover-community/mathlib4#8386
which reduces the build time by almost 20%.
See PR [#2478](https://github.com/leanprover/lean4/pull/2478) and RFC [#2451](https://github.com/leanprover/lean4/issues/2451).
* Add pretty printer settings to omit deeply nested terms (`pp.deepTerms false` and `pp.deepTerms.threshold`) ([PR #3201](https://github.com/leanprover/lean4/pull/3201))
* Add pretty printer options `pp.numeralTypes` and `pp.natLit`.
When `pp.numeralTypes` is true, then natural number literals, integer literals, and rational number literals
are pretty printed with type ascriptions, such as `(2 : Rat)`, `(-2 : Rat)`, and `(-2 / 3 : Rat)`.
When `pp.natLit` is true, then raw natural number literals are pretty printed as `nat_lit 2`.
[PR #2933](https://github.com/leanprover/lean4/pull/2933) and [RFC #3021](https://github.com/leanprover/lean4/issues/3021).
Lake updates:
* improved platform information & control [#3226](https://github.com/leanprover/lean4/pull/3226)
* `lake update` from unsupported manifest versions [#3149](https://github.com/leanprover/lean4/pull/3149)
Other improvements:
* make `intro` be aware of `let_fun` [#3115](https://github.com/leanprover/lean4/pull/3115)
* produce simpler proof terms in `rw` [#3121](https://github.com/leanprover/lean4/pull/3121)
* fuse nested `mkCongrArg` calls in proofs generated by `simp` [#3203](https://github.com/leanprover/lean4/pull/3203)
* `induction using` followed by a general term [#3188](https://github.com/leanprover/lean4/pull/3188)
* allow generalization in `let` [#3060](https://github.com/leanprover/lean4/pull/3060, fixing [#3065](https://github.com/leanprover/lean4/issues/3065)
* reducing out-of-bounds `swap!` should return `a`, not `default`` [#3197](https://github.com/leanprover/lean4/pull/3197), fixing [#3196](https://github.com/leanprover/lean4/issues/3196)
* derive `BEq` on structure with `Prop`-fields [#3191](https://github.com/leanprover/lean4/pull/3191), fixing [#3140](https://github.com/leanprover/lean4/issues/3140)
* refine through more `casesOnApp`/`matcherApp` [#3176](https://github.com/leanprover/lean4/pull/3176), fixing [#3175](https://github.com/leanprover/lean4/pull/3175)
* do not strip dotted components from lean module names [#2994](https://github.com/leanprover/lean4/pull/2994), fixing [#2999](https://github.com/leanprover/lean4/issues/2999)
* fix `deriving` only deriving the first declaration for some handlers [#3058](https://github.com/leanprover/lean4/pull/3058), fixing [#3057](https://github.com/leanprover/lean4/issues/3057)
* do not instantiate metavariables in kabstract/rw for disallowed occurrences [#2539](https://github.com/leanprover/lean4/pull/2539), fixing [#2538](https://github.com/leanprover/lean4/issues/2538)
* hover info for `cases h : ...` [#3084](https://github.com/leanprover/lean4/pull/3084)
v4.5.0
---------
@@ -33,7 +269,7 @@ v4.5.0
Migration guide: Use `termination_by` instead, e.g.:
```diff
-termination_by' measure (fun ⟨i, _⟩ => as.size - i)
+termination_by go i _ => as.size - i
+termination_by i _ => as.size - i
```
If the well-founded relation you want to use is not the one that the
@@ -41,7 +277,7 @@ v4.5.0
you can use `WellFounded.wrap` from the std libarary to explicitly give one:
```diff
-termination_by' ⟨r, hwf⟩
+termination_by _ x => hwf.wrap x
+termination_by x => hwf.wrap x
```
* Support snippet edits in LSP `TextEdit`s. See `Lean.Lsp.SnippetString` for more details.
@@ -50,7 +286,7 @@ v4.5.0
- `Widget.UserWidgetDefinition` is deprecated in favour of `Widget.Module`. The annotation `@[widget]` is deprecated in favour of `@[widget_module]`. To migrate a definition of type `UserWidgetDefinition`, remove the `name` field and replace the type with `Widget.Module`. Removing the `name` results in a title bar no longer being drawn above your panel widget. To add it back, draw it as part of the component using `<details open=true><summary class='mv2 pointer'>{name}</summary>{rest_of_widget}</details>`. See an example migration [here](https://github.com/leanprover/std4/pull/475/files#diff-857376079661a0c28a53b7ff84701afabbdf529836a6944d106c5294f0e68109R43-R83).
- The new command `show_panel_widgets` allows displaying always-on and locally-on panel widgets.
- `RpcEncodable` widget props can now be stored in the infotree.
- See [RFC 2963](https://github.com/leanprover/lean4/issues/2963) for more details and motivation.
- See [RFC 2963](https://github.com/leanprover/lean4/issues/2963) for more details and motivation.
* If no usable lexicographic order can be found automatically for a termination proof, explain why.
See [feat: GuessLex: if no measure is found, explain why](https://github.com/leanprover/lean4/pull/2960).
@@ -71,7 +307,7 @@ v4.5.0
* Tactics with `withLocation *` [no longer fail](https://github.com/leanprover/lean4/pull/2917) if they close the main goal.
* Implementation of a `test_extern` command for writing tests for `@[extern]` and `@[implemented_by]` functions.
Usage is
Usage is
```
import Lean.Util.TestExtern
@@ -79,8 +315,8 @@ v4.5.0
```
The head symbol must be the constant with the `@[extern]` or `@[implemented_by]` attribute. The return type must have a `DecidableEq` instance.
Bug fixes for
[#2853](https://github.com/leanprover/lean4/issues/2853), [#2953](https://github.com/leanprover/lean4/issues/2953), [#2966](https://github.com/leanprover/lean4/issues/2966),
Bug fixes for
[#2853](https://github.com/leanprover/lean4/issues/2853), [#2953](https://github.com/leanprover/lean4/issues/2953), [#2966](https://github.com/leanprover/lean4/issues/2966),
[#2971](https://github.com/leanprover/lean4/issues/2971), [#2990](https://github.com/leanprover/lean4/issues/2990), [#3094](https://github.com/leanprover/lean4/issues/3094).
Bug fix for [eager evaluation of default value](https://github.com/leanprover/lean4/pull/3043) in `Option.getD`.
@@ -93,19 +329,19 @@ v4.4.0
---------
* Lake and the language server now support per-package server options using the `moreServerOptions` config field, as well as options that apply to both the language server and `lean` using the `leanOptions` config field. Setting either of these fields instead of `moreServerArgs` ensures that viewing files from a dependency uses the options for that dependency. Additionally, `moreServerArgs` is being deprecated in favor of the `moreGlobalServerArgs` field. See PR [#2858](https://github.com/leanprover/lean4/pull/2858).
A Lakefile with the following deprecated package declaration:
```lean
def moreServerArgs := #[
"-Dpp.unicode.fun=true"
]
def moreLeanArgs := moreServerArgs
package SomePackage where
moreServerArgs := moreServerArgs
moreLeanArgs := moreLeanArgs
```
... can be updated to the following package declaration to use per-package options:
```lean
package SomePackage where

View File

@@ -483,7 +483,43 @@ def baz : Char → Nat
| _ => 3
```
If any of the terms ``tᵢ`` in the template above contain a recursive call to ``foo``, the equation compiler tries to interpret the definition as a structural recursion. In order for that to succeed, the recursive arguments must be subterms of the corresponding arguments on the left-hand side. The function is then defined using a *course of values* recursion, using automatically generated functions ``below`` and ``brec`` in the namespace corresponding to the inductive type of the recursive argument. In this case the defining equations hold definitionally, possibly with additional case splits.
The case where patterns are matched against an argument whose type is an inductive family is known as *dependent pattern matching*. This is more complicated, because the type of the function being defined can impose constraints on the patterns that are matched. In this case, the equation compiler will detect inconsistent cases and rule them out.
```lean
universe u
inductive Vector (α : Type u) : Nat → Type u
| nil : Vector α 0
| cons : α → Vector α n → Vector α (n+1)
namespace Vector
def head : Vector α (n+1) → α
| cons h t => h
def tail : Vector α (n+1) → Vector α n
| cons h t => t
def map (f : α → β → γ) : Vector α n → Vector β n → Vector γ n
| nil, nil => nil
| cons a va, cons b vb => cons (f a b) (map f va vb)
end Vector
```
.. _recursive_functions:
Recursive functions
===================
Lean must ensure that a recursive function terminates, for which there are two strategies: _structural recursion_, in which all recursive calls are made on smaller parts of the input data, and _well-founded recursion_, in which recursive calls are justified by showing that arguments to recursive calls are smaller according to some other measure.
Structural recursion
--------------------
If the definition of a function contains recursive calls, Lean first tries to interpret the definition as a structural recursion. In order for that to succeed, the recursive arguments must be subterms of the corresponding arguments on the left-hand side.
The function is then defined using a *course of values* recursion, using automatically generated functions ``below`` and ``brec`` in the namespace corresponding to the inductive type of the recursive argument. In this case the defining equations hold definitionally, possibly with additional case splits.
```lean
namespace Hide
@@ -504,7 +540,12 @@ example : append [(1 : Nat), 2, 3] [4, 5] = [1, 2, 3, 4, 5] => rfl
end Hide
```
If structural recursion fails, the equation compiler falls back on well-founded recursion. It tries to infer an instance of ``SizeOf`` for the type of each argument, and then show that each recursive call is decreasing under the lexicographic order of the arguments with respect to ``sizeOf`` measure. If it fails, the error message provides information as to the goal that Lean tried to prove. Lean uses information in the local context, so you can often provide the relevant proof manually using ``have`` in the body of the definition. In this case of well-founded recursion, the defining equations hold only propositionally, and can be accessed using ``simp`` and ``rewrite`` with the name ``foo``.
Well-founded recursion
---------------------
If structural recursion fails, the equation compiler falls back on well-founded recursion. It tries to infer an instance of ``SizeOf`` for the type of each argument, and then tries to find a permutation of the arguments such that each recursive call is decreasing under the lexicographic order with respect to ``sizeOf`` measures. Lean uses information in the local context, so you can often provide the relevant proof manually using ``have`` in the body of the definition.
In the case of well-founded recursion, the equation used to declare the function holds only propositionally, but not definitionally, and can be accessed using ``unfold``, ``simp`` and ``rewrite`` with the function name (for example ``unfold foo`` or ``simp [foo]``, where ``foo`` is the function defined with well-founded recursion).
```lean
namespace Hide
@@ -528,9 +569,53 @@ by rw [div]; rfl
end Hide
```
If Lean cannot find a permutation of the arguments for which all recursive calls are decreasing, it will print a table that contains, for every recursive call, which arguments Lean could prove to be decreasing. For example, a function with three recursive calls and four parameters might cause the following message to be printed
```
example.lean:37:0-43:31: error: Could not find a decreasing measure.
The arguments relate at each recursive call as follows:
(<, ≤, =: relation proved, ? all proofs failed, _: no proof attempted)
x1 x2 x3 x4
1) 39:6-27 = = _ =
2) 40:6-25 = ? _ <
3) 41:6-25 < _ _ _
Please use `termination_by` to specify a decreasing measure.
```
This table should be read as follows:
* In the first recursive call, in line 39, arguments 1, 2 and 4 are equal to the function's parameters.
* The second recursive call, in line 40, has an equal first argument, a smaller fourth argument, and nothing could be inferred for the second argument.
* The third recursive call, in line 41, has a decreasing first argument.
* No other proofs were attempted, either because the parameter has a type without a non-trivial ``WellFounded`` instance (parameter 3), or because it is already clear that no decreasing measure can be found.
Lean will print the termination argument it found if ``set_option showInferredTerminationBy true`` is set.
If Lean does not find the termination argument, or if you want to be explicit, you can append a `termination_by` clause to the function definition, after the function's body, but before the `where` clause if present. It is of the form
```
termination_by e
```
where ``e`` is an expression that depends on the parameters of the function and should be decreasing at each recursive call. The type of `e` should be an instance of the class ``WellFoundedRelation``, which determines how to compare two values of that type.
If ``f`` has parameters “after the ``:``” (for example when defining functions via patterns using `|`), then these can be brought into scope using the syntax
```
termination_by a₁ … aₙ => e
```
By default, Lean uses the tactic ``decreasing_tactic`` when proving that an argument is decreasing; see its documentation for how to globally extend it. You can also choose to use a different tactic for a given function definition with the clause
```
decreasing_by <tac>
```
which should come after ``termination_by`, if present.
Note that recursive definitions can in general require nested recursions, that is, recursion on different arguments of ``foo`` in the template above. The equation compiler handles this by abstracting later arguments, and recursively defining higher-order functions to meet the specification.
The equation compiler also allows mutual recursive definitions, with a syntax similar to that of [Mutual and Nested Inductive Definitions](#mutual-and-nested-inductive-definitions). They are compiled using well-founded recursion, and so once again the defining equations hold only propositionally.
Mutual recursion
----------------
The equation compiler also allows mutual recursive definitions, with a syntax similar to that of [Mutual and Nested Inductive Definitions](#mutual-and-nested-inductive-definitions). Mutual definitions are always compiled using well-founded recursion, and so once again the defining equations hold only propositionally.
```lean
mutual
@@ -587,29 +672,31 @@ def num_consts_lst : List Term → Nat
end
```
The case where patterns are matched against an argument whose type is an inductive family is known as *dependent pattern matching*. This is more complicated, because the type of the function being defined can impose constraints on the patterns that are matched. In this case, the equation compiler will detect inconsistent cases and rule them out.
In a set of mutually recursive function, either all or no functions must have an explicit termination argument (``termination_by``). A change of the default termination tactic (``decreasing_by``) only affects the proofs about the recursive calls of that function, not the other functions in the group.
```lean
universe u
```
mutual
theorem even_of_odd_succ : ∀ n, Odd (n + 1) → Even n
| _, odd_succ n h => h
termination_by n h => h
decreasing_by decreasing_tactic
inductive Vector (α : Type u) : Nat → Type u
| nil : Vector α 0
| cons : α → Vector α n → Vector α (n+1)
theorem odd_of_even_succ : ∀ n, Even (n + 1) → Odd n
| _, even_succ n h => h
termination_by n h => h
end
```
namespace Vector
Another way to express mutual recursion is using local function definitions in ``where`` or ``let rec`` clauses: these can be mutually recursive with each other and their containing function:
def head {α : Type} : Vector α (n+1) → α
| cons h t => h
def tail {α : Type} : Vector α (n+1) → Vector α n
| cons h t => t
def map {α β γ : Type} (f : α → β → γ) :
∀ {n}, Vector α n → Vector β n → Vector γ n
| 0, nil, nil => nil
| n+1, cons a va, cons b vb => cons (f a b) (map f va vb)
end Vector
```
theorem even_of_odd_succ : ∀ n, Odd (n + 1) → Even n
| _, odd_succ n h => h
termination_by n h => h
where
theorem odd_of_even_succ : ∀ n, Even (n + 1) → Odd n
| _, even_succ n h => h
termination_by n h => h
```
.. _match_expressions:

View File

@@ -121,4 +121,4 @@ Thus to e.g. run `#eval` on such a declaration, you need to
Note that it is not sufficient to load the foreign library containing the external symbol because the interpreter depends on code that is emitted for each `@[extern]` declaration.
Thus it is not possible to interpret an `@[extern]` declaration in the same file.
See `tests/compiler/foreign` for an example.
See [`tests/compiler/foreign`](https://github.com/leanprover/lean4/tree/master/tests/compiler/foreign/) for an example.

View File

@@ -41,17 +41,17 @@ information is displayed. This option will show all test output.
All these tests are included by [src/shell/CMakeLists.txt](https://github.com/leanprover/lean4/blob/master/src/shell/CMakeLists.txt):
- `tests/lean`: contains tests that come equipped with a
.lean.expected.out file. The driver script `test_single.sh` runs
- [`tests/lean`](https://github.com/leanprover/lean4/tree/master/tests/lean/): contains tests that come equipped with a
.lean.expected.out file. The driver script [`test_single.sh`](https://github.com/leanprover/lean4/tree/master/tests/lean/test_single.sh) runs
each test and checks the actual output (*.produced.out) with the
checked in expected output.
- `tests/lean/run`: contains tests that are run through the lean
- [`tests/lean/run`](https://github.com/leanprover/lean4/tree/master/tests/lean/run/): contains tests that are run through the lean
command line one file at a time. These tests only look for error
codes and do not check the expected output even though output is
produced, it is ignored.
- `tests/lean/interactive`: are designed to test server requests at a
- [`tests/lean/interactive`](https://github.com/leanprover/lean4/tree/master/tests/lean/interactive/): are designed to test server requests at a
given position in the input file. Each .lean file contains comments
that indicate how to simulate a client request at that position.
using a `--^` point to the line position. Example:
@@ -61,7 +61,7 @@ All these tests are included by [src/shell/CMakeLists.txt](https://github.com/le
Bla.
--^ textDocument/completion
```
In this example, the test driver `test_single.sh` will simulate an
In this example, the test driver [`test_single.sh`](https://github.com/leanprover/lean4/tree/master/tests/lean/interactive/test_single.sh) will simulate an
auto-completion request at `Bla.`. The expected output is stored in
a .lean.expected.out in the json format that is part of the
[Language Server
@@ -78,21 +78,21 @@ All these tests are included by [src/shell/CMakeLists.txt](https://github.com/le
--^ collectDiagnostics
```
- `tests/lean/server`: Tests more of the Lean `--server` protocol.
- [`tests/lean/server`](https://github.com/leanprover/lean4/tree/master/tests/lean/server/): Tests more of the Lean `--server` protocol.
There are just a few of them, and it uses .log files containing
JSON.
- `tests/compiler`: contains tests that will run the Lean compiler and
- [`tests/compiler`](https://github.com/leanprover/lean4/tree/master/tests/compiler/): contains tests that will run the Lean compiler and
build an executable that is executed and the output is compared to
the .lean.expected.out file. This test also contains a subfolder
`foreign` which shows how to extend Lean using C++.
[`foreign`](https://github.com/leanprover/lean4/tree/master/tests/compiler/foreign/) which shows how to extend Lean using C++.
- `tests/lean/trust0`: tests that run Lean in a mode that Lean doesn't
- [`tests/lean/trust0`](https://github.com/leanprover/lean4/tree/master/tests/lean/trust0): tests that run Lean in a mode that Lean doesn't
even trust the .olean files (i.e., trust 0).
- `tests/bench`: contains performance tests.
- [`tests/bench`](https://github.com/leanprover/lean4/tree/master/tests/bench/): contains performance tests.
- `tests/plugin`: tests that compiled Lean code can be loaded into
- [`tests/plugin`](https://github.com/leanprover/lean4/tree/master/tests/plugin/): tests that compiled Lean code can be loaded into
`lean` via the `--plugin` command line option.
## Writing Good Tests
@@ -103,7 +103,7 @@ Every test file should contain:
and, if not 100% clear, why that is the desirable behavior
At the time of writing, most tests do not follow these new guidelines yet.
For an example of a conforming test, see `tests/lean/1971.lean`.
For an example of a conforming test, see [`tests/lean/1971.lean`](https://github.com/leanprover/lean4/tree/master/tests/lean/1971.lean).
## Fixing Tests
@@ -119,7 +119,7 @@ First, we must install [meld](http://meldmerge.org/). On Ubuntu, we can do it by
sudo apt-get install meld
```
Now, suppose `bad_class.lean` test is broken. We can see the problem by going to `tests/lean` directory and
Now, suppose `bad_class.lean` test is broken. We can see the problem by going to [`tests/lean`](https://github.com/leanprover/lean4/tree/master/tests/lean) directory and
executing
```

View File

@@ -282,7 +282,7 @@ theorem BinTree.find_insert_of_ne (b : BinTree β) (h : k ≠ k') (v : β)
let t, h := b; simp
induction t with simp
| leaf =>
split <;> (try simp) <;> split <;> (try simp)
intros
have_eq k k'
contradiction
| node left key value right ihl ihr =>

View File

@@ -82,7 +82,7 @@ theorem List.palindrome_ind (motive : List α → Prop)
have ih := palindrome_ind motive h₁ h₂ h₃ (a₂::as').dropLast
have : [a₁] ++ (a₂::as').dropLast ++ [(a₂::as').last (by simp)] = a₁::a₂::as' := by simp
this h₃ _ _ _ ih
termination_by _ as => as.length
termination_by as.length
/-!
We use our new induction principle to prove that if `as.reverse = as`, then `Palindrome as` holds.

9
doc/flake.lock generated
View File

@@ -69,15 +69,16 @@
"leanInk": {
"flake": false,
"locked": {
"lastModified": 1666154782,
"narHash": "sha256-0ELqEca6jZT4BW/mqkDD+uYuxW5QlZUFlNwZkvugsg8=",
"owner": "digama0",
"lastModified": 1704976501,
"narHash": "sha256-FSBUsbX0HxakSnYRYzRBDN2YKmH9EkA0q9p7TSPEJTI=",
"owner": "leanprover",
"repo": "LeanInk",
"rev": "12a2aec9b5f4aa84e84fb01a9af1da00d8aaff4e",
"rev": "51821e3c2c032c88e4b2956483899d373ec090c4",
"type": "github"
},
"original": {
"owner": "leanprover",
"ref": "refs/pull/57/merge",
"repo": "LeanInk",
"type": "github"
}

View File

@@ -12,7 +12,7 @@
flake = false;
};
inputs.leanInk = {
url = "github:leanprover/LeanInk";
url = "github:leanprover/LeanInk/refs/pull/57/merge";
flake = false;
};

View File

@@ -32,8 +32,8 @@ def fact x :=
#eval fact 100
```
By default, Lean only accepts total functions. The `partial` keyword should be used when Lean cannot
establish that a function always terminates.
By default, Lean only accepts total functions.
The `partial` keyword may be used to define a recursive function without a termination proof; `partial` functions compute in compiled programs, but are opaque in proofs and during type checking.
```lean
partial def g (x : Nat) (p : Nat -> Bool) : Nat :=
if p x then

View File

@@ -10,7 +10,6 @@ Platform-Specific Setup
- [Linux (Ubuntu)](ubuntu.md)
- [Windows (msys2)](msys2.md)
- [Windows (Visual Studio)](msvc.md)
- [Windows (WSL)](wsl.md)
- [macOS (homebrew)](osx-10.9.md)
- Linux/macOS/WSL via [Nix](https://nixos.org/nix/): Call `nix-shell` in the project root. That's it.

View File

@@ -60,7 +60,7 @@ While parsing `a * (b + c)`, `(b + c)` is assigned a precedence `60` by the addi
the right argument to have precedence **at least** 71. Thus, this parse is invalid. In contrast, `(a * b) + c` assigns
a precedence of `70` to `(a * b)`. This is compatible with addition which expects the left argument to have precedence
**at least `60` ** (`70` is greater than `60`). Thus, the string `a * b + c` is parsed as `(a * b) + c`.
For more details, please look at the [Lean manual on syntax extensions](../syntax.md#notations-and-precedence).
For more details, please look at the [Lean manual on syntax extensions](./notation.md#notations-and-precedence).
To go from strings into `Arith`, we define a macro to
translate the syntax category `arith` into an `Arith` inductive value that

View File

@@ -2,7 +2,7 @@
### Tier 1
Platforms built & tested by our CI, available as nightly releases via elan (see below)
Platforms built & tested by our CI, available as binary releases via elan (see below)
* x86-64 Linux with glibc 2.27+
* x86-64 macOS 10.15+
@@ -10,7 +10,7 @@ Platforms built & tested by our CI, available as nightly releases via elan (see
### Tier 2
Platforms cross-compiled but not tested by our CI, available as nightly releases
Platforms cross-compiled but not tested by our CI, available as binary releases
Releases may be silently broken due to the lack of automated testing.
Issue reports and fixes are welcome.

View File

@@ -15,7 +15,7 @@ The most fundamental pieces of any Lean program are functions organized into nam
[Functions](./functions.md) perform work on inputs to produce outputs,
and they are organized under [namespaces](./namespaces.md),
which are the primary way you group things in Lean.
They are defined using the [`def`](./definitions.md) command,
They are defined using the `def` command,
which give the function a name and define its arguments.
```lean

View File

@@ -37,6 +37,6 @@ Lean has numerous features, including:
- [Extensible syntax](./syntax.md)
- Hygienic macros
- [Dependent types](https://lean-lang.org/theorem_proving_in_lean4/dependent_type_theory.html)
- [Metaprogramming](./metaprogramming.md)
- [Metaprogramming](./macro_overview.md)
- Multithreading
- Verification: you can prove properties of your functions using Lean itself

View File

@@ -9,7 +9,7 @@ endif()
include(ExternalProject)
project(LEAN CXX C)
set(LEAN_VERSION_MAJOR 4)
set(LEAN_VERSION_MINOR 6)
set(LEAN_VERSION_MINOR 7)
set(LEAN_VERSION_PATCH 0)
set(LEAN_VERSION_IS_RELEASE 0) # This number is 1 in the release revision, and 0 otherwise.
set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
@@ -18,6 +18,14 @@ if (LEAN_SPECIAL_VERSION_DESC)
string(APPEND LEAN_VERSION_STRING "-${LEAN_SPECIAL_VERSION_DESC}")
endif()
set(LEAN_PLATFORM_TARGET "" CACHE STRING "LLVM triple of the target platform")
if (NOT LEAN_PLATFORM_TARGET)
# this may fail when the compiler is not clang, but this should only happen in local builds where
# the value of the variable is not of immediate relevance
execute_process(COMMAND ${CMAKE_C_COMPILER} --print-target-triple
OUTPUT_VARIABLE LEAN_PLATFORM_TARGET OUTPUT_STRIP_TRAILING_WHITESPACE)
endif()
set(LEAN_EXTRA_LINKER_FLAGS "" CACHE STRING "Additional flags used by the linker")
set(LEAN_EXTRA_CXX_FLAGS "" CACHE STRING "Additional flags used by the C++ compiler")
set(LEAN_TEST_VARS "LEAN_CC=${CMAKE_C_COMPILER}" CACHE STRING "Additional environment variables used when running tests")

View File

@@ -7,6 +7,9 @@ prelude
import Init.Prelude
import Init.Notation
import Init.Tactics
import Init.TacticsExtra
import Init.ByCases
import Init.RCases
import Init.Core
import Init.Control
import Init.Data.Basic
@@ -21,6 +24,11 @@ import Init.MetaTypes
import Init.Meta
import Init.NotationExtra
import Init.SimpLemmas
import Init.PropLemmas
import Init.Hints
import Init.Conv
import Init.Guard
import Init.Simproc
import Init.SizeOfLemmas
import Init.BinderPredicates
import Init.Ext

View File

@@ -0,0 +1,82 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner
-/
prelude
import Init.NotationExtra
namespace Lean
/--
The syntax category of binder predicates contains predicates like `> 0`, `∈ s`, etc.
(`: t` should not be a binder predicate because it would clash with the built-in syntax for ∀/∃.)
-/
declare_syntax_cat binderPred
/--
`satisfies_binder_pred% t pred` expands to a proposition expressing that `t` satisfies `pred`.
-/
syntax "satisfies_binder_pred% " term:max binderPred : term
-- Extend ∀ and ∃ to binder predicates.
/--
The notation `∃ x < 2, p x` is shorthand for `∃ x, x < 2 ∧ p x`,
and similarly for other binary operators.
-/
syntax "" binderIdent binderPred ", " term : term
/--
The notation `∀ x < 2, p x` is shorthand for `∀ x, x < 2 → p x`,
and similarly for other binary operators.
-/
syntax "" binderIdent binderPred ", " term : term
macro_rules
| `( $x:ident $pred:binderPred, $p) =>
`( $x:ident, satisfies_binder_pred% $x $pred $p)
| `( _ $pred:binderPred, $p) =>
`( x, satisfies_binder_pred% x $pred $p)
macro_rules
| `( $x:ident $pred:binderPred, $p) =>
`( $x:ident, satisfies_binder_pred% $x $pred $p)
| `( _ $pred:binderPred, $p) =>
`( x, satisfies_binder_pred% x $pred $p)
/-- Declare `∃ x > y, ...` as syntax for `∃ x, x > y ∧ ...` -/
binder_predicate x " > " y:term => `($x > $y)
/-- Declare `∃ x ≥ y, ...` as syntax for `∃ x, x ≥ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∃ x < y, ...` as syntax for `∃ x, x < y ∧ ...` -/
binder_predicate x " < " y:term => `($x < $y)
/-- Declare `∃ x ≤ y, ...` as syntax for `∃ x, x ≤ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∃ x ≠ y, ...` as syntax for `∃ x, x ≠ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∀ x ∈ y, ...` as syntax for `∀ x, x ∈ y → ...` and `∃ x ∈ y, ...` as syntax for
`∃ x, x ∈ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∀ x ∉ y, ...` as syntax for `∀ x, x ∉ y → ...` and `∃ x ∉ y, ...` as syntax for
`∃ x, x ∉ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∀ x ⊆ y, ...` as syntax for `∀ x, x ⊆ y → ...` and `∃ x ⊆ y, ...` as syntax for
`∃ x, x ⊆ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∀ x ⊂ y, ...` as syntax for `∀ x, x ⊂ y → ...` and `∃ x ⊂ y, ...` as syntax for
`∃ x, x ⊂ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∀ x ⊇ y, ...` as syntax for `∀ x, x ⊇ y → ...` and `∃ x ⊇ y, ...` as syntax for
`∃ x, x ⊇ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
/-- Declare `∀ x ⊃ y, ...` as syntax for `∀ x, x ⊃ y → ...` and `∃ x ⊃ y, ...` as syntax for
`∃ x, x ⊃ y ∧ ...` -/
binder_predicate x "" y:term => `($x $y)
end Lean

74
src/Init/ByCases.lean Normal file
View File

@@ -0,0 +1,74 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.Classical
/-! # by_cases tactic and if-then-else support -/
/--
`by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, and `h : ¬ p` in the second branch.
-/
syntax "by_cases " (atomic(ident " : "))? term : tactic
macro_rules
| `(tactic| by_cases $e) => `(tactic| by_cases h : $e)
macro_rules
| `(tactic| by_cases $h : $e) =>
`(tactic| open Classical in refine if $h:ident : $e then ?pos else ?neg)
/-! ## if-then-else -/
@[simp] theorem if_true {h : Decidable True} (t e : α) : ite True t e = t := if_pos trivial
@[simp] theorem if_false {h : Decidable False} (t e : α) : ite False t e = e := if_neg id
theorem ite_id [Decidable c] {α} (t : α) : (if c then t else t) = t := by split <;> rfl
/-- A function applied to a `dite` is a `dite` of that function applied to each of the branches. -/
theorem apply_dite (f : α β) (P : Prop) [Decidable P] (x : P α) (y : ¬P α) :
f (dite P x y) = dite P (fun h => f (x h)) (fun h => f (y h)) := by
by_cases h : P <;> simp [h]
/-- A function applied to a `ite` is a `ite` of that function applied to each of the branches. -/
theorem apply_ite (f : α β) (P : Prop) [Decidable P] (x y : α) :
f (ite P x y) = ite P (f x) (f y) :=
apply_dite f P (fun _ => x) (fun _ => y)
/-- Negation of the condition `P : Prop` in a `dite` is the same as swapping the branches. -/
@[simp] theorem dite_not (P : Prop) {_ : Decidable P} (x : ¬P α) (y : ¬¬P α) :
dite (¬P) x y = dite P (fun h => y (not_not_intro h)) x := by
by_cases h : P <;> simp [h]
/-- Negation of the condition `P : Prop` in a `ite` is the same as swapping the branches. -/
@[simp] theorem ite_not (P : Prop) {_ : Decidable P} (x y : α) : ite (¬P) x y = ite P y x :=
dite_not P (fun _ => x) (fun _ => y)
@[simp] theorem dite_eq_left_iff {P : Prop} [Decidable P] {B : ¬ P α} :
dite P (fun _ => a) B = a h, B h = a := by
by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false]
@[simp] theorem dite_eq_right_iff {P : Prop} [Decidable P] {A : P α} :
(dite P A fun _ => b) = b h, A h = b := by
by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false]
@[simp] theorem ite_eq_left_iff {P : Prop} [Decidable P] : ite P a b = a ¬P b = a :=
dite_eq_left_iff
@[simp] theorem ite_eq_right_iff {P : Prop} [Decidable P] : ite P a b = b P a = b :=
dite_eq_right_iff
/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/
@[simp] theorem dite_eq_ite [Decidable P] : (dite P (fun _ => a) fun _ => b) = ite P a b := rfl
-- We don't mark this as `simp` as it is already handled by `ite_eq_right_iff`.
theorem ite_some_none_eq_none [Decidable P] :
(if P then some x else none) = none ¬ P := by
simp only [ite_eq_right_iff]
rfl
@[simp] theorem ite_some_none_eq_some [Decidable P] :
(if P then some x else none) = some y P x = y := by
split <;> simp_all

View File

@@ -1,11 +1,10 @@
/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.Core
import Init.NotationExtra
import Init.PropLemmas
universe u v
@@ -112,8 +111,8 @@ theorem skolem {α : Sort u} {b : α → Sort v} {p : ∀ x, b x → Prop} : (
theorem propComplete (a : Prop) : a = True a = False :=
match em a with
| Or.inl ha => Or.inl (propext (Iff.intro (fun _ => ) (fun _ => ha)))
| Or.inr hn => Or.inr (propext (Iff.intro (fun h => hn h) (fun h => False.elim h)))
| Or.inl ha => Or.inl (eq_true ha)
| Or.inr hn => Or.inr (eq_false hn)
-- this supercedes byCases in Decidable
theorem byCases {p q : Prop} (hpq : p q) (hnpq : ¬p q) : q :=
@@ -123,21 +122,36 @@ theorem byCases {p q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
theorem byContradiction {p : Prop} (h : ¬p False) : p :=
Decidable.byContradiction (dec := propDecidable _) h
/--
`by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, and `h : ¬ p` in the second branch.
-/
syntax "by_cases " (atomic(ident " : "))? term : tactic
/-- The Double Negation Theorem: `¬¬P` is equivalent to `P`.
The left-to-right direction, double negation elimination (DNE),
is classically true but not constructively. -/
@[scoped simp] theorem not_not : ¬¬a a := Decidable.not_not
macro_rules
| `(tactic| by_cases $h : $e) =>
`(tactic|
cases em $e with
| inl $h => _
| inr $h => _)
| `(tactic| by_cases $e) =>
`(tactic|
cases em $e with
| inl h => _
| inr h => _)
@[simp] theorem not_forall {p : α Prop} : (¬ x, p x) x, ¬p x := Decidable.not_forall
theorem not_forall_not {p : α Prop} : (¬ x, ¬p x) x, p x := Decidable.not_forall_not
theorem not_exists_not {p : α Prop} : (¬ x, ¬p x) x, p x := Decidable.not_exists_not
theorem forall_or_exists_not (P : α Prop) : ( a, P a) a, ¬ P a := by
rw [ not_forall]; exact em _
theorem exists_or_forall_not (P : α Prop) : ( a, P a) a, ¬ P a := by
rw [ not_exists]; exact em _
theorem or_iff_not_imp_left : a b (¬a b) := Decidable.or_iff_not_imp_left
theorem or_iff_not_imp_right : a b (¬b a) := Decidable.or_iff_not_imp_right
theorem not_imp_iff_and_not : ¬(a b) a ¬b := Decidable.not_imp_iff_and_not
theorem not_and_iff_or_not_not : ¬(a b) ¬a ¬b := Decidable.not_and_iff_or_not_not
theorem not_iff : ¬(a b) (¬a b) := Decidable.not_iff
end Classical
/-- Extract an element from a existential statement, using `Classical.choose`. -/
-- This enables projection notation.
@[reducible] noncomputable def Exists.choose {p : α Prop} (P : a, p a) : α := Classical.choose P
/-- Show that an element extracted from `P : ∃ a, p a` using `P.choose` satisfies `p`. -/
theorem Exists.choose_spec {p : α Prop} (P : a, p a) : p P.choose := Classical.choose_spec P

View File

@@ -290,6 +290,12 @@ between e.g. `↑x + ↑y` and `↑(x + y)`.
-/
syntax:1024 (name := coeNotation) "" term:1024 : term
/-- `⇑ t` coerces `t` to a function. -/
syntax:1024 (name := coeFunNotation) "" term:1024 : term
/-- `↥ t` coerces `t` to a type. -/
syntax:1024 (name := coeSortNotation) "" term:1024 : term
/-! # Basic instances -/
instance boolToProp : Coe Bool Prop where

View File

@@ -1,7 +1,7 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Leonardo de Moura
Authors: Sebastian Ullrich, Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.SimpLemmas
@@ -84,6 +84,36 @@ theorem seqRight_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x *>
theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y = x >>= fun a => y >>= fun _ => pure a := by
rw [seqLeft_eq]; simp [map_eq_pure_bind, seq_eq_bind_map]
/--
An alternative constructor for `LawfulMonad` which has more
defaultable fields in the common case.
-/
theorem LawfulMonad.mk' (m : Type u Type v) [Monad m]
(id_map : {α} (x : m α), id <$> x = x)
(pure_bind : {α β} (x : α) (f : α m β), pure x >>= f = f x)
(bind_assoc : {α β γ} (x : m α) (f : α m β) (g : β m γ),
x >>= f >>= g = x >>= fun x => f x >>= g)
(map_const : {α β} (x : α) (y : m β),
Functor.mapConst x y = Function.const β x <$> y := by intros; rfl)
(seqLeft_eq : {α β} (x : m α) (y : m β),
x <* y = (x >>= fun a => y >>= fun _ => pure a) := by intros; rfl)
(seqRight_eq : {α β} (x : m α) (y : m β), x *> y = (x >>= fun _ => y) := by intros; rfl)
(bind_pure_comp : {α β} (f : α β) (x : m α),
x >>= (fun y => pure (f y)) = f <$> x := by intros; rfl)
(bind_map : {α β} (f : m (α β)) (x : m α), f >>= (. <$> x) = f <*> x := by intros; rfl)
: LawfulMonad m :=
have map_pure {α β} (g : α β) (x : α) : g <$> (pure x : m α) = pure (g x) := by
rw [ bind_pure_comp]; simp [pure_bind]
{ id_map, bind_pure_comp, bind_map, pure_bind, bind_assoc, map_pure,
comp_map := by simp [ bind_pure_comp, bind_assoc, pure_bind]
pure_seq := by intros; rw [ bind_map]; simp [pure_bind]
seq_pure := by intros; rw [ bind_map]; simp [map_pure, bind_pure_comp]
seq_assoc := by simp [ bind_pure_comp, bind_map, bind_assoc, pure_bind]
map_const := funext fun x => funext (map_const x)
seqLeft_eq := by simp [seqLeft_eq, bind_map, bind_pure_comp, pure_bind, bind_assoc]
seqRight_eq := fun x y => by
rw [seqRight_eq, bind_map, bind_pure_comp, bind_assoc]; simp [pure_bind, id_map] }
/-! # Id -/
namespace Id
@@ -173,6 +203,16 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (ExceptT ε m) where
end ExceptT
/-! # Except -/
instance : LawfulMonad (Except ε) := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun a f => rfl)
(bind_assoc := fun a f g => by cases a <;> rfl)
instance : LawfulApplicative (Except ε) := inferInstance
instance : LawfulFunctor (Except ε) := inferInstance
/-! # ReaderT -/
namespace ReaderT
@@ -307,3 +347,30 @@ instance [Monad m] [LawfulMonad m] : LawfulMonad (StateT σ m) where
bind_assoc := by intros; apply ext; intros; simp
end StateT
/-! # EStateM -/
instance : LawfulMonad (EStateM ε σ) := .mk'
(id_map := fun x => funext <| fun s => by
dsimp only [EStateM.instMonadEStateM, EStateM.map]
match x s with
| .ok _ _ => rfl
| .error _ _ => rfl)
(pure_bind := fun _ _ => rfl)
(bind_assoc := fun x _ _ => funext <| fun s => by
dsimp only [EStateM.instMonadEStateM, EStateM.bind]
match x s with
| .ok _ _ => rfl
| .error _ _ => rfl)
(map_const := fun _ _ => rfl)
/-! # Option -/
instance : LawfulMonad Option := LawfulMonad.mk'
(id_map := fun x => by cases x <;> rfl)
(pure_bind := fun x f => rfl)
(bind_assoc := fun x f g => by cases x <;> rfl)
(bind_pure_comp := fun f x => by cases x <;> rfl)
instance : LawfulApplicative Option := inferInstance
instance : LawfulFunctor Option := inferInstance

View File

@@ -17,7 +17,9 @@ universe u v w
at the application site itself (by comparison to the `@[inline]` attribute,
which applies to all applications of the function).
-/
def inline {α : Sort u} (a : α) : α := a
@[simp] def inline {α : Sort u} (a : α) : α := a
theorem id.def {α : Sort u} (a : α) : id a = a := rfl
/--
`flip f a b` is `f b a`. It is useful for "point-free" programming,
@@ -32,8 +34,32 @@ and `flip (·<·)` is the greater-than relation.
@[simp] theorem Function.comp_apply {f : β δ} {g : α β} {x : α} : comp f g x = f (g x) := rfl
theorem Function.comp_def {α β δ} (f : β δ) (g : α β) : f g = fun x => f (g x) := rfl
attribute [simp] namedPattern
/--
`Empty.elim : Empty → C` says that a value of any type can be constructed from
`Empty`. This can be thought of as a compiler-checked assertion that a code path is unreachable.
This is a non-dependent variant of `Empty.rec`.
-/
@[macro_inline] def Empty.elim {C : Sort u} : Empty C := Empty.rec
/-- Decidable equality for Empty -/
instance : DecidableEq Empty := fun a => a.elim
/--
`PEmpty.elim : Empty → C` says that a value of any type can be constructed from
`PEmpty`. This can be thought of as a compiler-checked assertion that a code path is unreachable.
This is a non-dependent variant of `PEmpty.rec`.
-/
@[macro_inline] def PEmpty.elim {C : Sort _} : PEmpty C := fun a => nomatch a
/-- Decidable equality for PEmpty -/
instance : DecidableEq PEmpty := fun a => a.elim
/--
Thunks are "lazy" values that are evaluated when first accessed using `Thunk.get/map/bind`.
The value is then stored and not recomputed for all further accesses. -/
@@ -78,6 +104,8 @@ instance thunkCoe : CoeTail α (Thunk α) where
abbrev Eq.ndrecOn.{u1, u2} {α : Sort u2} {a : α} {motive : α Sort u1} {b : α} (h : a = b) (m : motive a) : motive b :=
Eq.ndrec m h
/-! # definitions -/
/--
If and only if, or logical bi-implication. `a ↔ b` means that `a` implies `b` and vice versa.
By `propext`, this implies that `a` and `b` are equal and hence any expression involving `a`
@@ -126,6 +154,10 @@ inductive PSum (α : Sort u) (β : Sort v) where
@[inherit_doc] infixr:30 " ⊕' " => PSum
instance {α β} [Inhabited α] : Inhabited (PSum α β) := PSum.inl default
instance {α β} [Inhabited β] : Inhabited (PSum α β) := PSum.inr default
/--
`Sigma β`, also denoted `Σ a : α, β a` or `(a : α) × β a`, is the type of dependent pairs
whose first component is `a : α` and whose second component is `b : β a`
@@ -342,6 +374,70 @@ class HasEquiv (α : Sort u) where
@[inherit_doc] infix:50 "" => HasEquiv.Equiv
/-! # set notation -/
/-- Notation type class for the subset relation `⊆`. -/
class HasSubset (α : Type u) where
/-- Subset relation: `a ⊆ b` -/
Subset : α α Prop
export HasSubset (Subset)
/-- Notation type class for the strict subset relation `⊂`. -/
class HasSSubset (α : Type u) where
/-- Strict subset relation: `a ⊂ b` -/
SSubset : α α Prop
export HasSSubset (SSubset)
/-- Superset relation: `a ⊇ b` -/
abbrev Superset [HasSubset α] (a b : α) := Subset b a
/-- Strict superset relation: `a ⊃ b` -/
abbrev SSuperset [HasSSubset α] (a b : α) := SSubset b a
/-- Notation type class for the union operation ``. -/
class Union (α : Type u) where
/-- `a b` is the union of`a` and `b`. -/
union : α α α
/-- Notation type class for the intersection operation `∩`. -/
class Inter (α : Type u) where
/-- `a ∩ b` is the intersection of`a` and `b`. -/
inter : α α α
/-- Notation type class for the set difference `\`. -/
class SDiff (α : Type u) where
/--
`a \ b` is the set difference of `a` and `b`,
consisting of all elements in `a` that are not in `b`.
-/
sdiff : α α α
/-- Subset relation: `a ⊆ b` -/
infix:50 "" => Subset
/-- Strict subset relation: `a ⊂ b` -/
infix:50 "" => SSubset
/-- Superset relation: `a ⊇ b` -/
infix:50 "" => Superset
/-- Strict superset relation: `a ⊃ b` -/
infix:50 "" => SSuperset
/-- `a b` is the union of`a` and `b`. -/
infixl:65 " " => Union.union
/-- `a ∩ b` is the intersection of`a` and `b`. -/
infixl:70 "" => Inter.inter
/--
`a \ b` is the set difference of `a` and `b`,
consisting of all elements in `a` that are not in `b`.
-/
infix:70 " \\ " => SDiff.sdiff
/-! # collections -/
/-- `EmptyCollection α` is the typeclass which supports the notation `∅`, also written as `{}`. -/
class EmptyCollection (α : Type u) where
/-- `∅` or `{}` is the empty set or empty collection.
@@ -351,6 +447,36 @@ class EmptyCollection (α : Type u) where
@[inherit_doc] notation "{" "}" => EmptyCollection.emptyCollection
@[inherit_doc] notation "" => EmptyCollection.emptyCollection
/--
Type class for the `insert` operation.
Used to implement the `{ a, b, c }` syntax.
-/
class Insert (α : outParam <| Type u) (γ : Type v) where
/-- `insert x xs` inserts the element `x` into the collection `xs`. -/
insert : α γ γ
export Insert (insert)
/--
Type class for the `singleton` operation.
Used to implement the `{ a, b, c }` syntax.
-/
class Singleton (α : outParam <| Type u) (β : Type v) where
/-- `singleton x` is a collection with the single element `x` (notation: `{x}`). -/
singleton : α β
export Singleton (singleton)
/-- `insert x ∅ = {x}` -/
class IsLawfulSingleton (α : Type u) (β : Type v) [EmptyCollection β] [Insert α β] [Singleton α β] :
Prop where
/-- `insert x ∅ = {x}` -/
insert_emptyc_eq (x : α) : (insert x : β) = singleton x
export IsLawfulSingleton (insert_emptyc_eq)
/-- Type class used to implement the notation `{ a ∈ c | p a }` -/
class Sep (α : outParam <| Type u) (γ : Type v) where
/-- Computes `{ a ∈ c | p a }`. -/
sep : (α Prop) γ γ
/--
`Task α` is a primitive for asynchronous computation.
It represents a computation that will resolve to a value of type `α`,
@@ -411,9 +537,10 @@ set_option linter.unusedVariables.funArgs false in
be available and then calls `f` on the result.
`prio`, if provided, is the priority of the task.
If `sync` is set to true, `f` is executed on the current thread if `x` has already finished.
-/
@[noinline, extern "lean_task_map"]
protected def map {α : Type u} {β : Type v} (f : α β) (x : Task α) (prio := Priority.default) : Task β :=
protected def map (f : α β) (x : Task α) (prio := Priority.default) (sync := false) : Task β :=
f x.get
set_option linter.unusedVariables.funArgs false in
@@ -424,9 +551,11 @@ for the value of `x` to be available and then calls `f` on the result,
resulting in a new task which is then run for a result.
`prio`, if provided, is the priority of the task.
If `sync` is set to true, `f` is executed on the current thread if `x` has already finished.
-/
@[noinline, extern "lean_task_bind"]
protected def bind {α : Type u} {β : Type v} (x : Task α) (f : α Task β) (prio := Priority.default) : Task β :=
protected def bind (x : Task α) (f : α Task β) (prio := Priority.default) (sync := false) :
Task β :=
(f x.get).get
end Task
@@ -522,9 +651,7 @@ theorem not_not_intro {p : Prop} (h : p) : ¬ ¬ p :=
fun hn : ¬ p => hn h
-- proof irrelevance is built in
theorem proofIrrel {a : Prop} (h₁ h₂ : a) : h₁ = h₂ := rfl
theorem id.def {α : Sort u} (a : α) : id a = a := rfl
theorem proof_irrel {a : Prop} (h₁ h₂ : a) : h₁ = h₂ := rfl
/--
If `h : α = β` is a proof of type equality, then `h.mp : α → β` is the induced
@@ -572,8 +699,9 @@ theorem Ne.elim (h : a ≠ b) : a = b → False := h
theorem Ne.irrefl (h : a a) : False := h rfl
theorem Ne.symm (h : a b) : b a :=
fun h₁ => h (h₁.symm)
theorem Ne.symm (h : a b) : b a := fun h₁ => h (h₁.symm)
theorem ne_comm {α} {a b : α} : a b b a := Ne.symm, Ne.symm
theorem false_of_ne : a a False := Ne.irrefl
@@ -585,8 +713,8 @@ theorem ne_true_of_not : ¬p → p ≠ True :=
have : ¬True := h hnp
this trivial
theorem true_ne_false : ¬True = False :=
ne_false_of_self trivial
theorem true_ne_false : ¬True = False := ne_false_of_self trivial
theorem false_ne_true : False True := fun h => h.symm trivial
end Ne
@@ -663,22 +791,31 @@ theorem Iff.refl (a : Prop) : a ↔ a :=
protected theorem Iff.rfl {a : Prop} : a a :=
Iff.refl a
macro_rules | `(tactic| rfl) => `(tactic| exact Iff.rfl)
theorem Iff.of_eq (h : a = b) : a b := h Iff.rfl
theorem Iff.trans (h₁ : a b) (h₂ : b c) : a c :=
Iff.intro
(fun ha => Iff.mp h₂ (Iff.mp h₁ ha))
(fun hc => Iff.mpr h₁ (Iff.mpr h₂ hc))
Iff.intro (h₂.mp h₁.mp) (h₁.mpr h₂.mpr)
theorem Iff.symm (h : a b) : b a :=
Iff.intro (Iff.mpr h) (Iff.mp h)
-- This is needed for `calc` to work with `iff`.
instance : Trans Iff Iff Iff where
trans := Iff.trans
theorem Iff.comm : (a b) (b a) :=
Iff.intro Iff.symm Iff.symm
theorem Eq.comm {a b : α} : a = b b = a := Iff.intro Eq.symm Eq.symm
theorem eq_comm {a b : α} : a = b b = a := Eq.comm
theorem Iff.of_eq (h : a = b) : a b :=
h Iff.refl _
theorem Iff.symm (h : a b) : b a := Iff.intro h.mpr h.mp
theorem Iff.comm: (a b) (b a) := Iff.intro Iff.symm Iff.symm
theorem iff_comm : (a b) (b a) := Iff.comm
theorem And.comm : a b b a := by
constructor <;> intro h₁, h₂ <;> exact h₂, h₁
theorem And.symm : a b b a := fun ha, hb => hb, ha
theorem And.comm : a b b a := Iff.intro And.symm And.symm
theorem and_comm : a b b a := And.comm
theorem Or.symm : a b b a := .rec .inr .inl
theorem Or.comm : a b b a := Iff.intro Or.symm Or.symm
theorem or_comm : a b b a := Or.comm
/-! # Exists -/
@@ -878,8 +1015,13 @@ protected theorem Subsingleton.helim {α β : Sort u} [h₁ : Subsingleton α] (
apply heq_of_eq
apply Subsingleton.elim
instance (p : Prop) : Subsingleton p :=
fun a b => proofIrrel a b
instance (p : Prop) : Subsingleton p := fun a b => proof_irrel a b
instance : Subsingleton Empty := (·.elim)
instance : Subsingleton PEmpty := (·.elim)
instance [Subsingleton α] [Subsingleton β] : Subsingleton (α × β) :=
fun {..} {..} => by congr <;> apply Subsingleton.elim
instance (p : Prop) : Subsingleton (Decidable p) :=
Subsingleton.intro fun
@@ -890,6 +1032,9 @@ instance (p : Prop) : Subsingleton (Decidable p) :=
| isTrue t₂ => absurd t₂ f₁
| isFalse _ => rfl
example [Subsingleton α] (p : α Prop) : Subsingleton (Subtype p) :=
fun x, _ y, _ => by congr; exact Subsingleton.elim x y
theorem recSubsingleton
{p : Prop} [h : Decidable p]
{h₁ : p Sort u}
@@ -1169,12 +1314,117 @@ gen_injective_theorems% Lean.Syntax
@[simp] theorem beq_iff_eq [BEq α] [LawfulBEq α] (a b : α) : a == b a = b :=
eq_of_beq, by intro h; subst h; exact LawfulBEq.rfl
/-! # Quotients -/
/-! # Prop lemmas -/
/-- *Ex falso* for negation: from `¬a` and `a` anything follows. This is the same as `absurd` with
the arguments flipped, but it is in the `Not` namespace so that projection notation can be used. -/
def Not.elim {α : Sort _} (H1 : ¬a) (H2 : a) : α := absurd H2 H1
/-- Non-dependent eliminator for `And`. -/
abbrev And.elim (f : a b α) (h : a b) : α := f h.left h.right
/-- Non-dependent eliminator for `Iff`. -/
def Iff.elim (f : (a b) (b a) α) (h : a b) : α := f h.mp h.mpr
/-- Iff can now be used to do substitutions in a calculation -/
theorem Iff.subst {a b : Prop} {p : Prop Prop} (h₁ : a b) (h₂ : p a) : p b :=
Eq.subst (propext h₁) h₂
theorem Not.intro {a : Prop} (h : a False) : ¬a := h
theorem Not.imp {a b : Prop} (H2 : ¬b) (H1 : a b) : ¬a := mt H1 H2
theorem not_congr (h : a b) : ¬a ¬b := mt h.2, mt h.1
theorem not_not_not : ¬¬¬a ¬a := mt not_not_intro, not_not_intro
theorem iff_of_true (ha : a) (hb : b) : a b := Iff.intro (fun _ => hb) (fun _ => ha)
theorem iff_of_false (ha : ¬a) (hb : ¬b) : a b := Iff.intro ha.elim hb.elim
theorem iff_true_left (ha : a) : (a b) b := Iff.intro (·.mp ha) (iff_of_true ha)
theorem iff_true_right (ha : a) : (b a) b := Iff.comm.trans (iff_true_left ha)
theorem iff_false_left (ha : ¬a) : (a b) ¬b := Iff.intro (mt ·.mpr ha) (iff_of_false ha)
theorem iff_false_right (ha : ¬a) : (b a) ¬b := Iff.comm.trans (iff_false_left ha)
theorem of_iff_true (h : a True) : a := h.mpr trivial
theorem iff_true_intro (h : a) : a True := iff_of_true h trivial
theorem not_of_iff_false : (p False) ¬p := Iff.mp
theorem iff_false_intro (h : ¬a) : a False := iff_of_false h id
theorem not_iff_false_intro (h : a) : ¬a False := iff_false_intro (not_not_intro h)
theorem not_true : (¬True) False := iff_false_intro (not_not_intro trivial)
theorem not_false_iff : (¬False) True := iff_true_intro not_false
theorem Eq.to_iff : a = b (a b) := Iff.of_eq
theorem iff_of_eq : a = b (a b) := Iff.of_eq
theorem neq_of_not_iff : ¬(a b) a b := mt Iff.of_eq
theorem iff_iff_eq : (a b) a = b := Iff.intro propext Iff.of_eq
@[simp] theorem eq_iff_iff : (a = b) (a b) := iff_iff_eq.symm
theorem eq_self_iff_true (a : α) : a = a True := iff_true_intro rfl
theorem ne_self_iff_false (a : α) : a a False := not_iff_false_intro rfl
theorem false_of_true_iff_false (h : True False) : False := h.mp trivial
theorem false_of_true_eq_false (h : True = False) : False := false_of_true_iff_false (Iff.of_eq h)
theorem true_eq_false_of_false : False (True = False) := False.elim
theorem iff_def : (a b) (a b) (b a) := iff_iff_implies_and_implies a b
theorem iff_def' : (a b) (b a) (a b) := Iff.trans iff_def And.comm
theorem true_iff_false : (True False) False := iff_false_intro (·.mp True.intro)
theorem false_iff_true : (False True) False := iff_false_intro (·.mpr True.intro)
theorem iff_not_self : ¬(a ¬a) | H => let f h := H.1 h h; f (H.2 f)
theorem heq_self_iff_true (a : α) : HEq a a True := iff_true_intro HEq.rfl
/-! ## implies -/
theorem not_not_of_not_imp : ¬(a b) ¬¬a := mt Not.elim
theorem not_of_not_imp {a : Prop} : ¬(a b) ¬b := mt fun h _ => h
@[simp] theorem imp_not_self : (a ¬a) ¬a := Iff.intro (fun h ha => h ha ha) (fun h _ => h)
theorem imp_intro {α β : Prop} (h : α) : β α := fun _ => h
theorem imp_imp_imp {a b c d : Prop} (h₀ : c a) (h₁ : b d) : (a b) (c d) := (h₁ · h₀)
theorem imp_iff_right {a : Prop} (ha : a) : (a b) b := Iff.intro (· ha) (fun a _ => a)
-- This is not marked `@[simp]` because we have `implies_true : (α → True) = True`
theorem imp_true_iff (α : Sort u) : (α True) True := iff_true_intro (fun _ => trivial)
theorem false_imp_iff (a : Prop) : (False a) True := iff_true_intro False.elim
theorem true_imp_iff (α : Prop) : (True α) α := imp_iff_right True.intro
@[simp] theorem imp_self : (a a) True := iff_true_intro id
theorem imp_false : (a False) ¬a := Iff.rfl
theorem imp.swap : (a b c) (b a c) := Iff.intro flip flip
theorem imp_not_comm : (a ¬b) (b ¬a) := imp.swap
theorem imp_congr_left (h : a b) : (a c) (b c) := Iff.intro (· h.mpr) (· h.mp)
theorem imp_congr_right (h : a (b c)) : (a b) (a c) :=
Iff.intro (fun hab ha => (h ha).mp (hab ha)) (fun hcd ha => (h ha).mpr (hcd ha))
theorem imp_congr_ctx (h₁ : a c) (h₂ : c (b d)) : (a b) (c d) :=
Iff.trans (imp_congr_left h₁) (imp_congr_right h₂)
theorem imp_congr (h₁ : a c) (h₂ : b d) : (a b) (c d) := imp_congr_ctx h₁ fun _ => h₂
theorem imp_iff_not (hb : ¬b) : a b ¬a := imp_congr_right fun _ => iff_false_intro hb
/-! # Quotients -/
namespace Quot
/--
The **quotient axiom**, or at least the nontrivial part of the quotient
@@ -1680,40 +1930,92 @@ So, you are mainly losing the capability of type checking your development using
-/
axiom ofReduceNat (a b : Nat) (h : reduceNat a = b) : a = b
end Lean
namespace Std
variable {α : Sort u}
/--
`IsAssociative op` says that `op` is an associative operation,
i.e. `(a ∘ b) ∘ c = a ∘ (b ∘ c)`. It is used by the `ac_rfl` tactic.
`Associative op` indicates `op` is an associative operation,
i.e. `(a ∘ b) ∘ c = a ∘ (b ∘ c)`.
-/
class IsAssociative {α : Sort u} (op : α α α) where
class Associative (op : α α α) : Prop where
/-- An associative operation satisfies `(a ∘ b) ∘ c = a ∘ (b ∘ c)`. -/
assoc : (a b c : α) op (op a b) c = op a (op b c)
/--
`IsCommutative op` says that `op` is a commutative operation,
i.e. `a ∘ b = b ∘ a`. It is used by the `ac_rfl` tactic.
`Commutative op` says that `op` is a commutative operation,
i.e. `a ∘ b = b ∘ a`.
-/
class IsCommutative {α : Sort u} (op : α α α) where
class Commutative (op : α α α) : Prop where
/-- A commutative operation satisfies `a ∘ b = b ∘ a`. -/
comm : (a b : α) op a b = op b a
/--
`IsIdempotent op` says that `op` is an idempotent operation,
i.e. `a ∘ a = a`. It is used by the `ac_rfl` tactic
(which also simplifies up to idempotence when available).
`IdempotentOp op` indicates `op` is an idempotent binary operation.
i.e. `a ∘ a = a`.
-/
class IsIdempotent {α : Sort u} (op : α α α) where
class IdempotentOp (op : α α α) : Prop where
/-- An idempotent operation satisfies `a ∘ a = a`. -/
idempotent : (x : α) op x x = x
/--
`IsNeutral op e` says that `e` is a neutral operation for `op`,
i.e. `a ∘ e = a = e ∘ a`. It is used by the `ac_rfl` tactic
(which also simplifies neutral elements when available).
-/
class IsNeutral {α : Sort u} (op : α α α) (neutral : α) where
/-- A neutral element can be cancelled on the left: `e ∘ a = a`. -/
left_neutral : (a : α) op neutral a = a
/-- A neutral element can be cancelled on the right: `a ∘ e = a`. -/
right_neutral : (a : α) op a neutral = a
`LeftIdentify op o` indicates `o` is a left identity of `op`.
end Lean
This class does not require a proof that `o` is an identity, and
is used primarily for infering the identity using class resoluton.
-/
class LeftIdentity (op : α β β) (o : outParam α) : Prop
/--
`LawfulLeftIdentify op o` indicates `o` is a verified left identity of
`op`.
-/
class LawfulLeftIdentity (op : α β β) (o : outParam α) extends LeftIdentity op o : Prop where
/-- Left identity `o` is an identity. -/
left_id : a, op o a = a
/--
`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.
-/
class RightIdentity (op : α β α) (o : outParam β) : Prop
/--
`LawfulRightIdentify op o` indicates `o` is a verified right identity of
`op`.
-/
class LawfulRightIdentity (op : α β α) (o : outParam β) extends RightIdentity op o : Prop where
/-- Right identity `o` is an identity. -/
right_id : a, op a o = a
/--
`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.
-/
class Identity (op : α α α) (o : outParam α) extends LeftIdentity op o, RightIdentity op o : Prop
/--
`LawfulIdentity op o` indicates `o` is a verified left and right
identity of `op`.
-/
class LawfulIdentity (op : α α α) (o : outParam α) extends Identity op o, LawfulLeftIdentity op o, LawfulRightIdentity op o : Prop
/--
`LawfulCommIdentity` can simplify defining instances of `LawfulIdentity`
on commutative functions by requiring only a left or right identity
proof.
This class is intended for simplifying defining instances of
`LawfulIdentity` and functions needed commutative operations with
identity should just add a `LawfulIdentity` constraint.
-/
class LawfulCommIdentity (op : α α α) (o : outParam α) [hc : Commutative op] extends LawfulIdentity op o : Prop where
left_id a := Eq.trans (hc.comm o a) (right_id a)
right_id a := Eq.trans (hc.comm a o) (left_id a)
end Std

View File

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.Data.Basic
import Init.Data.Nat
import Init.Data.Cast
import Init.Data.Char
import Init.Data.String
import Init.Data.List

View File

@@ -14,15 +14,17 @@ inductive Expr
| op (lhs rhs : Expr)
deriving Inhabited, Repr, BEq
open Std
structure Variable {α : Sort u} (op : α α α) : Type u where
value : α
neutral : Option $ IsNeutral op value
neutral : Option $ PLift (LawfulIdentity op value)
structure Context (α : Sort u) where
op : α α α
assoc : IsAssociative op
comm : Option $ IsCommutative op
idem : Option $ IsIdempotent op
assoc : Associative op
comm : Option $ PLift $ Commutative op
idem : Option $ PLift $ IdempotentOp op
vars : List (Variable op)
arbitrary : α
@@ -128,7 +130,14 @@ theorem Context.mergeIdem_head2 (h : x ≠ y) : mergeIdem (x :: y :: ys) = x ::
simp [mergeIdem, mergeIdem.loop, h]
theorem Context.evalList_mergeIdem (ctx : Context α) (h : ContextInformation.isIdem ctx) (e : List Nat) : evalList α ctx (mergeIdem e) = evalList α ctx e := by
have h : IsIdempotent ctx.op := by simp [ContextInformation.isIdem, Option.isSome] at h; cases h₂ : ctx.idem <;> simp [h₂] at h; assumption
have h : IdempotentOp ctx.op := by
simp [ContextInformation.isIdem, Option.isSome] at h;
match h₂ : ctx.idem with
| none =>
simp [h₂] at h
| some val =>
simp [h₂] at h
exact val.down
induction e using List.two_step_induction with
| empty => rfl
| single => rfl
@@ -141,18 +150,18 @@ theorem Context.evalList_mergeIdem (ctx : Context α) (h : ContextInformation.is
rfl
| cons z zs =>
by_cases h₂ : x = y
case inl =>
case pos =>
rw [h₂, mergeIdem_head, ih]
simp [evalList, ctx.assoc.1, h.1, EvalInformation.evalOp]
case inr =>
case neg =>
rw [mergeIdem_head2]
by_cases h₃ : y = z
case inl =>
case pos =>
simp [mergeIdem_head, h₃, evalList]
cases h₄ : mergeIdem (z :: zs) with
| nil => apply absurd h₄; apply mergeIdem_nonEmpty; simp
| cons u us => simp_all [mergeIdem, mergeIdem.loop, evalList]
case inr =>
case neg =>
simp [mergeIdem_head2, h₃, evalList] at *
rw [ih]
assumption
@@ -169,7 +178,7 @@ theorem Context.sort_loop_nonEmpty (xs : List Nat) (h : xs ≠ []) : sort.loop x
theorem Context.evalList_insert
(ctx : Context α)
(h : IsCommutative ctx.op)
(h : Commutative ctx.op)
(x : Nat)
(xs : List Nat)
: evalList α ctx (insert x xs) = evalList α ctx (x::xs) := by
@@ -190,7 +199,7 @@ theorem Context.evalList_insert
theorem Context.evalList_sort_congr
(ctx : Context α)
(h : IsCommutative ctx.op)
(h : Commutative ctx.op)
(h₂ : evalList α ctx a = evalList α ctx b)
(h₃ : a [])
(h₄ : b [])
@@ -209,7 +218,7 @@ theorem Context.evalList_sort_congr
theorem Context.evalList_sort_loop_swap
(ctx : Context α)
(h : IsCommutative ctx.op)
(h : Commutative ctx.op)
(xs ys : List Nat)
: evalList α ctx (sort.loop xs (y::ys)) = evalList α ctx (sort.loop (y::xs) ys) := by
induction ys generalizing y xs with
@@ -224,7 +233,7 @@ theorem Context.evalList_sort_loop_swap
theorem Context.evalList_sort_cons
(ctx : Context α)
(h : IsCommutative ctx.op)
(h : Commutative ctx.op)
(x : Nat)
(xs : List Nat)
: evalList α ctx (sort (x :: xs)) = evalList α ctx (x :: sort xs) := by
@@ -247,7 +256,14 @@ theorem Context.evalList_sort_cons
all_goals simp [insert_nonEmpty]
theorem Context.evalList_sort (ctx : Context α) (h : ContextInformation.isComm ctx) (e : List Nat) : evalList α ctx (sort e) = evalList α ctx e := by
have h : IsCommutative ctx.op := by simp [ContextInformation.isComm, Option.isSome] at h; cases h₂ : ctx.comm <;> simp [h₂] at h; assumption
have h : Commutative ctx.op := by
simp [ContextInformation.isComm, Option.isSome] at h
match h₂ : ctx.comm with
| none =>
simp only [h₂] at h
| some val =>
simp [h₂] at h
exact val.down
induction e using List.two_step_induction with
| empty => rfl
| single => rfl
@@ -269,10 +285,12 @@ theorem Context.toList_nonEmpty (e : Expr) : e.toList ≠ [] := by
theorem Context.unwrap_isNeutral
{ctx : Context α}
{x : Nat}
: ContextInformation.isNeutral ctx x = true IsNeutral (EvalInformation.evalOp ctx) (EvalInformation.evalVar (β := α) ctx x) := by
: ContextInformation.isNeutral ctx x = true LawfulIdentity (EvalInformation.evalOp ctx) (EvalInformation.evalVar (β := α) ctx x) := by
simp [ContextInformation.isNeutral, Option.isSome, EvalInformation.evalOp, EvalInformation.evalVar]
match (var ctx x).neutral with
| some hn => intro; assumption
| some hn =>
intro
exact hn.down
| none => intro; contradiction
theorem Context.evalList_removeNeutrals (ctx : Context α) (e : List Nat) : evalList α ctx (removeNeutrals ctx e) = evalList α ctx e := by
@@ -283,10 +301,12 @@ theorem Context.evalList_removeNeutrals (ctx : Context α) (e : List Nat) : eval
case h_1 => rfl
case h_2 h => split at h <;> simp_all
| step x y ys ih =>
cases h₁ : ContextInformation.isNeutral ctx x <;> cases h₂ : ContextInformation.isNeutral ctx y <;> cases h₃ : removeNeutrals.loop ctx ys
cases h₁ : ContextInformation.isNeutral ctx x <;>
cases h₂ : ContextInformation.isNeutral ctx y <;>
cases h₃ : removeNeutrals.loop ctx ys
<;> simp [removeNeutrals, removeNeutrals.loop, h₁, h₂, h₃, evalList, ih]
<;> (try simp [unwrap_isNeutral h₂ |>.2])
<;> (try simp [unwrap_isNeutral h₁ |>.1])
<;> (try simp [unwrap_isNeutral h₂ |>.right_id])
<;> (try simp [unwrap_isNeutral h₁ |>.left_id])
theorem Context.evalList_append
(ctx : Context α)

View File

@@ -11,3 +11,4 @@ import Init.Data.Array.InsertionSort
import Init.Data.Array.DecidableEq
import Init.Data.Array.Mem
import Init.Data.Array.BasicAux
import Init.Data.Array.Lemmas

View File

@@ -21,6 +21,21 @@ def mkArray {α : Type u} (n : Nat) (v : α) : Array α := {
data := List.replicate n v
}
/--
`ofFn f` with `f : Fin n → α` returns the list whose ith element is `f i`.
```
ofFn f = #[f 0, f 1, ... , f(n - 1)]
``` -/
def ofFn {n} (f : Fin n α) : Array α := go 0 (mkEmpty n) where
/-- Auxiliary for `ofFn`. `ofFn.go f i acc = acc ++ #[f i, ..., f(n - 1)]` -/
go (i : Nat) (acc : Array α) : Array α :=
if h : i < n then go (i+1) (acc.push (f i, h)) else acc
termination_by n - i
/-- The array `#[0, 1, ..., n - 1]`. -/
def range (n : Nat) : Array Nat :=
n.fold (flip Array.push) (mkEmpty n)
@[simp] theorem size_mkArray (n : Nat) (v : α) : (mkArray n v).size = n :=
List.length_replicate ..
@@ -71,6 +86,12 @@ abbrev getLit {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size =
def uset (a : Array α) (i : USize) (v : α) (h : i.toNat < a.size) : Array α :=
a.set i.toNat, h v
/--
Swaps two entries in an array.
This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[extern "lean_array_fswap"]
def swap (a : Array α) (i j : @& Fin a.size) : Array α :=
let v₁ := a.get i
@@ -78,12 +99,18 @@ def swap (a : Array α) (i j : @& Fin a.size) : Array α :=
let a' := a.set i v₂
a'.set (size_set a i v₂ j) v₁
/--
Swaps two entries in an array, or panics if either index is out of bounds.
This will perform the update destructively provided that `a` has a reference
count of 1 when called.
-/
@[extern "lean_array_swap"]
def swap! (a : Array α) (i j : @& Nat) : Array α :=
if h₁ : i < a.size then
if h₂ : j < a.size then swap a i, h₁ j, h₂
else panic! "index out of bounds"
else panic! "index out of bounds"
else a
else a
@[inline] def swapAt (a : Array α) (i : Fin a.size) (v : α) : α × Array α :=
let e := a.get i
@@ -276,8 +303,8 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
map (i+1) (r.push ( f as[i]))
else
pure r
termination_by as.size - i
map 0 (mkEmpty as.size)
termination_by map => as.size - i
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (as : Array α) (f : Fin as.size α m β) : m (Array β) :=
@@ -348,12 +375,12 @@ def anyM {α : Type u} {m : Type → Type w} [Monad m] (p : α → m Bool) (as :
loop (j+1)
else
pure false
termination_by stop - j
loop start
if h : stop as.size then
any stop h
else
any as.size (Nat.le_refl _)
termination_by loop i j => stop - j
@[inline]
def allM {α : Type u} {m : Type Type w} [Monad m] (p : α m Bool) (as : Array α) (start := 0) (stop := as.size) : m Bool :=
@@ -401,6 +428,10 @@ def map {α : Type u} {β : Type v} (f : α → β) (as : Array α) : Array β :
def mapIdx {α : Type u} {β : Type v} (as : Array α) (f : Fin as.size α β) : Array β :=
Id.run <| as.mapIdxM f
/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/
def zipWithIndex (arr : Array α) : Array (α × Nat) :=
arr.mapIdx fun i a => (a, i)
@[inline]
def find? {α : Type} (as : Array α) (p : α Bool) : Option α :=
Id.run <| as.findM? p
@@ -475,6 +506,11 @@ def elem [BEq α] (a : α) (as : Array α) : Bool :=
def toList (as : Array α) : List α :=
as.foldr List.cons []
/-- Prepends an `Array α` onto the front of a list. Equivalent to `as.toList ++ l`. -/
@[inline]
def toListAppend (as : Array α) (l : List α) : List α :=
as.foldr List.cons l
instance {α : Type u} [Repr α] : Repr (Array α) where
reprPrec a _ :=
let _ : Std.ToFormat α := repr
@@ -504,6 +540,13 @@ def concatMapM [Monad m] (f : α → m (Array β)) (as : Array α) : m (Array β
def concatMap (f : α Array β) (as : Array α) : Array β :=
as.foldl (init := empty) fun bs a => bs ++ f a
/-- Joins array of array into a single array.
`flatten #[#[a₁, a₂, ⋯], #[b₁, b₂, ⋯], ⋯]` = `#[a₁, a₂, ⋯, b₁, b₂, ⋯]`
-/
def flatten (as : Array (Array α)) : Array α :=
as.foldl (init := empty) fun r a => r ++ a
end Array
export Array (mkArray)
@@ -523,7 +566,7 @@ def isEqvAux (a b : Array α) (hsz : a.size = b.size) (p : αα → Bool) (
p a[i] b[i] && isEqvAux a b hsz p (i+1)
else
true
termination_by _ => a.size - i
termination_by a.size - i
@[inline] def isEqv (a b : Array α) (p : α α Bool) : Bool :=
if h : a.size = b.size then
@@ -627,7 +670,7 @@ def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size)
if a.get idx == v then some idx
else indexOfAux a v (i+1)
else none
termination_by _ => a.size - i
termination_by a.size - i
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
indexOfAux a v 0
@@ -659,7 +702,7 @@ where
loop as (i+1) j-1, this
else
as
termination_by _ => j - i
termination_by j - i
def popWhile (p : α Bool) (as : Array α) : Array α :=
if h : as.size > 0 then
@@ -669,7 +712,7 @@ def popWhile (p : α → Bool) (as : Array α) : Array α :=
as
else
as
termination_by popWhile as => as.size
termination_by as.size
def takeWhile (p : α Bool) (as : Array α) : Array α :=
let rec go (i : Nat) (r : Array α) : Array α :=
@@ -681,8 +724,8 @@ def takeWhile (p : α → Bool) (as : Array α) : Array α :=
r
else
r
termination_by as.size - i
go 0 #[]
termination_by go i r => as.size - i
def eraseIdxAux (i : Nat) (a : Array α) : Array α :=
if h : i < a.size then
@@ -692,7 +735,7 @@ def eraseIdxAux (i : Nat) (a : Array α) : Array α :=
eraseIdxAux (i+1) a'
else
a.pop
termination_by _ => a.size - i
termination_by a.size - i
def feraseIdx (a : Array α) (i : Fin a.size) : Array α :=
eraseIdxAux (i.val + 1) a
@@ -707,7 +750,7 @@ def eraseIdxSzAux (a : Array α) (i : Nat) (r : Array α) (heq : r.size = a.size
eraseIdxSzAux a (i+1) (r.swap idx idx1) ((size_swap r idx idx1).trans heq)
else
r.pop, (size_pop r).trans (heq rfl)
termination_by _ => r.size - i
termination_by r.size - i
def eraseIdx' (a : Array α) (i : Fin a.size) : { r : Array α // r.size = a.size - 1 } :=
eraseIdxSzAux a (i.val + 1) a rfl
@@ -726,10 +769,10 @@ def erase [BEq α] (as : Array α) (a : α) : Array α :=
loop as j', by rw [size_swap]; exact j'.2
else
as
termination_by j.1
let j := as.size
let as := as.push a
loop as j, size_push .. j.lt_succ_self
termination_by loop j => j.1
/-- Insert element `a` at position `i`. Panics if `i` is not `i ≤ as.size`. -/
def insertAt! (as : Array α) (i : Nat) (a : α) : Array α :=
@@ -779,7 +822,7 @@ def isPrefixOfAux [BEq α] (as bs : Array α) (hle : as.size ≤ bs.size) (i : N
false
else
true
termination_by _ => as.size - i
termination_by as.size - i
/-- Return true iff `as` is a prefix of `bs`.
That is, `bs = as ++ t` for some `t : List α`.-/
@@ -800,7 +843,7 @@ private def allDiffAux [BEq α] (as : Array α) (i : Nat) : Bool :=
allDiffAuxAux as as[i] i h && allDiffAux as (i+1)
else
true
termination_by _ => as.size - i
termination_by as.size - i
def allDiff [BEq α] (as : Array α) : Bool :=
allDiffAux as 0
@@ -815,7 +858,7 @@ def allDiff [BEq α] (as : Array α) : Bool :=
cs
else
cs
termination_by _ => as.size - i
termination_by as.size - i
@[inline] def zipWith (as : Array α) (bs : Array β) (f : α β γ) : Array γ :=
zipWithAux f as bs 0 #[]

View File

@@ -47,7 +47,7 @@ where
have hlt : i < as.size := Nat.lt_of_le_of_ne hle h
let b f as[i]
go (i+1) acc.val.push b, by simp [acc.property] hlt
termination_by go i _ _ => as.size - i
termination_by as.size - i
@[inline] private unsafe def mapMonoMImp [Monad m] (as : Array α) (f : α m α) : m (Array α) :=
go 0 as

View File

@@ -5,7 +5,7 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Array.Basic
import Init.Classical
import Init.ByCases
namespace Array
@@ -20,7 +20,7 @@ theorem eq_of_isEqvAux [DecidableEq α] (a b : Array α) (hsz : a.size = b.size)
· have heq : i = a.size := Nat.le_antisymm hi (Nat.ge_of_not_lt h)
subst heq
exact absurd (Nat.lt_of_lt_of_le high low) (Nat.lt_irrefl j)
termination_by _ => a.size - i
termination_by a.size - i
theorem eq_of_isEqv [DecidableEq α] (a b : Array α) : Array.isEqv a b (fun x y => x = y) a = b := by
simp [Array.isEqv]
@@ -36,7 +36,7 @@ theorem isEqvAux_self [DecidableEq α] (a : Array α) (i : Nat) : Array.isEqvAux
split
case inl h => simp [h, isEqvAux_self a (i+1)]
case inr h => simp [h]
termination_by _ => a.size - i
termination_by a.size - i
theorem isEqv_self [DecidableEq α] (a : Array α) : Array.isEqv a a (fun x y => x = y) = true := by
simp [isEqv, isEqvAux_self]

View File

@@ -0,0 +1,187 @@
/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
prelude
import Init.Data.Nat
import Init.Data.List.Lemmas
import Init.Data.Fin.Basic
import Init.Data.Array.Mem
/-!
## Bootstrapping theorems about arrays
This file contains some theorems about `Array` and `List` needed for `Std.List.Basic`.
-/
namespace Array
attribute [simp] data_toArray uset
@[simp] theorem mkEmpty_eq (α n) : @mkEmpty α n = #[] := rfl
@[simp] theorem size_toArray (as : List α) : as.toArray.size = as.length := by simp [size]
@[simp] theorem size_mk (as : List α) : (Array.mk as).size = as.length := by simp [size]
theorem getElem_eq_data_get (a : Array α) (h : i < a.size) : a[i] = a.data.get i, h := by
by_cases i < a.size <;> (try simp [*]) <;> rfl
theorem foldlM_eq_foldlM_data.aux [Monad m]
(f : β α m β) (arr : Array α) (i j) (H : arr.size i + j) (b) :
foldlM.loop f arr arr.size (Nat.le_refl _) i j b = (arr.data.drop j).foldlM f b := by
unfold foldlM.loop
split; split
· cases Nat.not_le_of_gt _ (Nat.zero_add _ H)
· rename_i i; rw [Nat.succ_add] at H
simp [foldlM_eq_foldlM_data.aux f arr i (j+1) H]
rw (config := {occs := .pos [2]}) [ List.get_drop_eq_drop _ _ _]
rfl
· rw [List.drop_length_le (Nat.ge_of_not_lt _)]; rfl
theorem foldlM_eq_foldlM_data [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
arr.foldlM f init = arr.data.foldlM f init := by
simp [foldlM, foldlM_eq_foldlM_data.aux]
theorem foldl_eq_foldl_data (f : β α β) (init : β) (arr : Array α) :
arr.foldl f init = arr.data.foldl f init :=
List.foldl_eq_foldlM .. foldlM_eq_foldlM_data ..
theorem foldrM_eq_reverse_foldlM_data.aux [Monad m]
(f : α β m β) (arr : Array α) (init : β) (i h) :
(arr.data.take i).reverse.foldlM (fun x y => f y x) init = foldrM.fold f arr 0 i h init := by
unfold foldrM.fold
match i with
| 0 => simp [List.foldlM, List.take]
| i+1 => rw [ List.take_concat_get _ _ h]; simp [ (aux f arr · i)]; rfl
theorem foldrM_eq_reverse_foldlM_data [Monad m] (f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.data.reverse.foldlM (fun x y => f y x) init := by
have : arr = #[] 0 < arr.size :=
match arr with | [] => .inl rfl | a::l => .inr (Nat.zero_lt_succ _)
match arr, this with | _, .inl rfl => rfl | arr, .inr h => ?_
simp [foldrM, h, foldrM_eq_reverse_foldlM_data.aux, List.take_length]
theorem foldrM_eq_foldrM_data [Monad m]
(f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.data.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_data, List.foldlM_reverse]
theorem foldr_eq_foldr_data (f : α β β) (init : β) (arr : Array α) :
arr.foldr f init = arr.data.foldr f init :=
List.foldr_eq_foldrM .. foldrM_eq_foldrM_data ..
@[simp] theorem push_data (arr : Array α) (a : α) : (arr.push a).data = arr.data ++ [a] := by
simp [push, List.concat_eq_append]
theorem foldrM_push [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
simp [foldrM_eq_reverse_foldlM_data, -size_push]
@[simp] theorem foldrM_push' [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init (start := arr.size + 1) = f a init >>= arr.foldrM f := by
simp [ foldrM_push]
theorem foldr_push (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init = arr.foldr f (f a init) := foldrM_push ..
@[simp] theorem foldr_push' (f : α β β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldr f init (start := arr.size + 1) = arr.foldr f (f a init) := foldrM_push' ..
@[simp] theorem toListAppend_eq (arr : Array α) (l) : arr.toListAppend l = arr.data ++ l := by
simp [toListAppend, foldr_eq_foldr_data]
@[simp] theorem toList_eq (arr : Array α) : arr.toList = arr.data := by
simp [toList, foldr_eq_foldr_data]
/-- A more efficient version of `arr.toList.reverse`. -/
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.data.reverse := by
rw [toListRev, foldl_eq_foldl_data, List.foldr_reverse, List.foldr_self]
theorem get_push_lt (a : Array α) (x : α) (i : Nat) (h : i < a.size) :
have : i < (a.push x).size := by simp [*, Nat.lt_succ_of_le, Nat.le_of_lt]
(a.push x)[i] = a[i] := by
simp only [push, getElem_eq_data_get, List.concat_eq_append, List.get_append_left, h]
@[simp] theorem get_push_eq (a : Array α) (x : α) : (a.push x)[a.size] = x := by
simp only [push, getElem_eq_data_get, List.concat_eq_append]
rw [List.get_append_right] <;> simp [getElem_eq_data_get, Nat.zero_lt_one]
theorem get_push (a : Array α) (x : α) (i : Nat) (h : i < (a.push x).size) :
(a.push x)[i] = if h : i < a.size then a[i] else x := by
by_cases h' : i < a.size
· simp [get_push_lt, h']
· simp at h
simp [get_push_lt, Nat.le_antisymm (Nat.le_of_lt_succ h) (Nat.ge_of_not_lt h')]
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
rw [mapM, aux, foldlM_eq_foldlM_data]; rfl
where
aux (i r) :
mapM.map f arr i r = (arr.data.drop i).foldlM (fun bs a => bs.push <$> f a) r := by
unfold mapM.map; split
· rw [ List.get_drop_eq_drop _ i _]
simp [aux (i+1), map_eq_pure_bind]; rfl
· rw [List.drop_length_le (Nat.ge_of_not_lt _)]; rfl
termination_by arr.size - i
@[simp] theorem map_data (f : α β) (arr : Array α) : (arr.map f).data = arr.data.map f := by
rw [map, mapM_eq_foldlM]
apply congrArg data (foldl_eq_foldl_data (fun bs a => push bs (f a)) #[] arr) |>.trans
have H (l arr) : List.foldl (fun bs a => push bs (f a)) arr l = arr.data ++ l.map f := by
induction l generalizing arr <;> simp [*]
simp [H]
@[simp] theorem size_map (f : α β) (arr : Array α) : (arr.map f).size = arr.size := by
simp [size]
@[simp] theorem pop_data (arr : Array α) : arr.pop.data = arr.data.dropLast := rfl
@[simp] theorem append_eq_append (arr arr' : Array α) : arr.append arr' = arr ++ arr' := rfl
@[simp] theorem append_data (arr arr' : Array α) :
(arr ++ arr').data = arr.data ++ arr'.data := by
rw [ append_eq_append]; unfold Array.append
rw [foldl_eq_foldl_data]
induction arr'.data generalizing arr <;> simp [*]
@[simp] theorem appendList_eq_append
(arr : Array α) (l : List α) : arr.appendList l = arr ++ l := rfl
@[simp] theorem appendList_data (arr : Array α) (l : List α) :
(arr ++ l).data = arr.data ++ l := by
rw [ appendList_eq_append]; unfold Array.appendList
induction l generalizing arr <;> simp [*]
@[simp] theorem appendList_nil (arr : Array α) : arr ++ ([] : List α) = arr := Array.ext' (by simp)
@[simp] theorem appendList_cons (arr : Array α) (a : α) (l : List α) :
arr ++ (a :: l) = arr.push a ++ l := Array.ext' (by simp)
theorem foldl_data_eq_bind (l : List α) (acc : Array β)
(F : Array β α Array β) (G : α List β)
(H : acc a, (F acc a).data = acc.data ++ G a) :
(l.foldl F acc).data = acc.data ++ l.bind G := by
induction l generalizing acc <;> simp [*, List.bind]
theorem foldl_data_eq_map (l : List α) (acc : Array β) (G : α β) :
(l.foldl (fun acc a => acc.push (G a)) acc).data = acc.data ++ l.map G := by
induction l generalizing acc <;> simp [*]
theorem size_uset (a : Array α) (v i h) : (uset a i v h).size = a.size := by simp
theorem anyM_eq_anyM_loop [Monad m] (p : α m Bool) (as : Array α) (start stop) :
anyM p as start stop = anyM.loop p as (min stop as.size) (Nat.min_le_right ..) start := by
simp only [anyM, Nat.min_def]; split <;> rfl
theorem anyM_stop_le_start [Monad m] (p : α m Bool) (as : Array α) (start stop)
(h : min stop as.size start) : anyM p as start stop = pure false := by
rw [anyM_eq_anyM_loop, anyM.loop, dif_neg (Nat.not_lt.2 h)]
theorem mem_def (a : α) (as : Array α) : a as a as.data :=
fun | .mk h => h, Array.Mem.mk

View File

@@ -26,8 +26,8 @@ def qpartition (as : Array α) (lt : αα → Bool) (lo hi : Nat) : Nat ×
else
let as := as.swap! i hi
(i, as)
termination_by hi - j
loop as lo lo
termination_by _ => hi - j
@[inline] partial def qsort (as : Array α) (lt : α α Bool) (low := 0) (high := as.size - 1) : Array α :=
let rec @[specialize] sort (as : Array α) (low high : Nat) :=

72
src/Init/Data/Cast.lean Normal file
View File

@@ -0,0 +1,72 @@
/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Gabriel Ebner
-/
prelude
import Init.Coe
/-!
# `NatCast`
We introduce the typeclass `NatCast R` for a type `R` with a "canonical
homomorphism" `Nat → R`. The typeclass carries the data of the function,
but no required axioms.
This typeclass was introduced to support a uniform `simp` normal form
for such morphisms.
Without such a typeclass, we would have specific coercions such as
`Int.ofNat`, but also later the generic coercion from `Nat` into any
Mathlib semiring (including `Int`), and we would need to use `simp` to
move between them. However `simp` lemmas expressed using a non-normal
form on the LHS would then not fire.
Typically different instances of this class for the same target type `R`
are definitionally equal, and so differences in the instance do not
block `simp` or `rw`.
This logic also applies to `Int` and so we also introduce `IntCast` alongside
`Int.
## Note about coercions into arbitrary types:
Coercions such as `Nat.cast` that go from a concrete structure such as
`Nat` to an arbitrary type `R` should be set up as follows:
```lean
instance : CoeTail Nat R where coe := ...
instance : CoeHTCT Nat R where coe := ...
```
It needs to be `CoeTail` instead of `Coe` because otherwise type-class
inference would loop when constructing the transitive coercion `Nat →
Nat → Nat → ...`. Sometimes we also need to declare the `CoeHTCT`
instance if we need to shadow another coercion.
-/
/-- Type class for the canonical homomorphism `Nat → R`. -/
class NatCast (R : Type u) where
/-- The canonical map `Nat → R`. -/
protected natCast : Nat R
instance : NatCast Nat where natCast n := n
/--
Canonical homomorphism from `Nat` to a type `R`.
It contains just the function, with no axioms.
In practice, the target type will likely have a (semi)ring structure,
and this homomorphism should be a ring homomorphism.
The prototypical example is `Int.ofNat`.
This class and `IntCast` exist to allow different libraries with their own types that can be notated as natural numbers to have consistent `simp` normal forms without needing to create coercion simplification sets that are aware of all combinations. Libraries should make it easy to work with `NatCast` where possible. For instance, in Mathlib there will be such a homomorphism (and thus a `NatCast R` instance) whenever `R` is an additive monoid with a `1`.
-/
@[coe, reducible, match_pattern] protected def Nat.cast {R : Type u} [NatCast R] : Nat R :=
NatCast.natCast
-- see the notes about coercions into arbitrary types in the module doc-string
instance [NatCast R] : CoeTail Nat R where coe := Nat.cast
-- see the notes about coercions into arbitrary types in the module doc-string
instance [NatCast R] : CoeHTCT Nat R where coe := Nat.cast

View File

@@ -100,12 +100,14 @@ instance : ShiftLeft (Fin n) where
instance : ShiftRight (Fin n) where
shiftRight := Fin.shiftRight
instance : OfNat (Fin (no_index (n+1))) i where
instance instOfNat : OfNat (Fin (no_index (n+1))) i where
ofNat := Fin.ofNat i
instance : Inhabited (Fin (no_index (n+1))) where
default := 0
@[simp] theorem zero_eta : (0, Nat.zero_lt_succ _ : Fin (n + 1)) = 0 := rfl
theorem val_ne_of_ne {i j : Fin n} (h : i j) : val i val j :=
fun h' => absurd (eq_of_val_eq h') h

View File

@@ -26,6 +26,8 @@ opaque floatSpec : FloatSpec := {
decLe := fun _ _ => inferInstanceAs (Decidable True)
}
/-- Native floating point type, corresponding to the IEEE 754 *binary64* format
(`double` in C or `f64` in Rust). -/
structure Float where
val : floatSpec.float

View File

@@ -300,11 +300,18 @@ instance : MonadPrettyFormat (StateM State) where
startTag _ := return ()
endTags _ := return ()
/-- Pretty-print a `Format` object as a string with expected width `w`. -/
/--
Renders a `Format` to a string.
* `width`: the total width
* `indent`: the initial indentation to use for wrapped lines
(subsequent wrapping may increase the indentation)
* `column`: begin the first line wrap `column` characters earlier than usual
(this is useful when the output String will be printed starting at `column`)
-/
@[export lean_format_pretty]
def pretty (f : Format) (w : Nat := defWidth) : String :=
let act: StateM State Unit := prettyM f w
act {} |>.snd.out
def pretty (f : Format) (width : Nat := defWidth) (indent : Nat := 0) (column := 0) : String :=
let act : StateM State Unit := prettyM f width indent
State.out <| act (State.mk "" column) |>.snd
end Format

View File

@@ -6,7 +6,7 @@ Authors: Jeremy Avigad, Leonardo de Moura
The integers, with addition, multiplication, and subtraction.
-/
prelude
import Init.Coe
import Init.Data.Cast
import Init.Data.Nat.Div
import Init.Data.List.Basic
set_option linter.missingDocs true -- keep it documented
@@ -47,9 +47,9 @@ inductive Int : Type where
attribute [extern "lean_nat_to_int"] Int.ofNat
attribute [extern "lean_int_neg_succ_of_nat"] Int.negSucc
instance : Coe Nat Int := Int.ofNat
instance : NatCast Int where natCast n := Int.ofNat n
instance : OfNat Int n where
instance instOfNat : OfNat Int n where
ofNat := Int.ofNat n
namespace Int
@@ -359,3 +359,27 @@ instance : Min Int := minOfLe
instance : Max Int := maxOfLe
end Int
/--
The canonical homomorphism `Int → R`.
In most use cases `R` will have a ring structure and this will be a ring homomorphism.
-/
class IntCast (R : Type u) where
/-- The canonical map `Int → R`. -/
protected intCast : Int R
instance : IntCast Int where intCast n := n
/--
Apply the canonical homomorphism from `Int` to a type `R` from an `IntCast R` instance.
In Mathlib there will be such a homomorphism whenever `R` is an additive group with a `1`.
-/
@[coe, reducible, match_pattern] protected def Int.cast {R : Type u} [IntCast R] : Int R :=
IntCast.intCast
-- see the notes about coercions into arbitrary types in the module doc-string
instance [IntCast R] : CoeTail Int R where coe := Int.cast
-- see the notes about coercions into arbitrary types in the module doc-string
instance [IntCast R] : CoeHTCT Int R where coe := Int.cast

View File

@@ -7,3 +7,4 @@ prelude
import Init.Data.List.Basic
import Init.Data.List.BasicAux
import Init.Data.List.Control
import Init.Data.List.Lemmas

View File

@@ -124,7 +124,8 @@ def appendTR (as bs : List α) : List α :=
induction as with
| nil => rfl
| cons a as ih =>
simp [reverseAux, List.append, ih, reverseAux_reverseAux]
rw [reverseAux, reverseAux_reverseAux]
simp [List.append, ih, reverseAux]
instance : Append (List α) := List.append
@@ -602,6 +603,27 @@ The longer list is truncated to match the shorter list.
def zip : List α List β List (Prod α β) :=
zipWith Prod.mk
/--
`O(max |xs| |ys|)`.
Version of `List.zipWith` that continues to the end of both lists,
passing `none` to one argument once the shorter list has run out.
-/
def zipWithAll (f : Option α Option β γ) : List α List β List γ
| [], bs => bs.map fun b => f none (some b)
| a :: as, [] => (a :: as).map fun a => f (some a) none
| a :: as, b :: bs => f a b :: zipWithAll f as bs
@[simp] theorem zipWithAll_nil_right :
zipWithAll f as [] = as.map fun a => f (some a) none := by
cases as <;> rfl
@[simp] theorem zipWithAll_nil_left :
zipWithAll f [] bs = bs.map fun b => f none (some b) := by
rfl
@[simp] theorem zipWithAll_cons_cons :
zipWithAll f (a :: as) (b :: bs) = f (some a) (some b) :: zipWithAll f as bs := rfl
/--
`O(|l|)`. Separates a list of pairs into two lists containing the first components and second components.
* `unzip [(x₁, y₁), (x₂, y₂), (x₃, y₃)] = ([x₁, x₂, x₃], [y₁, y₂, y₃])`
@@ -875,7 +897,7 @@ instance [BEq α] [LawfulBEq α] : LawfulBEq (List α) where
cases bs with
| nil => intro h; contradiction
| cons b bs =>
simp [show (a::as == b::bs) = (a == b && as == bs) from rfl]
simp [show (a::as == b::bs) = (a == b && as == bs) from rfl, -and_imp]
intro h₁, h₂
exact h₁, ih h₂
rfl {as} := by

View File

@@ -0,0 +1,630 @@
/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
prelude
import Init.Data.List.BasicAux
import Init.Data.List.Control
import Init.PropLemmas
import Init.Control.Lawful
import Init.Hints
namespace List
open Nat
/-!
# Bootstrapping theorems for lists
These are theorems used in the definitions of `Std.Data.List.Basic` and tactics.
New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap.
-/
attribute [simp] concat_eq_append append_assoc
@[simp] theorem get?_nil : @get? α [] n = none := rfl
@[simp] theorem get?_cons_zero : @get? α (a::l) 0 = some a := rfl
@[simp] theorem get?_cons_succ : @get? α (a::l) (n+1) = get? l n := rfl
@[simp] theorem get_cons_zero : get (a::l) (0 : Fin (l.length + 1)) = a := rfl
@[simp] theorem head?_nil : @head? α [] = none := rfl
@[simp] theorem head?_cons : @head? α (a::l) = some a := rfl
@[simp 1100] theorem headD_nil : @headD α [] d = d := rfl
@[simp 1100] theorem headD_cons : @headD α (a::l) d = a := rfl
@[simp] theorem head_cons : @head α (a::l) h = a := rfl
@[simp] theorem tail?_nil : @tail? α [] = none := rfl
@[simp] theorem tail?_cons : @tail? α (a::l) = some l := rfl
@[simp] theorem tail!_cons : @tail! α (a::l) = l := rfl
@[simp 1100] theorem tailD_nil : @tailD α [] l' = l' := rfl
@[simp 1100] theorem tailD_cons : @tailD α (a::l) l' = l := rfl
@[simp] theorem any_nil : [].any f = false := rfl
@[simp] theorem any_cons : (a::l).any f = (f a || l.any f) := rfl
@[simp] theorem all_nil : [].all f = true := rfl
@[simp] theorem all_cons : (a::l).all f = (f a && l.all f) := rfl
@[simp] theorem or_nil : [].or = false := rfl
@[simp] theorem or_cons : (a::l).or = (a || l.or) := rfl
@[simp] theorem and_nil : [].and = true := rfl
@[simp] theorem and_cons : (a::l).and = (a && l.and) := rfl
/-! ### length -/
theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl
theorem ne_nil_of_length_eq_succ (_ : length l = succ n) : l [] := fun _ => nomatch l
theorem length_eq_zero : length l = 0 l = [] :=
eq_nil_of_length_eq_zero, fun h => h rfl
/-! ### mem -/
@[simp] theorem not_mem_nil (a : α) : ¬ a [] := nofun
@[simp] theorem mem_cons : a (b :: l) a = b a l :=
fun h => by cases h <;> simp [Membership.mem, *],
fun | Or.inl rfl => by constructor | Or.inr h => by constructor; assumption
theorem mem_cons_self (a : α) (l : List α) : a a :: l := .head ..
theorem mem_cons_of_mem (y : α) {a : α} {l : List α} : a l a y :: l := .tail _
theorem eq_nil_iff_forall_not_mem {l : List α} : l = [] a, a l := by
cases l <;> simp
/-! ### append -/
@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl
theorem append_inj :
{s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ length s₁ = length s₂ s₁ = s₂ t₁ = t₂
| [], [], t₁, t₂, h, _ => rfl, h
| a :: s₁, b :: s₂, t₁, t₂, h, hl => by
simp [append_inj (cons.inj h).2 (Nat.succ.inj hl)] at h ; exact h
theorem append_inj_right (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : t₁ = t₂ :=
(append_inj h hl).right
theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : s₁ = s₂ :=
(append_inj h hl).left
theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ t₁ = t₂ :=
append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by
let hap := congrArg length h; simp only [length_append, hl] at hap; exact hap
theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ :=
(append_inj' h hl).right
theorem append_inj_left' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ :=
(append_inj' h hl).left
theorem append_right_inj {t₁ t₂ : List α} (s) : s ++ t₁ = s ++ t₂ t₁ = t₂ :=
fun h => append_inj_right h rfl, congrArg _
theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t s₁ = s₂ :=
fun h => append_inj_left' h rfl, congrArg (· ++ _)
@[simp] theorem append_eq_nil : p ++ q = [] p = [] q = [] := by
cases p <;> simp
/-! ### map -/
@[simp] theorem map_nil {f : α β} : map f [] = [] := rfl
@[simp] theorem map_cons (f : α β) a l : map f (a :: l) = f a :: map f l := rfl
@[simp] theorem map_append (f : α β) : l₁ l₂, map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
intro l₁; induction l₁ <;> intros <;> simp_all
@[simp] theorem map_id (l : List α) : map id l = l := by induction l <;> simp_all
@[simp] theorem map_id' (l : List α) : map (fun a => a) l = l := by induction l <;> simp_all
@[simp] theorem mem_map {f : α β} : {l : List α}, b l.map f a, a l f a = b
| [] => by simp
| _ :: l => by simp [mem_map (l := l), eq_comm (a := b)]
theorem mem_map_of_mem (f : α β) (h : a l) : f a map f l := mem_map.2 _, h, rfl
@[simp] theorem map_map (g : β γ) (f : α β) (l : List α) :
map g (map f l) = map (g f) l := by induction l <;> simp_all
/-! ### bind -/
@[simp] theorem nil_bind (f : α List β) : List.bind [] f = [] := by simp [join, List.bind]
@[simp] theorem cons_bind x xs (f : α List β) :
List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [join, List.bind]
@[simp] theorem append_bind xs ys (f : α List β) :
List.bind (xs ++ ys) f = List.bind xs f ++ List.bind ys f := by
induction xs; {rfl}; simp_all [cons_bind, append_assoc]
@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.join := by simp [List.bind]
/-! ### join -/
@[simp] theorem join_nil : List.join ([] : List (List α)) = [] := rfl
@[simp] theorem join_cons : (l :: ls).join = l ++ ls.join := rfl
/-! ### bounded quantifiers over Lists -/
theorem forall_mem_cons {p : α Prop} {a : α} {l : List α} :
( x, x a :: l p x) p a x, x l p x :=
fun H => H _ (.head ..), fun _ h => H _ (.tail _ h),
fun H₁, H₂ _ => fun | .head .. => H₁ | .tail _ h => H₂ _ h
/-! ### reverse -/
@[simp] theorem reverseAux_nil : reverseAux [] r = r := rfl
@[simp] theorem reverseAux_cons : reverseAux (a::l) r = reverseAux l (a::r) := rfl
theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
reverseAux_eq_append ..
theorem reverse_map (f : α β) (l : List α) : (l.map f).reverse = l.reverse.map f := by
induction l <;> simp [*]
@[simp] theorem reverse_eq_nil_iff {xs : List α} : xs.reverse = [] xs = [] := by
match xs with
| [] => simp
| x :: xs => simp
/-! ### nth element -/
theorem get_of_mem : {a} {l : List α}, a l n, get l n = a
| _, _ :: _, .head .. => 0, Nat.succ_pos _, rfl
| _, _ :: _, .tail _ m => let n, h, e := get_of_mem m; n+1, Nat.succ_lt_succ h, e
theorem get_mem : (l : List α) n h, get l n, h l
| _ :: _, 0, _ => .head ..
| _ :: l, _+1, _ => .tail _ (get_mem l ..)
theorem mem_iff_get {a} {l : List α} : a l n, get l n = a :=
get_of_mem, fun _, e => e get_mem ..
theorem get?_len_le : {l : List α} {n}, length l n l.get? n = none
| [], _, _ => rfl
| _ :: l, _+1, h => get?_len_le (l := l) <| Nat.le_of_succ_le_succ h
theorem get?_eq_get : {l : List α} {n} (h : n < l.length), l.get? n = some (get l n, h)
| _ :: _, 0, _ => rfl
| _ :: l, _+1, _ => get?_eq_get (l := l) _
theorem get?_eq_some : l.get? n = some a h, get l n, h = a :=
fun e =>
have : n < length l := Nat.gt_of_not_le fun hn => by cases get?_len_le hn e
this, by rwa [get?_eq_get this, Option.some.injEq] at e,
fun h, e => e get?_eq_get _
@[simp] theorem get?_eq_none : l.get? n = none length l n :=
fun e => Nat.ge_of_not_lt (fun h' => by cases e get?_eq_some.2 h', rfl), get?_len_le
@[simp] theorem get?_map (f : α β) : l n, (map f l).get? n = (l.get? n).map f
| [], _ => rfl
| _ :: _, 0 => rfl
| _ :: l, n+1 => get?_map f l n
@[simp] theorem get?_concat_length : (l : List α) (a : α), (l ++ [a]).get? l.length = some a
| [], a => rfl
| b :: l, a => by rw [cons_append, length_cons]; simp only [get?, get?_concat_length]
theorem getLast_eq_get : (l : List α) (h : l []),
getLast l h = l.get l.length - 1, by
match l with
| [] => contradiction
| a :: l => exact Nat.le_refl _
| [a], h => rfl
| a :: b :: l, h => by
simp [getLast, get, Nat.succ_sub_succ, getLast_eq_get]
@[simp] theorem getLast?_nil : @getLast? α [] = none := rfl
theorem getLast?_eq_getLast : l h, @getLast? α l = some (getLast l h)
| [], h => nomatch h rfl
| _::_, _ => rfl
theorem getLast?_eq_get? : (l : List α), getLast? l = l.get? (l.length - 1)
| [] => rfl
| a::l => by rw [getLast?_eq_getLast (a::l) nofun, getLast_eq_get, get?_eq_get]
@[simp] theorem getLast?_concat (l : List α) : getLast? (l ++ [a]) = some a := by
simp [getLast?_eq_get?, Nat.succ_sub_succ]
/-! ### take and drop -/
@[simp] theorem take_append_drop : (n : Nat) (l : List α), take n l ++ drop n l = l
| 0, _ => rfl
| _+1, [] => rfl
| n+1, x :: xs => congrArg (cons x) <| take_append_drop n xs
@[simp] theorem length_drop : (i : Nat) (l : List α), length (drop i l) = length l - i
| 0, _ => rfl
| succ i, [] => Eq.symm (Nat.zero_sub (succ i))
| succ i, x :: l => calc
length (drop (succ i) (x :: l)) = length l - i := length_drop i l
_ = succ (length l) - succ i := (Nat.succ_sub_succ_eq_sub (length l) i).symm
theorem drop_length_le {l : List α} (h : l.length i) : drop i l = [] :=
length_eq_zero.1 (length_drop .. Nat.sub_eq_zero_of_le h)
theorem take_length_le {l : List α} (h : l.length i) : take i l = l := by
have := take_append_drop i l
rw [drop_length_le h, append_nil] at this; exact this
@[simp] theorem take_zero (l : List α) : l.take 0 = [] := rfl
@[simp] theorem take_nil : ([] : List α).take i = [] := by cases i <;> rfl
@[simp] theorem take_cons_succ : (a::as).take (i+1) = a :: as.take i := rfl
@[simp] theorem drop_zero (l : List α) : l.drop 0 = l := rfl
@[simp] theorem drop_succ_cons : (a :: l).drop (n + 1) = l.drop n := rfl
@[simp] theorem drop_length (l : List α) : drop l.length l = [] := drop_length_le (Nat.le_refl _)
@[simp] theorem take_length (l : List α) : take l.length l = l := take_length_le (Nat.le_refl _)
theorem take_concat_get (l : List α) (i : Nat) (h : i < l.length) :
(l.take i).concat l[i] = l.take (i+1) :=
Eq.symm <| (append_left_inj _).1 <| (take_append_drop (i+1) l).trans <| by
rw [concat_eq_append, append_assoc, singleton_append, get_drop_eq_drop, take_append_drop]
theorem reverse_concat (l : List α) (a : α) : (l.concat a).reverse = a :: l.reverse := by
rw [concat_eq_append, reverse_append]; rfl
/-! ### takeWhile and dropWhile -/
@[simp] theorem dropWhile_nil : ([] : List α).dropWhile p = [] := rfl
theorem dropWhile_cons :
(x :: xs : List α).dropWhile p = if p x then xs.dropWhile p else x :: xs := by
split <;> simp_all [dropWhile]
/-! ### foldlM and foldrM -/
@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β α m β) (b) :
l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl
@[simp] theorem foldlM_nil [Monad m] (f : β α m β) (b) : [].foldlM f b = pure b := rfl
@[simp] theorem foldlM_cons [Monad m] (f : β α m β) (b) (a) (l : List α) :
(a :: l).foldlM f b = f b a >>= l.foldlM f := by
simp [List.foldlM]
@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β α m β) (b) (l l' : List α) :
(l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
induction l generalizing b <;> simp [*]
@[simp] theorem foldrM_nil [Monad m] (f : α β m β) (b) : [].foldrM f b = pure b := rfl
@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α β m β) (b) :
(a :: l).foldrM f b = l.foldrM f b >>= f a := by
simp only [foldrM]
induction l <;> simp_all
@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α β m β) (b) :
l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b :=
(foldlM_reverse ..).symm.trans <| by simp
theorem foldl_eq_foldlM (f : β α β) (b) (l : List α) :
l.foldl f b = l.foldlM (m := Id) f b := by
induction l generalizing b <;> simp [*, foldl]
theorem foldr_eq_foldrM (f : α β β) (b) (l : List α) :
l.foldr f b = l.foldrM (m := Id) f b := by
induction l <;> simp [*, foldr]
/-! ### foldl and foldr -/
@[simp] theorem foldl_reverse (l : List α) (f : β α β) (b) :
l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM]
@[simp] theorem foldr_reverse (l : List α) (f : α β β) (b) :
l.reverse.foldr f b = l.foldl (fun x y => f y x) b :=
(foldl_reverse ..).symm.trans <| by simp
@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α β m β) (b) (l l' : List α) :
(l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
induction l <;> simp [*]
@[simp] theorem foldl_append {β : Type _} (f : β α β) (b) (l l' : List α) :
(l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]
@[simp] theorem foldr_append (f : α β β) (b) (l l' : List α) :
(l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]
@[simp] theorem foldl_nil : [].foldl f b = b := rfl
@[simp] theorem foldl_cons (l : List α) (b : β) : (a :: l).foldl f b = l.foldl f (f b a) := rfl
@[simp] theorem foldr_nil : [].foldr f b = b := rfl
@[simp] theorem foldr_cons (l : List α) : (a :: l).foldr f b = f a (l.foldr f b) := rfl
@[simp] theorem foldr_self_append (l : List α) : l.foldr cons l' = l ++ l' := by
induction l <;> simp [*]
theorem foldr_self (l : List α) : l.foldr cons [] = l := by simp
/-! ### mapM -/
/-- Alternate (non-tail-recursive) form of mapM for proofs. -/
def mapM' [Monad m] (f : α m β) : List α m (List β)
| [] => pure []
| a :: l => return ( f a) :: ( l.mapM' f)
@[simp] theorem mapM'_nil [Monad m] {f : α m β} : mapM' f [] = pure [] := rfl
@[simp] theorem mapM'_cons [Monad m] {f : α m β} :
mapM' f (a :: l) = return (( f a) :: ( l.mapM' f)) :=
rfl
theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α m β) (l : List α) :
mapM' f l = mapM f l := by simp [go, mapM] where
go : l acc, mapM.loop f l acc = return acc.reverse ++ ( mapM' f l)
| [], acc => by simp [mapM.loop, mapM']
| a::l, acc => by simp [go l, mapM.loop, mapM']
@[simp] theorem mapM_nil [Monad m] (f : α m β) : [].mapM f = pure [] := rfl
@[simp] theorem mapM_cons [Monad m] [LawfulMonad m] (f : α m β) :
(a :: l).mapM f = (return ( f a) :: ( l.mapM f)) := by simp [ mapM'_eq_mapM, mapM']
@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α m β) {l₁ l₂ : List α} :
(l₁ ++ l₂).mapM f = (return ( l₁.mapM f) ++ ( l₂.mapM f)) := by induction l₁ <;> simp [*]
/-! ### forM -/
-- We use `List.forM` as the simp normal form, rather that `ForM.forM`.
-- As such we need to replace `List.forM_nil` and `List.forM_cons` from Lean:
@[simp] theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl
@[simp] theorem forM_cons' [Monad m] :
(a::as).forM f = (f a >>= fun _ => as.forM f : m PUnit) :=
List.forM_cons _ _ _
/-! ### eraseIdx -/
@[simp] theorem eraseIdx_nil : ([] : List α).eraseIdx i = [] := rfl
@[simp] theorem eraseIdx_cons_zero : (a::as).eraseIdx 0 = as := rfl
@[simp] theorem eraseIdx_cons_succ : (a::as).eraseIdx (i+1) = a :: as.eraseIdx i := rfl
/-! ### find? -/
@[simp] theorem find?_nil : ([] : List α).find? p = none := rfl
theorem find?_cons : (a::as).find? p = match p a with | true => some a | false => as.find? p :=
rfl
/-! ### filter -/
@[simp] theorem filter_nil (p : α Bool) : filter p [] = [] := rfl
@[simp] theorem filter_cons_of_pos {p : α Bool} {a : α} (l) (pa : p a) :
filter p (a :: l) = a :: filter p l := by rw [filter, pa]
@[simp] theorem filter_cons_of_neg {p : α Bool} {a : α} (l) (pa : ¬ p a) :
filter p (a :: l) = filter p l := by rw [filter, eq_false_of_ne_true pa]
theorem filter_cons :
(x :: xs : List α).filter p = if p x then x :: (xs.filter p) else xs.filter p := by
split <;> simp [*]
theorem mem_filter : x filter p as x as p x := by
induction as with
| nil => simp [filter]
| cons a as ih =>
by_cases h : p a <;> simp [*, or_and_right]
· exact or_congr_left (and_iff_left_of_imp fun | rfl => h).symm
· exact (or_iff_right fun rfl, h' => h h').symm
theorem filter_eq_nil {l} : filter p l = [] a, a l ¬p a := by
simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and]
/-! ### findSome? -/
@[simp] theorem findSome?_nil : ([] : List α).findSome? f = none := rfl
theorem findSome?_cons {f : α Option β} :
(a::as).findSome? f = match f a with | some b => some b | none => as.findSome? f :=
rfl
/-! ### replace -/
@[simp] theorem replace_nil [BEq α] : ([] : List α).replace a b = [] := rfl
theorem replace_cons [BEq α] {a : α} :
(a::as).replace b c = match a == b with | true => c::as | false => a :: replace as b c :=
rfl
@[simp] theorem replace_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).replace a b = b::as := by
simp [replace_cons]
/-! ### elem -/
@[simp] theorem elem_nil [BEq α] : ([] : List α).elem a = false := rfl
theorem elem_cons [BEq α] {a : α} :
(a::as).elem b = match b == a with | true => true | false => as.elem b :=
rfl
@[simp] theorem elem_cons_self [BEq α] [LawfulBEq α] {a : α} : (a::as).elem a = true := by
simp [elem_cons]
/-! ### lookup -/
@[simp] theorem lookup_nil [BEq α] : ([] : List (α × β)).lookup a = none := rfl
theorem lookup_cons [BEq α] {k : α} :
((k,b)::es).lookup a = match a == k with | true => some b | false => es.lookup a :=
rfl
@[simp] theorem lookup_cons_self [BEq α] [LawfulBEq α] {k : α} : ((k,b)::es).lookup k = some b := by
simp [lookup_cons]
/-! ### zipWith -/
@[simp] theorem zipWith_nil_left {f : α β γ} : zipWith f [] l = [] := by
rfl
@[simp] theorem zipWith_nil_right {f : α β γ} : zipWith f l [] = [] := by
simp [zipWith]
@[simp] theorem zipWith_cons_cons {f : α β γ} :
zipWith f (a :: as) (b :: bs) = f a b :: zipWith f as bs := by
rfl
theorem zipWith_get? {f : α β γ} :
(List.zipWith f as bs).get? i = match as.get? i, bs.get? i with
| some a, some b => some (f a b) | _, _ => none := by
induction as generalizing bs i with
| nil => cases bs with
| nil => simp
| cons b bs => simp
| cons a as aih => cases bs with
| nil => simp
| cons b bs => cases i <;> simp_all
/-! ### zipWithAll -/
theorem zipWithAll_get? {f : Option α Option β γ} :
(zipWithAll f as bs).get? i = match as.get? i, bs.get? i with
| none, none => .none | a?, b? => some (f a? b?) := by
induction as generalizing bs i with
| nil => induction bs generalizing i with
| nil => simp
| cons b bs bih => cases i <;> simp_all
| cons a as aih => cases bs with
| nil =>
specialize @aih []
cases i <;> simp_all
| cons b bs => cases i <;> simp_all
/-! ### zip -/
@[simp] theorem zip_nil_left : zip ([] : List α) (l : List β) = [] := by
rfl
@[simp] theorem zip_nil_right : zip (l : List α) ([] : List β) = [] := by
simp [zip]
@[simp] theorem zip_cons_cons : zip (a :: as) (b :: bs) = (a, b) :: zip as bs := by
rfl
/-! ### unzip -/
@[simp] theorem unzip_nil : ([] : List (α × β)).unzip = ([], []) := rfl
@[simp] theorem unzip_cons {h : α × β} :
(h :: t).unzip = match unzip t with | (al, bl) => (h.1::al, h.2::bl) := rfl
/-! ### all / any -/
@[simp] theorem all_eq_true {l : List α} : l.all p x, x l p x := by induction l <;> simp [*]
@[simp] theorem any_eq_true {l : List α} : l.any p x, x l p x := by induction l <;> simp [*]
/-! ### enumFrom -/
@[simp] theorem enumFrom_nil : ([] : List α).enumFrom i = [] := rfl
@[simp] theorem enumFrom_cons : (a::as).enumFrom i = (i, a) :: as.enumFrom (i+1) := rfl
/-! ### iota -/
@[simp] theorem iota_zero : iota 0 = [] := rfl
@[simp] theorem iota_succ : iota (i+1) = (i+1) :: iota i := rfl
/-! ### intersperse -/
@[simp] theorem intersperse_nil (sep : α) : ([] : List α).intersperse sep = [] := rfl
@[simp] theorem intersperse_single (sep : α) : [x].intersperse sep = [x] := rfl
@[simp] theorem intersperse_cons₂ (sep : α) :
(x::y::zs).intersperse sep = x::sep::((y::zs).intersperse sep) := rfl
/-! ### isPrefixOf -/
@[simp] theorem isPrefixOf_nil_left [BEq α] : isPrefixOf ([] : List α) l = true := by
simp [isPrefixOf]
@[simp] theorem isPrefixOf_cons_nil [BEq α] : isPrefixOf (a::as) ([] : List α) = false := rfl
theorem isPrefixOf_cons₂ [BEq α] {a : α} :
isPrefixOf (a::as) (b::bs) = (a == b && isPrefixOf as bs) := rfl
@[simp] theorem isPrefixOf_cons₂_self [BEq α] [LawfulBEq α] {a : α} :
isPrefixOf (a::as) (a::bs) = isPrefixOf as bs := by simp [isPrefixOf_cons₂]
/-! ### isEqv -/
@[simp] theorem isEqv_nil_nil : isEqv ([] : List α) [] eqv = true := rfl
@[simp] theorem isEqv_nil_cons : isEqv ([] : List α) (a::as) eqv = false := rfl
@[simp] theorem isEqv_cons_nil : isEqv (a::as : List α) [] eqv = false := rfl
theorem isEqv_cons₂ : isEqv (a::as) (b::bs) eqv = (eqv a b && isEqv as bs eqv) := rfl
/-! ### dropLast -/
@[simp] theorem dropLast_nil : ([] : List α).dropLast = [] := rfl
@[simp] theorem dropLast_single : [x].dropLast = [] := rfl
@[simp] theorem dropLast_cons₂ :
(x::y::zs).dropLast = x :: (y::zs).dropLast := rfl
-- We may want to replace these `simp` attributes with explicit equational lemmas,
-- as we already have for all the non-monadic functions.
attribute [simp] mapA forA filterAuxM firstM anyM allM findM? findSomeM?
-- Previously `range.loop`, `mapM.loop`, `filterMapM.loop`, `forIn.loop`, `forIn'.loop`
-- had attribute `@[simp]`.
-- We don't currently provide simp lemmas,
-- as this is an internal implementation and they don't seem to be needed.
/-! ### minimum? -/
@[simp] theorem minimum?_nil [Min α] : ([] : List α).minimum? = none := rfl
-- We don't put `@[simp]` on `minimum?_cons`,
-- because the definition in terms of `foldl` is not useful for proofs.
theorem minimum?_cons [Min α] {xs : List α} : (x :: xs).minimum? = foldl min x xs := rfl
@[simp] theorem minimum?_eq_none_iff {xs : List α} [Min α] : xs.minimum? = none xs = [] := by
cases xs <;> simp [minimum?]
theorem minimum?_mem [Min α] (min_eq_or : a b : α, min a b = a min a b = b) :
{xs : List α} xs.minimum? = some a a xs := by
intro xs
match xs with
| nil => simp
| x :: xs =>
simp only [minimum?_cons, Option.some.injEq, List.mem_cons]
intro eq
induction xs generalizing x with
| nil =>
simp at eq
simp [eq]
| cons y xs ind =>
simp at eq
have p := ind _ eq
cases p with
| inl p =>
cases min_eq_or x y with | _ q => simp [p, q]
| inr p => simp [p, mem_cons]
theorem le_minimum?_iff [Min α] [LE α]
(le_min_iff : a b c : α, a min b c a b a c) :
{xs : List α} xs.minimum? = some a x, x a b, b xs x b
| nil => by simp
| cons x xs => by
rw [minimum?]
intro eq y
simp only [Option.some.injEq] at eq
induction xs generalizing x with
| nil =>
simp at eq
simp [eq]
| cons z xs ih =>
simp at eq
simp [ih _ eq, le_min_iff, and_assoc]
-- This could be refactored by designing appropriate typeclasses to replace `le_refl`, `min_eq_or`,
-- and `le_min_iff`.
theorem minimum?_eq_some_iff [Min α] [LE α] [anti : Antisymm ((· : α) ·)]
(le_refl : a : α, a a)
(min_eq_or : a b : α, min a b = a min a b = b)
(le_min_iff : a b c : α, a min b c a b a c) {xs : List α} :
xs.minimum? = some a a xs b, b xs a b := by
refine fun h => minimum?_mem min_eq_or h, (le_minimum?_iff le_min_iff h _).1 (le_refl _), ?_
intro h₁, h₂
cases xs with
| nil => simp at h₁
| cons x xs =>
exact congrArg some <| anti.1
((le_minimum?_iff le_min_iff (xs := x::xs) rfl _).1 (le_refl _) _ h₁)
(h₂ _ (minimum?_mem min_eq_or (xs := x::xs) rfl))

View File

@@ -6,7 +6,9 @@ Authors: Leonardo de Moura
prelude
import Init.Data.Nat.Basic
import Init.Data.Nat.Div
import Init.Data.Nat.Dvd
import Init.Data.Nat.Gcd
import Init.Data.Nat.MinMax
import Init.Data.Nat.Bitwise
import Init.Data.Nat.Control
import Init.Data.Nat.Log2

View File

@@ -147,13 +147,20 @@ protected theorem add_right_comm (n m k : Nat) : (n + m) + k = (n + k) + m := by
protected theorem add_left_cancel {n m k : Nat} : n + m = n + k m = k := by
induction n with
| zero => simp; intros; assumption
| zero => simp
| succ n ih => simp [succ_add]; intro h; apply ih h
protected theorem add_right_cancel {n m k : Nat} (h : n + m = k + m) : n = k := by
rw [Nat.add_comm n m, Nat.add_comm k m] at h
apply Nat.add_left_cancel h
theorem eq_zero_of_add_eq_zero : {n m}, n + m = 0 n = 0 m = 0
| 0, 0, _ => rfl, rfl
| _+1, 0, h => Nat.noConfusion h
protected theorem eq_zero_of_add_eq_zero_left (h : n + m = 0) : m = 0 :=
(Nat.eq_zero_of_add_eq_zero h).2
/-! # Nat.mul theorems -/
@[simp] protected theorem mul_zero (n : Nat) : n * 0 = 0 :=
@@ -206,16 +213,13 @@ protected theorem mul_left_comm (n m k : Nat) : n * (m * k) = m * (n * k) := by
attribute [simp] Nat.le_refl
theorem succ_lt_succ {n m : Nat} : n < m succ n < succ m :=
succ_le_succ
theorem succ_lt_succ {n m : Nat} : n < m succ n < succ m := succ_le_succ
theorem lt_succ_of_le {n m : Nat} : n m n < succ m :=
succ_le_succ
theorem lt_succ_of_le {n m : Nat} : n m n < succ m := succ_le_succ
@[simp] protected theorem sub_zero (n : Nat) : n - 0 = n :=
rfl
@[simp] protected theorem sub_zero (n : Nat) : n - 0 = n := rfl
theorem succ_sub_succ_eq_sub (n m : Nat) : succ n - succ m = n - m := by
@[simp] theorem succ_sub_succ_eq_sub (n m : Nat) : succ n - succ m = n - m := by
induction m with
| zero => exact rfl
| succ m ih => apply congrArg pred ih
@@ -241,8 +245,7 @@ theorem sub_lt : ∀ {n m : Nat}, 0 < n → 0 < m → n - m < n
show n - m < succ n from
lt_succ_of_le (sub_le n m)
theorem sub_succ (n m : Nat) : n - succ m = pred (n - m) :=
rfl
theorem sub_succ (n m : Nat) : n - succ m = pred (n - m) := rfl
theorem succ_sub_succ (n m : Nat) : succ n - succ m = n - m :=
succ_sub_succ_eq_sub n m
@@ -277,20 +280,24 @@ instance : Trans (. ≤ . : Nat → Nat → Prop) (. < . : Nat → Nat → Prop)
protected theorem le_of_eq {n m : Nat} (p : n = m) : n m :=
p Nat.le_refl n
theorem le_of_succ_le {n m : Nat} (h : succ n m) : n m :=
Nat.le_trans (le_succ n) h
protected theorem le_of_lt {n m : Nat} (h : n < m) : n m :=
le_of_succ_le h
theorem lt.step {n m : Nat} : n < m n < succ m := le_step
theorem le_of_succ_le {n m : Nat} (h : succ n m) : n m := Nat.le_trans (le_succ n) h
theorem lt_of_succ_lt {n m : Nat} : succ n < m n < m := le_of_succ_le
protected theorem le_of_lt {n m : Nat} : n < m n m := le_of_succ_le
theorem lt_of_succ_lt_succ {n m : Nat} : succ n < succ m n < m := le_of_succ_le_succ
theorem lt_of_succ_le {n m : Nat} (h : succ n m) : n < m := h
theorem succ_le_of_lt {n m : Nat} (h : n < m) : succ n m := h
theorem eq_zero_or_pos : (n : Nat), n = 0 n > 0
| 0 => Or.inl rfl
| _+1 => Or.inr (succ_pos _)
theorem lt.base (n : Nat) : n < succ n := Nat.le_refl (succ n)
protected theorem pos_of_ne_zero {n : Nat} : n 0 0 < n := (eq_zero_or_pos n).resolve_left
theorem lt.base (n : Nat) : n < succ n := Nat.le_refl (succ n)
theorem lt_succ_self (n : Nat) : n < succ n := lt.base n
protected theorem le_total (m n : Nat) : m n n m :=
@@ -298,20 +305,7 @@ protected theorem le_total (m n : Nat) : m ≤ n n ≤ m :=
| Or.inl h => Or.inl (Nat.le_of_lt h)
| Or.inr h => Or.inr h
theorem eq_zero_of_le_zero {n : Nat} (h : n 0) : n = 0 :=
Nat.le_antisymm h (zero_le _)
theorem lt_of_succ_lt {n m : Nat} : succ n < m n < m :=
le_of_succ_le
theorem lt_of_succ_lt_succ {n m : Nat} : succ n < succ m n < m :=
le_of_succ_le_succ
theorem lt_of_succ_le {n m : Nat} (h : succ n m) : n < m :=
h
theorem succ_le_of_lt {n m : Nat} (h : n < m) : succ n m :=
h
theorem eq_zero_of_le_zero {n : Nat} (h : n 0) : n = 0 := Nat.le_antisymm h (zero_le _)
theorem zero_lt_of_lt : {a b : Nat} a < b 0 < b
| 0, _, h => h
@@ -326,8 +320,7 @@ theorem zero_lt_of_ne_zero {a : Nat} (h : a ≠ 0) : 0 < a := by
attribute [simp] Nat.lt_irrefl
theorem ne_of_lt {a b : Nat} (h : a < b) : a b :=
fun he => absurd (he h) (Nat.lt_irrefl a)
theorem ne_of_lt {a b : Nat} (h : a < b) : a b := fun he => absurd (he h) (Nat.lt_irrefl a)
theorem le_or_eq_of_le_succ {m n : Nat} (h : m succ n) : m n m = succ n :=
Decidable.byCases
@@ -363,16 +356,51 @@ protected theorem not_le_of_gt {n m : Nat} (h : n > m) : ¬ n ≤ m := fun h₁
| Or.inr h₂ =>
have Heq : n = m := Nat.le_antisymm h₁ h₂
absurd (@Eq.subst _ _ _ _ Heq h) (Nat.lt_irrefl m)
protected theorem not_le_of_lt : {a b : Nat}, a < b ¬(b a) := Nat.not_le_of_gt
protected theorem not_lt_of_ge : {a b : Nat}, b a ¬(b < a) := flip Nat.not_le_of_gt
protected theorem not_lt_of_le : {a b : Nat}, a b ¬(b < a) := flip Nat.not_le_of_gt
protected theorem lt_le_asymm : {a b : Nat}, a < b ¬(b a) := Nat.not_le_of_gt
protected theorem le_lt_asymm : {a b : Nat}, a b ¬(b < a) := flip Nat.not_le_of_gt
theorem gt_of_not_le {n m : Nat} (h : ¬ n m) : n > m :=
match Nat.lt_or_ge m n with
| Or.inl h₁ => h₁
| Or.inr h₁ => absurd h₁ h
theorem gt_of_not_le {n m : Nat} (h : ¬ n m) : n > m := (Nat.lt_or_ge m n).resolve_right h
protected theorem lt_of_not_ge : {a b : Nat}, ¬(b a) b < a := Nat.gt_of_not_le
protected theorem lt_of_not_le : {a b : Nat}, ¬(a b) b < a := Nat.gt_of_not_le
theorem ge_of_not_lt {n m : Nat} (h : ¬ n < m) : n m :=
match Nat.lt_or_ge n m with
| Or.inl h₁ => absurd h₁ h
| Or.inr h₁ => h₁
theorem ge_of_not_lt {n m : Nat} (h : ¬ n < m) : n m := (Nat.lt_or_ge n m).resolve_left h
protected theorem le_of_not_gt : {a b : Nat}, ¬(b > a) b a := Nat.ge_of_not_lt
protected theorem le_of_not_lt : {a b : Nat}, ¬(a < b) b a := Nat.ge_of_not_lt
theorem ne_of_gt {a b : Nat} (h : b < a) : a b := (ne_of_lt h).symm
protected theorem ne_of_lt' : {a b : Nat}, a < b b a := ne_of_gt
@[simp] protected theorem not_le {a b : Nat} : ¬ a b b < a :=
Iff.intro Nat.gt_of_not_le Nat.not_le_of_gt
@[simp] protected theorem not_lt {a b : Nat} : ¬ a < b b a :=
Iff.intro Nat.ge_of_not_lt (flip Nat.not_le_of_gt)
protected theorem le_of_not_le {a b : Nat} (h : ¬ b a) : a b := Nat.le_of_lt (Nat.not_le.1 h)
protected theorem le_of_not_ge : {a b : Nat}, ¬(a b) a b:= @Nat.le_of_not_le
protected theorem lt_trichotomy (a b : Nat) : a < b a = b b < a :=
match Nat.lt_or_ge a b with
| .inl h => .inl h
| .inr h =>
match Nat.eq_or_lt_of_le h with
| .inl h => .inr (.inl h.symm)
| .inr h => .inr (.inr h)
protected theorem lt_or_gt_of_ne {a b : Nat} (ne : a b) : a < b a > b :=
match Nat.lt_trichotomy a b with
| .inl h => .inl h
| .inr (.inl e) => False.elim (ne e)
| .inr (.inr h) => .inr h
protected theorem lt_or_lt_of_ne : {a b : Nat}, a b a < b b < a := Nat.lt_or_gt_of_ne
protected theorem le_antisymm_iff {a b : Nat} : a = b a b b a :=
Iff.intro (fun p => And.intro (Nat.le_of_eq p) (Nat.le_of_eq p.symm))
(fun hle, hge => Nat.le_antisymm hle hge)
protected theorem eq_iff_le_and_ge : {a b : Nat}, a = b a b b a := @Nat.le_antisymm_iff
instance : Antisymm ( . . : Nat Nat Prop) where
antisymm h₁ h₂ := Nat.le_antisymm h₁ h₂
@@ -401,6 +429,8 @@ protected theorem add_lt_add_right {n m : Nat} (h : n < m) (k : Nat) : n + k < m
protected theorem zero_lt_one : 0 < (1:Nat) :=
zero_lt_succ 0
protected theorem pos_iff_ne_zero : 0 < n n 0 := ne_of_gt, Nat.pos_of_ne_zero
theorem add_le_add {a b c d : Nat} (h₁ : a b) (h₂ : c d) : a + c b + d :=
Nat.le_trans (Nat.add_le_add_right h₁ c) (Nat.add_le_add_left h₂ b)
@@ -418,6 +448,9 @@ protected theorem le_of_add_le_add_right {a b c : Nat} : a + b ≤ c + b → a
rw [Nat.add_comm _ b, Nat.add_comm _ b]
apply Nat.le_of_add_le_add_left
protected theorem add_le_add_iff_right {n : Nat} : m + n k + n m k :=
Nat.le_of_add_le_add_right, fun h => Nat.add_le_add_right h _
/-! # Basic theorems for comparing numerals -/
theorem ctor_eq_zero : Nat.zero = 0 :=
@@ -527,7 +560,20 @@ theorem not_eq_zero_of_lt (h : b < a) : a ≠ 0 := by
theorem pred_lt' {n m : Nat} (h : m < n) : pred n < n :=
pred_lt (not_eq_zero_of_lt h)
/-! # sub/pred theorems -/
/-! # pred theorems -/
@[simp] protected theorem pred_zero : pred 0 = 0 := rfl
@[simp] protected theorem pred_succ (n : Nat) : pred n.succ = n := rfl
theorem succ_pred {a : Nat} (h : a 0) : a.pred.succ = a := by
induction a with
| zero => contradiction
| succ => rfl
theorem succ_pred_eq_of_pos : {n}, 0 < n succ (pred n) = n
| _+1, _ => rfl
/-! # sub theorems -/
theorem add_sub_self_left (a b : Nat) : (a + b) - a = b := by
induction a with
@@ -561,11 +607,6 @@ theorem sub_succ_lt_self (a i : Nat) (h : i < a) : a - (i + 1) < a - i := by
apply Nat.zero_lt_sub_of_lt
assumption
theorem succ_pred {a : Nat} (h : a 0) : a.pred.succ = a := by
induction a with
| zero => contradiction
| succ => rfl
theorem sub_ne_zero_of_lt : {a b : Nat} a < b b - a 0
| 0, 0, h => absurd h (Nat.lt_irrefl 0)
| 0, succ b, _ => by simp
@@ -591,7 +632,7 @@ protected theorem add_sub_add_right (n k m : Nat) : (n + k) - (m + k) = n - m :=
protected theorem add_sub_add_left (k n m : Nat) : (k + n) - (k + m) = n - m := by
rw [Nat.add_comm k n, Nat.add_comm k m, Nat.add_sub_add_right]
protected theorem add_sub_cancel (n m : Nat) : n + m - m = n :=
@[simp] protected theorem add_sub_cancel (n m : Nat) : n + m - m = n :=
suffices n + m - (0 + m) = n by rw [Nat.zero_add] at this; assumption
by rw [Nat.add_sub_add_right, Nat.sub_zero]
@@ -680,12 +721,6 @@ theorem lt_sub_of_add_lt {a b c : Nat} (h : a + b < c) : a < c - b :=
have : a.succ + b c := by simp [Nat.succ_add]; exact h
le_sub_of_add_le this
@[simp] protected theorem pred_zero : pred 0 = 0 :=
rfl
@[simp] protected theorem pred_succ (n : Nat) : pred n.succ = n :=
rfl
theorem sub.elim {motive : Nat Prop}
(x y : Nat)
(h₁ : y x (k : Nat) x = y + k motive k)
@@ -695,19 +730,76 @@ theorem sub.elim {motive : Nat → Prop}
| inl hlt => rw [Nat.sub_eq_zero_of_le (Nat.le_of_lt hlt)]; exact h₂ hlt
| inr hle => exact h₁ hle (x - y) (Nat.add_sub_of_le hle).symm
theorem mul_pred_left (n m : Nat) : pred n * m = n * m - m := by
cases n with
| zero => simp
| succ n => rw [Nat.pred_succ, succ_mul, Nat.add_sub_cancel]
theorem succ_sub {m n : Nat} (h : n m) : succ m - n = succ (m - n) := by
let k, hk := Nat.le.dest h
rw [ hk, Nat.add_sub_cancel_left, add_succ, Nat.add_sub_cancel_left]
theorem mul_pred_right (n m : Nat) : n * pred m = n * m - n := by
rw [Nat.mul_comm, mul_pred_left, Nat.mul_comm]
protected theorem sub_pos_of_lt (h : m < n) : 0 < n - m :=
Nat.pos_iff_ne_zero.2 (Nat.sub_ne_zero_of_lt h)
protected theorem sub_sub (n m k : Nat) : n - m - k = n - (m + k) := by
induction k with
| zero => simp
| succ k ih => rw [Nat.add_succ, Nat.sub_succ, Nat.sub_succ, ih]
protected theorem sub_le_sub_left (h : n m) (k : Nat) : k - m k - n :=
match m, le.dest h with
| _, a, rfl => by rw [ Nat.sub_sub]; apply sub_le
protected theorem sub_le_sub_right {n m : Nat} (h : n m) : k, n - k m - k
| 0 => h
| z+1 => pred_le_pred (Nat.sub_le_sub_right h z)
protected theorem lt_of_sub_ne_zero (h : n - m 0) : m < n :=
Nat.not_le.1 (mt Nat.sub_eq_zero_of_le h)
protected theorem sub_ne_zero_iff_lt : n - m 0 m < n :=
Nat.lt_of_sub_ne_zero, Nat.sub_ne_zero_of_lt
protected theorem lt_of_sub_pos (h : 0 < n - m) : m < n :=
Nat.lt_of_sub_ne_zero (Nat.pos_iff_ne_zero.1 h)
protected theorem lt_of_sub_eq_succ (h : m - n = succ l) : n < m :=
Nat.lt_of_sub_pos (h Nat.zero_lt_succ _)
protected theorem sub_lt_left_of_lt_add {n k m : Nat} (H : n k) (h : k < n + m) : k - n < m := by
have := Nat.sub_le_sub_right (succ_le_of_lt h) n
rwa [Nat.add_sub_cancel_left, Nat.succ_sub H] at this
protected theorem sub_lt_right_of_lt_add {n k m : Nat} (H : n k) (h : k < m + n) : k - n < m :=
Nat.sub_lt_left_of_lt_add H (Nat.add_comm .. h)
protected theorem le_of_sub_eq_zero : {n m}, n - m = 0 n m
| 0, _, _ => Nat.zero_le ..
| _+1, _+1, h => Nat.succ_le_succ <| Nat.le_of_sub_eq_zero (Nat.succ_sub_succ .. h)
protected theorem le_of_sub_le_sub_right : {n m k : Nat}, k m n - k m - k n m
| 0, _, _, _, _ => Nat.zero_le ..
| _+1, _, 0, _, h₁ => h₁
| _+1, _+1, _+1, h₀, h₁ => by
simp only [Nat.succ_sub_succ] at h₁
exact succ_le_succ <| Nat.le_of_sub_le_sub_right (le_of_succ_le_succ h₀) h₁
protected theorem sub_le_sub_iff_right {n : Nat} (h : k m) : n - k m - k n m :=
Nat.le_of_sub_le_sub_right h, fun h => Nat.sub_le_sub_right h _
protected theorem sub_eq_iff_eq_add {c : Nat} (h : b a) : a - b = c a = c + b :=
fun | rfl => by rw [Nat.sub_add_cancel h], fun heq => by rw [heq, Nat.add_sub_cancel]
protected theorem sub_eq_iff_eq_add' {c : Nat} (h : b a) : a - b = c a = b + c := by
rw [Nat.add_comm, Nat.sub_eq_iff_eq_add h]
theorem mul_pred_left (n m : Nat) : pred n * m = n * m - m := by
cases n with
| zero => simp
| succ n => rw [Nat.pred_succ, succ_mul, Nat.add_sub_cancel]
/-! ## Mul sub distrib -/
theorem mul_pred_right (n m : Nat) : n * pred m = n * m - n := by
rw [Nat.mul_comm, mul_pred_left, Nat.mul_comm]
protected theorem mul_sub_right_distrib (n m k : Nat) : (n - m) * k = n * k - m * k := by
induction m with
| zero => simp
@@ -719,14 +811,12 @@ protected theorem mul_sub_left_distrib (n m k : Nat) : n * (m - k) = n * m - n *
/-! # Helper normalization theorems -/
theorem not_le_eq (a b : Nat) : (¬ (a b)) = (b + 1 a) :=
propext <| Iff.intro (fun h => Nat.gt_of_not_le h) (fun h => Nat.not_le_of_gt h)
Eq.propIntro Nat.gt_of_not_le Nat.not_le_of_gt
theorem not_ge_eq (a b : Nat) : (¬ (a b)) = (a + 1 b) :=
not_le_eq b a
theorem not_lt_eq (a b : Nat) : (¬ (a < b)) = (b a) :=
propext <| Iff.intro (fun h => have h := Nat.succ_le_of_lt (Nat.gt_of_not_le h); Nat.le_of_succ_le_succ h) (fun h => Nat.not_le_of_gt (Nat.succ_le_succ h))
Eq.propIntro Nat.le_of_not_lt Nat.not_lt_of_le
theorem not_gt_eq (a b : Nat) : (¬ (a > b)) = (a b) :=
not_lt_eq b a

View File

@@ -7,6 +7,7 @@ prelude
import Init.WF
import Init.WFTactics
import Init.Data.Nat.Basic
namespace Nat
theorem div_rec_lemma {x y : Nat} : 0 < y y x x - y < x :=
@@ -174,4 +175,136 @@ theorem div_add_mod (m n : Nat) : n * (m / n) + m % n = m := by
rw [Nat.left_distrib, Nat.mul_one, Nat.add_assoc, Nat.add_left_comm, ih, Nat.add_comm, Nat.sub_add_cancel h.2]
decreasing_by apply div_rec_lemma; assumption
theorem div_eq_sub_div (h₁ : 0 < b) (h₂ : b a) : a / b = (a - b) / b + 1 := by
rw [div_eq a, if_pos]; constructor <;> assumption
theorem mod_add_div (m k : Nat) : m % k + k * (m / k) = m := by
induction m, k using mod.inductionOn with rw [div_eq, mod_eq]
| base x y h => simp [h]
| ind x y h IH => simp [h]; rw [Nat.mul_succ, Nat.add_assoc, IH, Nat.sub_add_cancel h.2]
@[simp] protected theorem div_one (n : Nat) : n / 1 = n := by
have := mod_add_div n 1
rwa [mod_one, Nat.zero_add, Nat.one_mul] at this
@[simp] protected theorem div_zero (n : Nat) : n / 0 = 0 := by
rw [div_eq]; simp [Nat.lt_irrefl]
@[simp] protected theorem zero_div (b : Nat) : 0 / b = 0 :=
(div_eq 0 b).trans <| if_neg <| And.rec Nat.not_le_of_gt
theorem le_div_iff_mul_le (k0 : 0 < k) : x y / k x * k y := by
induction y, k using mod.inductionOn generalizing x with
(rw [div_eq]; simp [h]; cases x with | zero => simp [zero_le] | succ x => ?_)
| base y k h =>
simp [not_succ_le_zero x, succ_mul, Nat.add_comm]
refine Nat.lt_of_lt_of_le ?_ (Nat.le_add_right ..)
exact Nat.not_le.1 fun h' => h k0, h'
| ind y k h IH =>
rw [ add_one, Nat.add_le_add_iff_right, IH k0, succ_mul,
Nat.add_sub_cancel (x*k) k, Nat.sub_le_sub_iff_right h.2, Nat.add_sub_cancel]
theorem div_mul_le_self : (m n : Nat), m / n * n m
| m, 0 => by simp
| m, n+1 => (le_div_iff_mul_le (Nat.succ_pos _)).1 (Nat.le_refl _)
theorem div_lt_iff_lt_mul (Hk : 0 < k) : x / k < y x < y * k := by
rw [ Nat.not_le, Nat.not_le]; exact not_congr (le_div_iff_mul_le Hk)
@[simp] theorem add_div_right (x : Nat) {z : Nat} (H : 0 < z) : (x + z) / z = succ (x / z) := by
rw [div_eq_sub_div H (Nat.le_add_left _ _), Nat.add_sub_cancel]
@[simp] theorem add_div_left (x : Nat) {z : Nat} (H : 0 < z) : (z + x) / z = succ (x / z) := by
rw [Nat.add_comm, add_div_right x H]
theorem add_mul_div_left (x z : Nat) {y : Nat} (H : 0 < y) : (x + y * z) / y = x / y + z := by
induction z with
| zero => rw [Nat.mul_zero, Nat.add_zero, Nat.add_zero]
| succ z ih => rw [mul_succ, Nat.add_assoc, add_div_right _ H, ih]; rfl
theorem add_mul_div_right (x y : Nat) {z : Nat} (H : 0 < z) : (x + y * z) / z = x / z + y := by
rw [Nat.mul_comm, add_mul_div_left _ _ H]
@[simp] theorem add_mod_right (x z : Nat) : (x + z) % z = x % z := by
rw [mod_eq_sub_mod (Nat.le_add_left ..), Nat.add_sub_cancel]
@[simp] theorem add_mod_left (x z : Nat) : (x + z) % x = z % x := by
rw [Nat.add_comm, add_mod_right]
@[simp] theorem add_mul_mod_self_left (x y z : Nat) : (x + y * z) % y = x % y := by
match z with
| 0 => rw [Nat.mul_zero, Nat.add_zero]
| succ z => rw [mul_succ, Nat.add_assoc, add_mod_right, add_mul_mod_self_left (z := z)]
@[simp] theorem add_mul_mod_self_right (x y z : Nat) : (x + y * z) % z = x % z := by
rw [Nat.mul_comm, add_mul_mod_self_left]
@[simp] theorem mul_mod_right (m n : Nat) : (m * n) % m = 0 := by
rw [ Nat.zero_add (m * n), add_mul_mod_self_left, zero_mod]
@[simp] theorem mul_mod_left (m n : Nat) : (m * n) % n = 0 := by
rw [Nat.mul_comm, mul_mod_right]
protected theorem div_eq_of_lt_le (lo : k * n m) (hi : m < succ k * n) : m / n = k :=
have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun hn => by
rw [hn, Nat.mul_zero] at hi lo; exact absurd lo (Nat.not_le_of_gt hi)
Nat.le_antisymm
(le_of_lt_succ ((Nat.div_lt_iff_lt_mul npos).2 hi))
((Nat.le_div_iff_mul_le npos).2 lo)
theorem sub_mul_div (x n p : Nat) (h₁ : n*p x) : (x - n*p) / n = x / n - p := by
match eq_zero_or_pos n with
| .inl h₀ => rw [h₀, Nat.div_zero, Nat.div_zero, Nat.zero_sub]
| .inr h₀ => induction p with
| zero => rw [Nat.mul_zero, Nat.sub_zero, Nat.sub_zero]
| succ p IH =>
have h₂ : n * p x := Nat.le_trans (Nat.mul_le_mul_left _ (le_succ _)) h₁
have h₃ : x - n * p n := by
apply Nat.le_of_add_le_add_right
rw [Nat.sub_add_cancel h₂, Nat.add_comm]
rw [mul_succ] at h₁
exact h₁
rw [sub_succ, IH h₂, div_eq_sub_div h₀ h₃]
simp [add_one, Nat.pred_succ, mul_succ, Nat.sub_sub]
theorem mul_sub_div (x n p : Nat) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) := by
have npos : 0 < n := (eq_zero_or_pos _).resolve_left fun n0 => by
rw [n0, Nat.zero_mul] at h₁; exact not_lt_zero _ h₁
apply Nat.div_eq_of_lt_le
focus
rw [Nat.mul_sub_right_distrib, Nat.mul_comm]
exact Nat.sub_le_sub_left ((div_lt_iff_lt_mul npos).1 (lt_succ_self _)) _
focus
show succ (pred (n * p - x)) (succ (pred (p - x / n))) * n
rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁),
fun h => succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)] -- TODO: why is the function needed?
focus
rw [Nat.mul_sub_right_distrib, Nat.mul_comm]
exact Nat.sub_le_sub_left (div_mul_le_self ..) _
focus
rwa [div_lt_iff_lt_mul npos, Nat.mul_comm]
theorem mul_mod_mul_left (z x y : Nat) : (z * x) % (z * y) = z * (x % y) :=
if y0 : y = 0 then by
rw [y0, Nat.mul_zero, mod_zero, mod_zero]
else if z0 : z = 0 then by
rw [z0, Nat.zero_mul, Nat.zero_mul, Nat.zero_mul, mod_zero]
else by
induction x using Nat.strongInductionOn with
| _ n IH =>
have y0 : y > 0 := Nat.pos_of_ne_zero y0
have z0 : z > 0 := Nat.pos_of_ne_zero z0
cases Nat.lt_or_ge n y with
| inl yn => rw [mod_eq_of_lt yn, mod_eq_of_lt (Nat.mul_lt_mul_of_pos_left yn z0)]
| inr yn =>
rw [mod_eq_sub_mod yn, mod_eq_sub_mod (Nat.mul_le_mul_left z yn),
Nat.mul_sub_left_distrib]
exact IH _ (sub_lt (Nat.lt_of_lt_of_le y0 yn) y0)
theorem div_eq_of_lt (h₀ : a < b) : a / b = 0 := by
rw [div_eq a, if_neg]
intro h₁
apply Nat.not_le_of_gt h₀ h₁.right
end Nat

View File

@@ -0,0 +1,96 @@
prelude
import Init.Data.Nat.Div
namespace Nat
/--
Divisibility of natural numbers. `a b` (typed as `\|`) says that
there is some `c` such that `b = a * c`.
-/
instance : Dvd Nat where
dvd a b := Exists (fun c => b = a * c)
protected theorem dvd_refl (a : Nat) : a a := 1, by simp
protected theorem dvd_zero (a : Nat) : a 0 := 0, by simp
protected theorem dvd_mul_left (a b : Nat) : a b * a := b, Nat.mul_comm b a
protected theorem dvd_mul_right (a b : Nat) : a a * b := b, rfl
protected theorem dvd_trans {a b c : Nat} (h₁ : a b) (h₂ : b c) : a c :=
match h₁, h₂ with
| d, (h₃ : b = a * d), e, (h₄ : c = b * e) =>
d * e, show c = a * (d * e) by simp[h₃,h₄, Nat.mul_assoc]
protected theorem eq_zero_of_zero_dvd {a : Nat} (h : 0 a) : a = 0 :=
let c, H' := h; H'.trans c.zero_mul
@[simp] protected theorem zero_dvd {n : Nat} : 0 n n = 0 :=
Nat.eq_zero_of_zero_dvd, fun h => h.symm Nat.dvd_zero 0
protected theorem dvd_add {a b c : Nat} (h₁ : a b) (h₂ : a c) : a b + c :=
let d, hd := h₁; let e, he := h₂; d + e, by simp [Nat.left_distrib, hd, he]
protected theorem dvd_add_iff_right {k m n : Nat} (h : k m) : k n k m + n :=
Nat.dvd_add h,
match m, h with
| _, d, rfl => fun e, he =>
e - d, by rw [Nat.mul_sub_left_distrib, he, Nat.add_sub_cancel_left]
protected theorem dvd_add_iff_left {k m n : Nat} (h : k n) : k m k m + n := by
rw [Nat.add_comm]; exact Nat.dvd_add_iff_right h
theorem dvd_mod_iff {k m n : Nat} (h: k n) : k m % n k m :=
have := Nat.dvd_add_iff_left <| Nat.dvd_trans h <| Nat.dvd_mul_right n (m / n)
by rwa [mod_add_div] at this
theorem le_of_dvd {m n : Nat} (h : 0 < n) : m n m n
| k, e => by
revert h
rw [e]
match k with
| 0 => intro hn; simp at hn
| pk+1 =>
intro
have := Nat.mul_le_mul_left m (succ_pos pk)
rwa [Nat.mul_one] at this
protected theorem dvd_antisymm : {m n : Nat}, m n n m m = n
| _, 0, _, h₂ => Nat.eq_zero_of_zero_dvd h₂
| 0, _, h₁, _ => (Nat.eq_zero_of_zero_dvd h₁).symm
| _+1, _+1, h₁, h₂ => Nat.le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂)
theorem pos_of_dvd_of_pos {m n : Nat} (H1 : m n) (H2 : 0 < n) : 0 < m :=
Nat.pos_of_ne_zero fun m0 => Nat.ne_of_gt H2 <| Nat.eq_zero_of_zero_dvd (m0 H1)
@[simp] protected theorem one_dvd (n : Nat) : 1 n := n, n.one_mul.symm
theorem eq_one_of_dvd_one {n : Nat} (H : n 1) : n = 1 := Nat.dvd_antisymm H n.one_dvd
theorem mod_eq_zero_of_dvd {m n : Nat} (H : m n) : n % m = 0 := by
let z, H := H; rw [H, mul_mod_right]
theorem dvd_of_mod_eq_zero {m n : Nat} (H : n % m = 0) : m n := by
exists n / m
have := (mod_add_div n m).symm
rwa [H, Nat.zero_add] at this
theorem dvd_iff_mod_eq_zero (m n : Nat) : m n n % m = 0 :=
mod_eq_zero_of_dvd, dvd_of_mod_eq_zero
instance decidable_dvd : @DecidableRel Nat (··) :=
fun _ _ => decidable_of_decidable_of_iff (dvd_iff_mod_eq_zero _ _).symm
theorem emod_pos_of_not_dvd {a b : Nat} (h : ¬ a b) : 0 < b % a := by
rw [dvd_iff_mod_eq_zero] at h
exact Nat.pos_of_ne_zero h
protected theorem mul_div_cancel' {n m : Nat} (H : n m) : n * (m / n) = m := by
have := mod_add_div m n
rwa [mod_eq_zero_of_dvd H, Nat.zero_add] at this
protected theorem div_mul_cancel {n m : Nat} (H : n m) : m / n * n = m := by
rw [Nat.mul_comm, Nat.mul_div_cancel' H]
end Nat

View File

@@ -4,18 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Div
import Init.Data.Nat.Dvd
namespace Nat
private def gcdF (x : Nat) : ( x₁, x₁ < x Nat Nat) Nat Nat :=
match x with
| 0 => fun _ y => y
| succ x => fun f y => f (y % succ x) (mod_lt _ (zero_lt_succ _)) (succ x)
@[extern "lean_nat_gcd"]
def gcd (a b : @& Nat) : Nat :=
WellFounded.fix (measure id).wf gcdF a b
def gcd (m n : @& Nat) : Nat :=
if m = 0 then
n
else
gcd (n % m) m
termination_by m
decreasing_by simp_wf; apply mod_lt _ (zero_lt_of_ne_zero _); assumption
@[simp] theorem gcd_zero_left (y : Nat) : gcd 0 y = y :=
rfl
@@ -38,4 +38,35 @@ theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) :=
@[simp] theorem gcd_self (n : Nat) : gcd n n = n := by
cases n <;> simp [gcd_succ]
theorem gcd_rec (m n : Nat) : gcd m n = gcd (n % m) m :=
match m with
| 0 => by have := (mod_zero n).symm; rwa [gcd_zero_right]
| _ + 1 => by simp [gcd_succ]
@[elab_as_elim] theorem gcd.induction {P : Nat Nat Prop} (m n : Nat)
(H0 : n, P 0 n) (H1 : m n, 0 < m P (n % m) m P m n) : P m n :=
Nat.strongInductionOn (motive := fun m => n, P m n) m
(fun
| 0, _ => H0
| _+1, IH => fun _ => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) )
n
theorem gcd_dvd (m n : Nat) : (gcd m n m) (gcd m n n) := by
induction m, n using gcd.induction with
| H0 n => rw [gcd_zero_left]; exact Nat.dvd_zero n, Nat.dvd_refl n
| H1 m n _ IH => rw [ gcd_rec] at IH; exact IH.2, (dvd_mod_iff IH.2).1 IH.1
theorem gcd_dvd_left (m n : Nat) : gcd m n m := (gcd_dvd m n).left
theorem gcd_dvd_right (m n : Nat) : gcd m n n := (gcd_dvd m n).right
theorem gcd_le_left (n) (h : 0 < m) : gcd m n m := le_of_dvd h <| gcd_dvd_left m n
theorem gcd_le_right (n) (h : 0 < n) : gcd m n n := le_of_dvd h <| gcd_dvd_right m n
theorem dvd_gcd : k m k n k gcd m n := by
induction m, n using gcd.induction with intro km kn
| H0 n => rw [gcd_zero_left]; exact kn
| H1 n m _ IH => rw [gcd_rec]; exact IH ((dvd_mod_iff km).2 kn) km
end Nat

View File

@@ -5,8 +5,7 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Coe
import Init.Classical
import Init.SimpLemmas
import Init.ByCases
import Init.Data.Nat.Basic
import Init.Data.List.Basic
import Init.Data.Prod
@@ -539,13 +538,13 @@ theorem Expr.eq_of_toNormPoly (ctx : Context) (a b : Expr) (h : a.toNormPoly = b
theorem Expr.of_cancel_eq (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.toNormPoly b.toNormPoly = (c.toPoly, d.toPoly)) : (a.denote ctx = b.denote ctx) = (c.denote ctx = d.denote ctx) := by
have := Poly.denote_eq_cancel_eq ctx a.toNormPoly b.toNormPoly
rw [h] at this
simp [toNormPoly, Poly.norm, Poly.denote_eq] at this
simp [toNormPoly, Poly.norm, Poly.denote_eq, -eq_iff_iff] at this
exact this.symm
theorem Expr.of_cancel_le (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.toNormPoly b.toNormPoly = (c.toPoly, d.toPoly)) : (a.denote ctx b.denote ctx) = (c.denote ctx d.denote ctx) := by
have := Poly.denote_le_cancel_eq ctx a.toNormPoly b.toNormPoly
rw [h] at this
simp [toNormPoly, Poly.norm,Poly.denote_le] at this
simp [toNormPoly, Poly.norm,Poly.denote_le, -eq_iff_iff] at this
exact this.symm
theorem Expr.of_cancel_lt (ctx : Context) (a b c d : Expr) (h : Poly.cancel a.inc.toNormPoly b.toNormPoly = (c.inc.toPoly, d.toPoly)) : (a.denote ctx < b.denote ctx) = (c.denote ctx < d.denote ctx) :=
@@ -590,7 +589,7 @@ theorem PolyCnstr.denote_mul (ctx : Context) (k : Nat) (c : PolyCnstr) : (c.mul
have : (1 == (0 : Nat)) = false := rfl
have : (1 == (1 : Nat)) = true := rfl
by_cases he : eq = true <;> simp [he, PolyCnstr.mul, PolyCnstr.denote, Poly.denote_le, Poly.denote_eq]
<;> by_cases hk : k == 0 <;> (try simp [eq_of_beq hk]) <;> simp [*] <;> apply propext <;> apply Iff.intro <;> intro h
<;> by_cases hk : k == 0 <;> (try simp [eq_of_beq hk]) <;> simp [*] <;> apply Iff.intro <;> intro h
· exact Nat.eq_of_mul_eq_mul_left (Nat.zero_lt_succ _) h
· rw [h]
· exact Nat.le_of_mul_le_mul_left h (Nat.zero_lt_succ _)
@@ -637,20 +636,18 @@ theorem Poly.of_isNonZero (ctx : Context) {p : Poly} (h : isNonZero p = true) :
theorem PolyCnstr.eq_false_of_isUnsat (ctx : Context) {c : PolyCnstr} : c.isUnsat c.denote ctx = False := by
cases c; rename_i eq lhs rhs
simp [isUnsat]
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le]
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le, -and_imp]
· intro
| Or.inl h₁, h₂ => simp [Poly.of_isZero, h₁]; have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₂); simp [this.symm]
| Or.inr h₁, h₂ => simp [Poly.of_isZero, h₂]; have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₁); simp [this]
· intro h₁, h₂
simp [Poly.of_isZero, h₂]
have := Nat.not_eq_zero_of_lt (Poly.of_isNonZero ctx h₁)
simp [this]
done
exact Poly.of_isNonZero ctx h₁
theorem PolyCnstr.eq_true_of_isValid (ctx : Context) {c : PolyCnstr} : c.isValid c.denote ctx = True := by
cases c; rename_i eq lhs rhs
simp [isValid]
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le]
by_cases he : eq = true <;> simp [he, denote, Poly.denote_eq, Poly.denote_le, -and_imp]
· intro h₁, h₂
simp [Poly.of_isZero, h₁, h₂]
· intro h
@@ -658,12 +655,12 @@ theorem PolyCnstr.eq_true_of_isValid (ctx : Context) {c : PolyCnstr} : c.isValid
theorem ExprCnstr.eq_false_of_isUnsat (ctx : Context) (c : ExprCnstr) (h : c.toNormPoly.isUnsat) : c.denote ctx = False := by
have := PolyCnstr.eq_false_of_isUnsat ctx h
simp at this
simp [-eq_iff_iff] at this
assumption
theorem ExprCnstr.eq_true_of_isValid (ctx : Context) (c : ExprCnstr) (h : c.toNormPoly.isValid) : c.denote ctx = True := by
have := PolyCnstr.eq_true_of_isValid ctx h
simp at this
simp [-eq_iff_iff] at this
assumption
theorem Certificate.of_combineHyps (ctx : Context) (c : PolyCnstr) (cs : Certificate) (h : (combineHyps c cs).denote ctx False) : c.denote ctx cs.denote ctx := by
@@ -712,7 +709,7 @@ theorem Poly.denote_toExpr (ctx : Context) (p : Poly) : p.toExpr.denote ctx = p.
theorem ExprCnstr.eq_of_toNormPoly_eq (ctx : Context) (c d : ExprCnstr) (h : c.toNormPoly == d.toPoly) : c.denote ctx = d.denote ctx := by
have h := congrArg (PolyCnstr.denote ctx) (eq_of_beq h)
simp at h
simp [-eq_iff_iff] at h
assumption
theorem Expr.eq_of_toNormPoly_eq (ctx : Context) (e e' : Expr) (h : e.toNormPoly == e'.toPoly) : e.denote ctx = e'.denote ctx := by

View File

@@ -0,0 +1,51 @@
prelude
import Init.ByCases
namespace Nat
/-! # min lemmas -/
protected theorem min_eq_min (a : Nat) : Nat.min a b = min a b := rfl
protected theorem min_comm (a b : Nat) : min a b = min b a := by
match Nat.lt_trichotomy a b with
| .inl h => simp [Nat.min_def, h, Nat.le_of_lt, Nat.not_le_of_lt]
| .inr (.inl h) => simp [Nat.min_def, h]
| .inr (.inr h) => simp [Nat.min_def, h, Nat.le_of_lt, Nat.not_le_of_lt]
protected theorem min_le_right (a b : Nat) : min a b b := by
by_cases (a <= b) <;> simp [Nat.min_def, *]
protected theorem min_le_left (a b : Nat) : min a b a :=
Nat.min_comm .. Nat.min_le_right ..
protected theorem min_eq_left {a b : Nat} (h : a b) : min a b = a := if_pos h
protected theorem min_eq_right {a b : Nat} (h : b a) : min a b = b :=
Nat.min_comm .. Nat.min_eq_left h
protected theorem le_min_of_le_of_le {a b c : Nat} : a b a c a min b c := by
intros; cases Nat.le_total b c with
| inl h => rw [Nat.min_eq_left h]; assumption
| inr h => rw [Nat.min_eq_right h]; assumption
protected theorem le_min {a b c : Nat} : a min b c a b a c :=
fun h => Nat.le_trans h (Nat.min_le_left ..), Nat.le_trans h (Nat.min_le_right ..),
fun h₁, h₂ => Nat.le_min_of_le_of_le h₁ h₂
protected theorem lt_min {a b c : Nat} : a < min b c a < b a < c := Nat.le_min
/-! # max lemmas -/
protected theorem max_eq_max (a : Nat) : Nat.max a b = max a b := rfl
protected theorem max_comm (a b : Nat) : max a b = max b a := by
simp only [Nat.max_def]
by_cases h₁ : a b <;> by_cases h₂ : b a <;> simp [h₁, h₂]
· exact Nat.le_antisymm h₂ h₁
· cases not_or_intro h₁ h₂ <| Nat.le_total ..
protected theorem le_max_left ( a b : Nat) : a max a b := by
by_cases (a <= b) <;> simp [Nat.max_def, *]
protected theorem le_max_right (a b : Nat) : b max a b :=
Nat.max_comm .. Nat.le_max_left ..
end Nat

View File

@@ -8,6 +8,8 @@ import Init.Data.Nat.Linear
namespace Nat
protected theorem two_pow_pos (w : Nat) : 0 < 2^w := Nat.pos_pow_of_pos _ (by decide)
theorem nextPowerOfTwo_dec {n power : Nat} (h₁ : power > 0) (h₂ : power < n) : n - power * 2 < n - power := by
have : power * 2 = power + power := by simp_arith
rw [this, Nat.sub_add_eq]
@@ -21,8 +23,8 @@ where
go (power * 2) (Nat.mul_pos h (by decide))
else
power
termination_by go p h => n - p
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
termination_by n - power
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
def isPowerOfTwo (n : Nat) := k, n = 2 ^ k
@@ -48,7 +50,7 @@ where
split
. exact isPowerOfTwo_go (power*2) (Nat.mul_pos h₁ (by decide)) (Nat.mul2_isPowerOfTwo_of_isPowerOfTwo h₂)
. assumption
termination_by isPowerOfTwo_go p _ _ => n - p
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
termination_by n - power
decreasing_by simp_wf; apply nextPowerOfTwo_dec <;> assumption
end Nat

View File

@@ -6,7 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.Meta
import Init.Data.Float
import Init.Data.Nat
import Init.Data.Nat.Log2
/-- For decimal and scientific numbers (e.g., `1.23`, `3.12e10`).
Examples:

View File

@@ -12,16 +12,105 @@ inductive Ordering where
| lt | eq | gt
deriving Inhabited, BEq
namespace Ordering
deriving instance DecidableEq for Ordering
/-- Swaps less and greater ordering results -/
def swap : Ordering Ordering
| .lt => .gt
| .eq => .eq
| .gt => .lt
/--
If `o₁` and `o₂` are `Ordering`, then `o₁.then o₂` returns `o₁` unless it is `.eq`,
in which case it returns `o₂`. Additionally, it has "short-circuiting" semantics similar to
boolean `x && y`: if `o₁` is not `.eq` then the expression for `o₂` is not evaluated.
This is a useful primitive for constructing lexicographic comparator functions:
```
structure Person where
name : String
age : Nat
instance : Ord Person where
compare a b := (compare a.name b.name).then (compare b.age a.age)
```
This example will sort people first by name (in ascending order) and will sort people with
the same name by age (in descending order). (If all fields are sorted ascending and in the same
order as they are listed in the structure, you can also use `deriving Ord` on the structure
definition for the same effect.)
-/
@[macro_inline] def «then» : Ordering Ordering Ordering
| .eq, f => f
| o, _ => o
/--
Check whether the ordering is 'equal'.
-/
def isEq : Ordering Bool
| eq => true
| _ => false
/--
Check whether the ordering is 'not equal'.
-/
def isNe : Ordering Bool
| eq => false
| _ => true
/--
Check whether the ordering is 'less than or equal to'.
-/
def isLE : Ordering Bool
| gt => false
| _ => true
/--
Check whether the ordering is 'less than'.
-/
def isLT : Ordering Bool
| lt => true
| _ => false
/--
Check whether the ordering is 'greater than'.
-/
def isGT : Ordering Bool
| gt => true
| _ => false
/--
Check whether the ordering is 'greater than or equal'.
-/
def isGE : Ordering Bool
| lt => false
| _ => true
end Ordering
@[inline] def compareOfLessAndEq {α} (x y : α) [LT α] [Decidable (x < y)] [DecidableEq α] : Ordering :=
if x < y then Ordering.lt
else if x = y then Ordering.eq
else Ordering.gt
/--
Compare `a` and `b` lexicographically by `cmp₁` and `cmp₂`. `a` and `b` are
first compared by `cmp₁`. If this returns 'equal', `a` and `b` are compared
by `cmp₂` to break the tie.
-/
@[inline] def compareLex (cmp₁ cmp₂ : α β Ordering) (a : α) (b : β) : Ordering :=
(cmp₁ a b).then (cmp₂ a b)
class Ord (α : Type u) where
compare : α α Ordering
export Ord (compare)
@[inline] def compareOfLessAndEq {α} (x y : α) [LT α] [Decidable (x < y)] [DecidableEq α] : Ordering :=
if x < y then Ordering.lt
else if x = y then Ordering.eq
else Ordering.gt
/--
Compare `x` and `y` by comparing `f x` and `f y`.
-/
@[inline] def compareOn [ord : Ord β] (f : α β) (x y : α) : Ordering :=
compare (f x) (f y)
instance : Ord Nat where
compare x y := compareOfLessAndEq x y
@@ -71,13 +160,55 @@ def ltOfOrd [Ord α] : LT α where
instance [Ord α] : DecidableRel (@LT.lt α ltOfOrd) :=
inferInstanceAs (DecidableRel (fun a b => compare a b == Ordering.lt))
def Ordering.isLE : Ordering Bool
| Ordering.lt => true
| Ordering.eq => true
| Ordering.gt => false
def leOfOrd [Ord α] : LE α where
le a b := (compare a b).isLE
instance [Ord α] : DecidableRel (@LE.le α leOfOrd) :=
inferInstanceAs (DecidableRel (fun a b => (compare a b).isLE))
namespace Ord
/--
Derive a `BEq` instance from an `Ord` instance.
-/
protected def toBEq (ord : Ord α) : BEq α where
beq x y := ord.compare x y == .eq
/--
Derive an `LT` instance from an `Ord` instance.
-/
protected def toLT (_ : Ord α) : LT α :=
ltOfOrd
/--
Derive an `LE` instance from an `Ord` instance.
-/
protected def toLE (_ : Ord α) : LE α :=
leOfOrd
/--
Invert the order of an `Ord` instance.
-/
protected def opposite (ord : Ord α) : Ord α where
compare x y := ord.compare y x
/--
`ord.on f` compares `x` and `y` by comparing `f x` and `f y` according to `ord`.
-/
protected def on (ord : Ord β) (f : α β) : Ord α where
compare := compareOn f
/--
Derive the lexicographic order on products `α × β` from orders for `α` and `β`.
-/
protected def lex (_ : Ord α) (_ : Ord β) : Ord (α × β) :=
lexOrd
/--
Create an order which compares elements first by `ord₁` and then, if this
returns 'equal', by `ord₂`.
-/
protected def lex' (ord₁ ord₂ : Ord α) : Ord α where
compare := compareLex ord₁.compare ord₂.compare
end Ord

View File

@@ -76,10 +76,12 @@ macro_rules
end Range
end Std
theorem Membership.mem.upper {i : Nat} {r : Std.Range} (h : i r) : i < r.stop := by
simp [Membership.mem] at h
exact h.2
theorem Membership.mem.upper {i : Nat} {r : Std.Range} (h : i r) : i < r.stop := h.2
theorem Membership.mem.lower {i : Nat} {r : Std.Range} (h : i r) : r.start i := by
simp [Membership.mem] at h
exact h.1
theorem Membership.mem.lower {i : Nat} {r : Std.Range} (h : i r) : r.start i := h.1
theorem Membership.get_elem_helper {i n : Nat} {r : Std.Range} (h₁ : i r) (h₂ : r.stop = n) :
i < n := h₂ h₁.2
macro_rules
| `(tactic| get_elem_tactic_trivial) => `(tactic| apply Membership.get_elem_helper; assumption; rfl)

View File

@@ -159,7 +159,7 @@ def posOfAux (s : String) (c : Char) (stopPos : Pos) (pos : Pos) : Pos :=
have := Nat.sub_lt_sub_left h (lt_next s pos)
posOfAux s c stopPos (s.next pos)
else pos
termination_by _ => stopPos.1 - pos.1
termination_by stopPos.1 - pos.1
@[inline] def posOf (s : String) (c : Char) : Pos :=
posOfAux s c s.endPos 0
@@ -171,7 +171,7 @@ def revPosOfAux (s : String) (c : Char) (pos : Pos) : Option Pos :=
let pos := s.prev pos
if s.get pos == c then some pos
else revPosOfAux s c pos
termination_by _ => pos.1
termination_by pos.1
def revPosOf (s : String) (c : Char) : Option Pos :=
revPosOfAux s c s.endPos
@@ -183,7 +183,7 @@ def findAux (s : String) (p : Char → Bool) (stopPos : Pos) (pos : Pos) : Pos :
have := Nat.sub_lt_sub_left h (lt_next s pos)
findAux s p stopPos (s.next pos)
else pos
termination_by _ => stopPos.1 - pos.1
termination_by stopPos.1 - pos.1
@[inline] def find (s : String) (p : Char Bool) : Pos :=
findAux s p s.endPos 0
@@ -195,7 +195,7 @@ def revFindAux (s : String) (p : Char → Bool) (pos : Pos) : Option Pos :=
let pos := s.prev pos
if p (s.get pos) then some pos
else revFindAux s p pos
termination_by _ => pos.1
termination_by pos.1
def revFind (s : String) (p : Char Bool) : Option Pos :=
revFindAux s p s.endPos
@@ -213,8 +213,8 @@ def firstDiffPos (a b : String) : Pos :=
have := Nat.sub_lt_sub_left h (lt_next a i)
loop (a.next i)
else i
termination_by stopPos.1 - i.1
loop 0
termination_by loop => stopPos.1 - i.1
@[extern "lean_string_utf8_extract"]
def extract : (@& String) (@& Pos) (@& Pos) String
@@ -240,7 +240,7 @@ where
splitAux s p i' i' (s.extract b i :: r)
else
splitAux s p b (s.next i) r
termination_by _ => s.endPos.1 - i.1
termination_by s.endPos.1 - i.1
@[specialize] def split (s : String) (p : Char Bool) : List String :=
splitAux s p 0 0 []
@@ -260,7 +260,7 @@ def splitOnAux (s sep : String) (b : Pos) (i : Pos) (j : Pos) (r : List String)
splitOnAux s sep b i j r
else
splitOnAux s sep b (s.next i) 0 r
termination_by _ => s.endPos.1 - i.1
termination_by s.endPos.1 - i.1
def splitOn (s : String) (sep : String := " ") : List String :=
if sep == "" then [s] else splitOnAux s sep 0 0 0 []
@@ -369,7 +369,7 @@ def offsetOfPosAux (s : String) (pos : Pos) (i : Pos) (offset : Nat) : Nat :=
else
have := Nat.sub_lt_sub_left (Nat.gt_of_not_le (mt decide_eq_true h)) (lt_next s _)
offsetOfPosAux s pos (s.next i) (offset+1)
termination_by _ => s.endPos.1 - i.1
termination_by s.endPos.1 - i.1
def offsetOfPos (s : String) (pos : Pos) : Nat :=
offsetOfPosAux s pos 0 0
@@ -379,7 +379,7 @@ def offsetOfPos (s : String) (pos : Pos) : Nat :=
have := Nat.sub_lt_sub_left h (lt_next s i)
foldlAux f s stopPos (s.next i) (f a (s.get i))
else a
termination_by _ => stopPos.1 - i.1
termination_by stopPos.1 - i.1
@[inline] def foldl {α : Type u} (f : α Char α) (init : α) (s : String) : α :=
foldlAux f s s.endPos 0 init
@@ -392,7 +392,7 @@ termination_by _ => stopPos.1 - i.1
let a := f (s.get i) a
foldrAux f a s i begPos
else a
termination_by _ => i.1
termination_by i.1
@[inline] def foldr {α : Type u} (f : Char α α) (init : α) (s : String) : α :=
foldrAux f init s s.endPos 0
@@ -404,7 +404,7 @@ termination_by _ => i.1
have := Nat.sub_lt_sub_left h (lt_next s i)
anyAux s stopPos p (s.next i)
else false
termination_by _ => stopPos.1 - i.1
termination_by stopPos.1 - i.1
@[inline] def any (s : String) (p : Char Bool) : Bool :=
anyAux s s.endPos p 0
@@ -463,7 +463,7 @@ theorem mapAux_lemma (s : String) (i : Pos) (c : Char) (h : ¬s.atEnd i) :
have := mapAux_lemma s i c h
let s := s.set i c
mapAux f (s.next i) s
termination_by _ => s.endPos.1 - i.1
termination_by s.endPos.1 - i.1
@[inline] def map (f : Char Char) (s : String) : String :=
mapAux f 0 s
@@ -490,7 +490,7 @@ where
have := Nat.sub_lt_sub_left h (Nat.add_lt_add_left (one_le_csize c₁) off1.1)
c₁ == c₂ && loop (off1 + c₁) (off2 + c₂) stop1
else true
termination_by loop => stop1.1 - off1.1
termination_by stop1.1 - off1.1
/-- Return true iff `p` is a prefix of `s` -/
def isPrefixOf (p : String) (s : String) : Bool :=
@@ -512,8 +512,14 @@ def replace (s pattern replacement : String) : String :=
else
have := Nat.sub_lt_sub_left this (lt_next s pos)
loop acc accStop (s.next pos)
termination_by s.endPos.1 - pos.1
loop "" 0 0
termination_by loop => s.endPos.1 - pos.1
/-- Return the beginning of the line that contains character `pos`. -/
def findLineStart (s : String) (pos : String.Pos) : String.Pos :=
match s.revFindAux (· = '\n') pos with
| none => 0
| some n => n.byteIdx + 1
end String
@@ -612,8 +618,8 @@ def splitOn (s : Substring) (sep : String := " ") : List Substring :=
else
s.extract b i :: r
r.reverse
termination_by s.bsize - i.1
loop 0 0 0 []
termination_by loop => s.bsize - i.1
@[inline] def foldl {α : Type u} (f : α Char α) (init : α) (s : Substring) : α :=
match s with
@@ -640,7 +646,7 @@ def contains (s : Substring) (c : Char) : Bool :=
takeWhileAux s stopPos p (s.next i)
else i
else i
termination_by _ => stopPos.1 - i.1
termination_by stopPos.1 - i.1
@[inline] def takeWhile : Substring (Char Bool) Substring
| s, b, e, p =>
@@ -661,7 +667,7 @@ termination_by _ => stopPos.1 - i.1
if !p c then i
else takeRightWhileAux s begPos p i'
else i
termination_by _ => i.1
termination_by i.1
@[inline] def takeRightWhile : Substring (Char Bool) Substring
| s, b, e, p =>

View File

@@ -5,7 +5,6 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Fin.Basic
import Init.System.Platform
open Nat
@@ -39,7 +38,7 @@ def UInt8.shiftRight (a b : UInt8) : UInt8 := ⟨a.val >>> (modn b 8).val⟩
def UInt8.lt (a b : UInt8) : Prop := a.val < b.val
def UInt8.le (a b : UInt8) : Prop := a.val b.val
instance : OfNat UInt8 n := UInt8.ofNat n
instance UInt8.instOfNat : OfNat UInt8 n := UInt8.ofNat n
instance : Add UInt8 := UInt8.add
instance : Sub UInt8 := UInt8.sub
instance : Mul UInt8 := UInt8.mul
@@ -110,8 +109,7 @@ def UInt16.shiftRight (a b : UInt16) : UInt16 := ⟨a.val >>> (modn b 16).val⟩
def UInt16.lt (a b : UInt16) : Prop := a.val < b.val
def UInt16.le (a b : UInt16) : Prop := a.val b.val
instance : OfNat UInt16 n := UInt16.ofNat n
instance UInt16.instOfNat : OfNat UInt16 n := UInt16.ofNat n
instance : Add UInt16 := UInt16.add
instance : Sub UInt16 := UInt16.sub
instance : Mul UInt16 := UInt16.mul
@@ -152,6 +150,14 @@ instance : Min UInt16 := minOfLe
def UInt32.ofNat (n : @& Nat) : UInt32 := Fin.ofNat n
@[extern "lean_uint32_of_nat"]
def UInt32.ofNat' (n : Nat) (h : n < UInt32.size) : UInt32 := n, h
/--
Converts the given natural number to `UInt32`, but returns `2^32 - 1` for natural numbers `>= 2^32`.
-/
def UInt32.ofNatTruncate (n : Nat) : UInt32 :=
if h : n < UInt32.size then
UInt32.ofNat' n h
else
UInt32.ofNat' (UInt32.size - 1) (by decide)
abbrev Nat.toUInt32 := UInt32.ofNat
@[extern "lean_uint32_add"]
def UInt32.add (a b : UInt32) : UInt32 := a.val + b.val
@@ -184,7 +190,7 @@ def UInt8.toUInt32 (a : UInt8) : UInt32 := a.toNat.toUInt32
@[extern "lean_uint16_to_uint32"]
def UInt16.toUInt32 (a : UInt16) : UInt32 := a.toNat.toUInt32
instance : OfNat UInt32 n := UInt32.ofNat n
instance UInt32.instOfNat : OfNat UInt32 n := UInt32.ofNat n
instance : Add UInt32 := UInt32.add
instance : Sub UInt32 := UInt32.sub
instance : Mul UInt32 := UInt32.mul
@@ -244,7 +250,7 @@ def UInt16.toUInt64 (a : UInt16) : UInt64 := a.toNat.toUInt64
@[extern "lean_uint32_to_uint64"]
def UInt32.toUInt64 (a : UInt32) : UInt64 := a.toNat.toUInt64
instance : OfNat UInt64 n := UInt64.ofNat n
instance UInt64.instOfNat : OfNat UInt64 n := UInt64.ofNat n
instance : Add UInt64 := UInt64.add
instance : Sub UInt64 := UInt64.sub
instance : Mul UInt64 := UInt64.mul
@@ -322,7 +328,7 @@ def USize.toUInt32 (a : USize) : UInt32 := a.toNat.toUInt32
def USize.lt (a b : USize) : Prop := a.val < b.val
def USize.le (a b : USize) : Prop := a.val b.val
instance : OfNat USize n := USize.ofNat n
instance USize.instOfNat : OfNat USize n := USize.ofNat n
instance : Add USize := USize.add
instance : Sub USize := USize.sub
instance : Mul USize := USize.mul

113
src/Init/Ext.lean Normal file
View File

@@ -0,0 +1,113 @@
/-
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Mario Carneiro
-/
prelude
import Init.TacticsExtra
import Init.RCases
namespace Lean
namespace Parser.Attr
/-- Registers an extensionality theorem.
* When `@[ext]` is applied to a structure, it generates `.ext` and `.ext_iff` theorems and registers
them for the `ext` tactic.
* When `@[ext]` is applied to a theorem, the theorem is registered for the `ext` tactic.
* An optional natural number argument, e.g. `@[ext 9000]`, specifies a priority for the lemma. Higher-priority lemmas are chosen first, and the default is `1000`.
* The flag `@[ext (flat := false)]` causes generated structure extensionality theorems to show inherited fields based on their representation,
rather than flattening the parents' fields into the lemma's equality hypotheses.
structures in the generated extensionality theorems. -/
syntax (name := ext) "ext" (" (" &"flat" " := " term ")")? (ppSpace prio)? : attr
end Parser.Attr
-- TODO: rename this namespace?
-- Remark: `ext` has scoped syntax, Mathlib may depend on the actual namespace name.
namespace Elab.Tactic.Ext
/--
Creates the type of the extensionality theorem for the given structure,
elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example.
-/
scoped syntax (name := extType) "ext_type% " term:max ppSpace ident : term
/--
Creates the type of the iff-variant of the extensionality theorem for the given structure,
elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example.
-/
scoped syntax (name := extIffType) "ext_iff_type% " term:max ppSpace ident : term
/--
`declare_ext_theorems_for A` declares the extensionality theorems for the structure `A`.
These theorems state that two expressions with the structure type are equal if their fields are equal.
-/
syntax (name := declareExtTheoremFor) "declare_ext_theorems_for " ("(" &"flat" " := " term ") ")? ident (ppSpace prio)? : command
macro_rules | `(declare_ext_theorems_for $[(flat := $f)]? $struct:ident $(prio)?) => do
let flat := f.getD (mkIdent `true)
let names Macro.resolveGlobalName struct.getId.eraseMacroScopes
let name match names.filter (·.2.isEmpty) with
| [] => Macro.throwError s!"unknown constant {struct.getId}"
| [(name, _)] => pure name
| _ => Macro.throwError s!"ambiguous name {struct.getId}"
let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext"
let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff"
`(@[ext $(prio)?] protected theorem $extName:ident : ext_type% $flat $struct:ident :=
fun {..} {..} => by intros; subst_eqs; rfl
protected theorem $extIffName:ident : ext_iff_type% $flat $struct:ident :=
fun {..} {..} =>
fun h => by cases h; and_intros <;> rfl,
fun _ => by (repeat cases _ _); subst_eqs; rfl)
/--
Applies extensionality lemmas that are registered with the `@[ext]` attribute.
* `ext pat*` applies extensionality theorems as much as possible,
using the patterns `pat*` to introduce the variables in extensionality theorems using `rintro`.
For example, the patterns are used to name the variables introduced by lemmas such as `funext`.
* Without patterns,`ext` applies extensionality lemmas as much
as possible but introduces anonymous hypotheses whenever needed.
* `ext pat* : n` applies ext theorems only up to depth `n`.
The `ext1 pat*` tactic is like `ext pat*` except that it only applies a single extensionality theorem.
Unused patterns will generate warning.
Patterns that don't match the variables will typically result in the introduction of anonymous hypotheses.
-/
syntax (name := ext) "ext" (colGt ppSpace rintroPat)* (" : " num)? : tactic
/-- Apply a single extensionality theorem to the current goal. -/
syntax (name := applyExtTheorem) "apply_ext_theorem" : tactic
/--
`ext1 pat*` is like `ext pat*` except that it only applies a single extensionality theorem rather
than recursively applying as many extensionality theorems as possible.
The `pat*` patterns are processed using the `rintro` tactic.
If no patterns are supplied, then variables are introduced anonymously using the `intros` tactic.
-/
macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic =>
if xs.isEmpty then `(tactic| apply_ext_theorem <;> intros)
else `(tactic| apply_ext_theorem <;> rintro $xs*)
end Elab.Tactic.Ext
end Lean
attribute [ext] funext propext Subtype.eq
@[ext] theorem Prod.ext : {x y : Prod α β} x.fst = y.fst x.snd = y.snd x = y
| _,_, _,_, rfl, rfl => rfl
@[ext] theorem PProd.ext : {x y : PProd α β} x.fst = y.fst x.snd = y.snd x = y
| _,_, _,_, rfl, rfl => rfl
@[ext] theorem Sigma.ext : {x y : Sigma β} x.fst = y.fst HEq x.snd y.snd x = y
| _,_, _,_, rfl, .rfl => rfl
@[ext] theorem PSigma.ext : {x y : PSigma β} x.fst = y.fst HEq x.snd y.snd x = y
| _,_, _,_, rfl, .rfl => rfl
@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl
protected theorem Unit.ext (x y : Unit) : x = y := rfl

129
src/Init/Guard.lean Normal file
View File

@@ -0,0 +1,129 @@
/-
Copyright (c) 2021 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
prelude
import Init.Tactics
import Init.Conv
import Init.NotationExtra
namespace Lean.Parser
/-- Reducible defeq matching for `guard_hyp` types -/
syntax colonR := " : "
/-- Default-reducibility defeq matching for `guard_hyp` types -/
syntax colonD := " :~ "
/-- Syntactic matching for `guard_hyp` types -/
syntax colonS := " :ₛ "
/-- Alpha-eq matching for `guard_hyp` types -/
syntax colonA := " :ₐ "
/-- The `guard_hyp` type specifier, one of `:`, `:~`, `:ₛ`, `:ₐ` -/
syntax colon := colonR <|> colonD <|> colonS <|> colonA
/-- Reducible defeq matching for `guard_hyp` values -/
syntax colonEqR := " := "
/-- Default-reducibility defeq matching for `guard_hyp` values -/
syntax colonEqD := " :=~ "
/-- Syntactic matching for `guard_hyp` values -/
syntax colonEqS := " :=ₛ "
/-- Alpha-eq matching for `guard_hyp` values -/
syntax colonEqA := " :=ₐ "
/-- The `guard_hyp` value specifier, one of `:=`, `:=~`, `:=ₛ`, `:=ₐ` -/
syntax colonEq := colonEqR <|> colonEqD <|> colonEqS <|> colonEqA
/-- Reducible defeq matching for `guard_expr` -/
syntax equalR := " = "
/-- Default-reducibility defeq matching for `guard_expr` -/
syntax equalD := " =~ "
/-- Syntactic matching for `guard_expr` -/
syntax equalS := " =ₛ "
/-- Alpha-eq matching for `guard_expr` -/
syntax equalA := " =ₐ "
/-- The `guard_expr` matching specifier, one of `=`, `=~`, `=ₛ`, `=ₐ` -/
syntax equal := equalR <|> equalD <|> equalS <|> equalA
namespace Tactic
/--
Tactic to check equality of two expressions.
* `guard_expr e = e'` checks that `e` and `e'` are defeq at reducible transparency.
* `guard_expr e =~ e'` checks that `e` and `e'` are defeq at default transparency.
* `guard_expr e =ₛ e'` checks that `e` and `e'` are syntactically equal.
* `guard_expr e =ₐ e'` checks that `e` and `e'` are alpha-equivalent.
Both `e` and `e'` are elaborated then have their metavariables instantiated before the equality
check. Their types are unified (using `isDefEqGuarded`) before synthetic metavariables are
processed, which helps with default instance handling.
-/
syntax (name := guardExpr) "guard_expr " term:51 equal term : tactic
@[inherit_doc guardExpr]
syntax (name := guardExprConv) "guard_expr " term:51 equal term : conv
/--
Tactic to check that the target agrees with a given expression.
* `guard_target = e` checks that the target is defeq at reducible transparency to `e`.
* `guard_target =~ e` checks that the target is defeq at default transparency to `e`.
* `guard_target =ₛ e` checks that the target is syntactically equal to `e`.
* `guard_target =ₐ e` checks that the target is alpha-equivalent to `e`.
The term `e` is elaborated with the type of the goal as the expected type, which is mostly
useful within `conv` mode.
-/
syntax (name := guardTarget) "guard_target " equal term : tactic
@[inherit_doc guardTarget]
syntax (name := guardTargetConv) "guard_target " equal term : conv
/--
Tactic to check that a named hypothesis has a given type and/or value.
* `guard_hyp h : t` checks the type up to reducible defeq,
* `guard_hyp h :~ t` checks the type up to default defeq,
* `guard_hyp h :ₛ t` checks the type up to syntactic equality,
* `guard_hyp h :ₐ t` checks the type up to alpha equality.
* `guard_hyp h := v` checks value up to reducible defeq,
* `guard_hyp h :=~ v` checks value up to default defeq,
* `guard_hyp h :=ₛ v` checks value up to syntactic equality,
* `guard_hyp h :=ₐ v` checks the value up to alpha equality.
The value `v` is elaborated using the type of `h` as the expected type.
-/
syntax (name := guardHyp)
"guard_hyp " term:max (colon term)? (colonEq term)? : tactic
@[inherit_doc guardHyp] syntax (name := guardHypConv)
"guard_hyp " term:max (colon term)? (colonEq term)? : conv
end Tactic
namespace Command
/--
Command to check equality of two expressions.
* `#guard_expr e = e'` checks that `e` and `e'` are defeq at reducible transparency.
* `#guard_expr e =~ e'` checks that `e` and `e'` are defeq at default transparency.
* `#guard_expr e =ₛ e'` checks that `e` and `e'` are syntactically equal.
* `#guard_expr e =ₐ e'` checks that `e` and `e'` are alpha-equivalent.
This is a command version of the `guard_expr` tactic. -/
syntax (name := guardExprCmd) "#guard_expr " term:51 equal term : command
/--
Command to check that an expression evaluates to `true`.
`#guard e` elaborates `e` ensuring its type is `Bool` then evaluates `e` and checks that
the result is `true`. The term is elaborated *without* variables declared using `variable`, since
these cannot be evaluated.
Since this makes use of coercions, so long as a proposition `p` is decidable, one can write
`#guard p` rather than `#guard decide p`. A consequence to this is that if there is decidable
equality one can write `#guard a = b`. Note that this is not exactly the same as checking
if `a` and `b` evaluate to the same thing since it uses the `DecidableEq` instance to do
the evaluation.
Note: this uses the untrusted evaluator, so `#guard` passing is *not* a proof that the
expression equals `true`. -/
syntax (name := guardCmd) "#guard " term : command
end Command
end Lean.Parser

View File

@@ -563,8 +563,17 @@ def SepArray.ofElemsUsingRef [Monad m] [MonadRef m] {sep} (elems : Array Syntax)
instance : Coe (Array Syntax) (SepArray sep) where
coe := SepArray.ofElems
/--
Constructs a typed separated array from elements.
The given array does not include the separators.
Like `Syntax.SepArray.ofElems` but for typed syntax.
-/
def TSepArray.ofElems {sep} (elems : Array (TSyntax k)) : TSepArray k sep :=
.mk (SepArray.ofElems (sep := sep) (TSyntaxArray.raw elems)).1
instance : Coe (TSyntaxArray k) (TSepArray k sep) where
coe a := mkSepArray a.raw (mkAtom sep)
coe := TSepArray.ofElems
/-- Create syntax representing a Lean term application, but avoid degenerate empty applications. -/
def mkApp (fn : Term) : (args : TSyntaxArray `term) Term
@@ -1039,7 +1048,7 @@ where
go (i+1) (args.push (quote xs[i]))
else
Syntax.mkCApp (Name.mkStr2 "Array" ("mkArray" ++ toString xs.size)) args
termination_by go i _ => xs.size - i
termination_by xs.size - i
instance [Quote α `term] : Quote (Array α) `term where
quote := quoteArray

View File

@@ -268,6 +268,7 @@ syntax (name := rawNatLit) "nat_lit " num : term
@[inherit_doc] infixr:90 "" => Function.comp
@[inherit_doc] infixr:35 " × " => Prod
@[inherit_doc] infix:50 " " => Dvd.dvd
@[inherit_doc] infixl:55 " ||| " => HOr.hOr
@[inherit_doc] infixl:58 " ^^^ " => HXor.hXor
@[inherit_doc] infixl:60 " &&& " => HAnd.hAnd
@@ -463,6 +464,14 @@ macro "without_expected_type " x:term : term => `(let aux := $x; aux)
namespace Lean
/--
* The `by_elab doSeq` expression runs the `doSeq` as a `TermElabM Expr` to
synthesize the expression.
* `by_elab fun expectedType? => do doSeq` receives the expected type (an `Option Expr`)
as well.
-/
syntax (name := byElab) "by_elab " doSeq : term
/--
Category for carrying raw syntax trees between macros; any content is printed as is by the pretty printer.
The only accepted parser for this category is an antiquotation.
@@ -484,9 +493,39 @@ existing code. It may be removed in a future version of the library.
-/
syntax (name := deprecated) "deprecated" (ppSpace ident)? : attr
/--
The `@[coe]` attribute on a function (which should also appear in a
`instance : Coe A B := ⟨myFn⟩` declaration) allows the delaborator to show
applications of this function as `↑` when printing expressions.
-/
syntax (name := Attr.coe) "coe" : attr
/--
When `parent_dir` contains the current Lean file, `include_str "path" / "to" / "file"` becomes
a string literal with the contents of the file at `"parent_dir" / "path" / "to" / "file"`. If this
file cannot be read, elaboration fails.
-/
syntax (name := includeStr) "include_str " term : term
/--
The `run_cmd doSeq` command executes code in `CommandElabM Unit`.
This is almost the same as `#eval show CommandElabM Unit from do doSeq`,
except that it doesn't print an empty diagnostic.
-/
syntax (name := runCmd) "run_cmd " doSeq : command
/--
The `run_elab doSeq` command executes code in `TermElabM Unit`.
This is almost the same as `#eval show TermElabM Unit from do doSeq`,
except that it doesn't print an empty diagnostic.
-/
syntax (name := runElab) "run_elab " doSeq : command
/--
The `run_meta doSeq` command executes code in `MetaM Unit`.
This is almost the same as `#eval show MetaM Unit from do doSeq`,
except that it doesn't print an empty diagnostic.
(This is effectively a synonym for `run_elab`.)
-/
syntax (name := runMeta) "run_meta " doSeq : command

View File

@@ -170,6 +170,19 @@ See [Theorem Proving in Lean 4][tpil4] for more information.
-/
syntax (name := calcTactic) "calc" calcSteps : tactic
/--
Denotes a term that was omitted by the pretty printer.
This is only used for pretty printing, and it cannot be elaborated.
The presence of `⋯` is controlled by the `pp.deepTerms` and `pp.proofs` options.
-/
syntax "" : term
macro_rules | `() => Macro.throwError "\
Error: The '⋯' token is used by the pretty printer to indicate omitted terms, \
and it cannot be elaborated.\
\n\nIts presence in pretty printing output is controlled by the 'pp.deepTerms' and `pp.proofs` options. \
These options can be further adjusted using `pp.deepTerms.threshold` and `pp.proofs.threshold`."
@[app_unexpander Unit.unit] def unexpandUnit : Lean.PrettyPrinter.Unexpander
| `($(_)) => `(())
@@ -177,9 +190,13 @@ syntax (name := calcTactic) "calc" calcSteps : tactic
| `($(_)) => `([])
@[app_unexpander List.cons] def unexpandListCons : Lean.PrettyPrinter.Unexpander
| `($(_) $x []) => `([$x])
| `($(_) $x [$xs,*]) => `([$x, $xs,*])
| _ => throw ()
| `($(_) $x $tail) =>
match tail with
| `([]) => `([$x])
| `([$xs,*]) => `([$x, $xs,*])
| `() => `([$x, $tail]) -- Unexpands to `[x, y, z, ⋯]` for `⋯ : List α`
| _ => throw ()
| _ => throw ()
@[app_unexpander List.toArray] def unexpandListToArray : Lean.PrettyPrinter.Unexpander
| `($(_) [$xs,*]) => `(#[$xs,*])
@@ -373,6 +390,23 @@ macro_rules
`($mods:declModifiers class $id $params* extends $parents,* $[: $ty]?
attribute [instance] $ctor)
macro_rules
| `(haveI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) =>
`(haveI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body)
| `(haveI _ $bs* := $val; $body) => `(haveI x $bs* : _ := $val; $body)
| `(haveI _ $bs* : $ty := $val; $body) => `(haveI x $bs* : $ty := $val; $body)
| `(haveI $x:ident $bs* := $val; $body) => `(haveI $x $bs* : _ := $val; $body)
| `(haveI $_:ident $_* : $_ := $_; $_) => Lean.Macro.throwUnsupported -- handled by elab
macro_rules
| `(letI $hy:hygieneInfo $bs* $[: $ty]? := $val; $body) =>
`(letI $(HygieneInfo.mkIdent hy `this (canonical := true)) $bs* $[: $ty]? := $val; $body)
| `(letI _ $bs* := $val; $body) => `(letI x $bs* : _ := $val; $body)
| `(letI _ $bs* : $ty := $val; $body) => `(letI x $bs* : $ty := $val; $body)
| `(letI $x:ident $bs* := $val; $body) => `(letI $x $bs* : _ := $val; $body)
| `(letI $_:ident $_* : $_ := $_; $_) => Lean.Macro.throwUnsupported -- handled by elab
syntax cdotTk := patternIgnore("· " <|> ". ")
/-- `· tac` focuses on the main goal and tries to solve it using `tac`, or else fails. -/
syntax (name := cdot) cdotTk tacticSeqIndentGt : tactic

View File

@@ -9,9 +9,9 @@ set_option linter.missingDocs true -- keep it documented
/-!
# Init.Prelude
This is the first file in the lean import hierarchy. It is responsible for setting
up basic definitions, most of which lean already has "built in knowledge" about,
so it is important that they be set up in exactly this way. (For example, lean will
This is the first file in the Lean import hierarchy. It is responsible for setting
up basic definitions, most of which Lean already has "built in knowledge" about,
so it is important that they be set up in exactly this way. (For example, Lean will
use `PUnit` in the desugaring of `do` notation, or in the pattern match compiler.)
-/
@@ -24,7 +24,7 @@ The identity function. `id` takes an implicit argument `α : Sort u`
Although this may look like a useless function, one application of the identity
function is to explicitly put a type on an expression. If `e` has type `T`,
and `T'` is definitionally equal to `T`, then `@id T' e` typechecks, and lean
and `T'` is definitionally equal to `T`, then `@id T' e` typechecks, and Lean
knows that this expression has type `T'` rather than `T`. This can make a
difference for typeclass inference, since `T` and `T'` may have different
typeclass instances on them. `show T' from e` is sugar for an `@id T' e`
@@ -287,9 +287,9 @@ inductive Eq : αα → Prop where
same as `Eq.refl` except that it takes `a` implicitly instead of explicitly.
This is a more powerful theorem than it may appear at first, because although
the statement of the theorem is `a = a`, lean will allow anything that is
the statement of the theorem is `a = a`, Lean will allow anything that is
definitionally equal to that type. So, for instance, `2 + 2 = 4` is proven in
lean by `rfl`, because both sides are the same up to definitional equality.
Lean by `rfl`, because both sides are the same up to definitional equality.
-/
@[match_pattern] def rfl {α : Sort u} {a : α} : Eq a a := Eq.refl a
@@ -548,6 +548,11 @@ theorem Or.elim {c : Prop} (h : Or a b) (left : a → c) (right : b → c) : c :
| Or.inl h => left h
| Or.inr h => right h
theorem Or.resolve_left (h: Or a b) (na : Not a) : b := h.elim (absurd · na) id
theorem Or.resolve_right (h: Or a b) (nb : Not b) : a := h.elim id (absurd · nb)
theorem Or.neg_resolve_left (h : Or (Not a) b) (ha : a) : b := h.elim (absurd ha) id
theorem Or.neg_resolve_right (h : Or a (Not b)) (nb : b) : a := h.elim id (absurd nb)
/--
`Bool` is the type of boolean values, `true` and `false`. Classically,
this is equivalent to `Prop` (the type of propositions), but the distinction
@@ -597,7 +602,7 @@ For example, the `Membership` class is defined as:
class Membership (α : outParam (Type u)) (γ : Type v)
```
This means that whenever a typeclass goal of the form `Membership ?α ?γ` comes
up, lean will wait to solve it until `?γ` is known, but then it will run
up, Lean will wait to solve it until `?γ` is known, but then it will run
typeclass inference, and take the first solution it finds, for any value of `?α`,
which thereby determines what `?α` should be.
@@ -712,13 +717,13 @@ nonempty, then `fun i => Classical.choice (h i) : ∀ i, α i` is a family of
chosen elements. This is actually a bit stronger than the ZFC choice axiom;
this is sometimes called "[global choice](https://en.wikipedia.org/wiki/Axiom_of_global_choice)".
In lean, we use the axiom of choice to derive the law of excluded middle
In Lean, we use the axiom of choice to derive the law of excluded middle
(see `Classical.em`), so it will often show up in axiom listings where you
may not expect. You can use `#print axioms my_thm` to find out if a given
theorem depends on this or other axioms.
This axiom can be used to construct "data", but obviously there is no algorithm
to compute it, so lean will require you to mark any definition that would
to compute it, so Lean will require you to mark any definition that would
involve executing `Classical.choice` or other axioms as `noncomputable`, and
will not produce any executable code for such definitions.
-/
@@ -943,7 +948,7 @@ determines how to evaluate `c` to true or false. Write `if h : c then t else e`
instead for a "dependent if-then-else" `dite`, which allows `t`/`e` to use the fact
that `c` is true/false.
Because lean uses a strict (call-by-value) evaluation strategy, the signature of this
Because Lean uses a strict (call-by-value) evaluation strategy, the signature of this
function is problematic in that it would require `t` and `e` to be evaluated before
calling the `ite` function, which would cause both sides of the `if` to be evaluated.
Even if the result is discarded, this would be a big performance problem,
@@ -1033,7 +1038,7 @@ You can prove a theorem `P n` about `n : Nat` by `induction n`, which will
expect a proof of the theorem for `P 0`, and a proof of `P (succ i)` assuming
a proof of `P i`. The same method also works to define functions by recursion
on natural numbers: induction and recursion are two expressions of the same
operation from lean's point of view.
operation from Lean's point of view.
```
open Nat
@@ -1069,14 +1074,14 @@ instance : Inhabited Nat where
/--
The class `OfNat α n` powers the numeric literal parser. If you write
`37 : α`, lean will attempt to synthesize `OfNat α 37`, and will generate
`37 : α`, Lean will attempt to synthesize `OfNat α 37`, and will generate
the term `(OfNat.ofNat 37 : α)`.
There is a bit of infinite regress here since the desugaring apparently
still contains a literal `37` in it. The type of expressions contains a
primitive constructor for "raw natural number literals", which you can directly
access using the macro `nat_lit 37`. Raw number literals are always of type `Nat`.
So it would be more correct to say that lean looks for an instance of
So it would be more correct to say that Lean looks for an instance of
`OfNat α (nat_lit 37)`, and it generates the term `(OfNat.ofNat (nat_lit 37) : α)`.
-/
class OfNat (α : Type u) (_ : Nat) where
@@ -1314,6 +1319,11 @@ class Mod (α : Type u) where
/-- `a % b` computes the remainder upon dividing `a` by `b`. See `HMod`. -/
mod : α α α
/-- Notation typeclass for the `` operation (typed as `\|`), which represents divisibility. -/
class Dvd (α : Type _) where
/-- Divisibility. `a b` (typed as `\|`) means that there is some `c` such that `b = a * c`. -/
dvd : α α Prop
/--
The homogeneous version of `HPow`: `a ^ b : α` where `a : α`, `b : β`.
(The right argument is not the same as the left since we often want this even
@@ -1780,7 +1790,7 @@ Gets the word size of the platform. That is, whether the platform is 64 or 32 bi
This function is opaque because we cannot guarantee at compile time that the target
will have the same size as the host, and also because we would like to avoid
typechecking being architecture-dependent. Nevertheless, lean only works on
typechecking being architecture-dependent. Nevertheless, Lean only works on
64 and 32 bit systems so we can encode this as a fact available for proof purposes.
-/
@[extern "lean_system_platform_nbits"] opaque System.Platform.getNumBits : Unit Subtype fun (n : Nat) => Or (Eq n 32) (Eq n 64) :=
@@ -2518,7 +2528,7 @@ attribute [nospecialize] Inhabited
/--
The class `GetElem cont idx elem dom` implements the `xs[i]` notation.
When you write this, given `xs : cont` and `i : idx`, lean looks for an instance
When you write this, given `xs : cont` and `i : idx`, Lean looks for an instance
of `GetElem cont idx elem dom`. Here `elem` is the type of `xs[i]`, while
`dom` is whatever proof side conditions are required to make this applicable.
For example, the instance for arrays looks like
@@ -2558,7 +2568,7 @@ export GetElem (getElem)
with elements from `α`. This type has special support in the runtime.
An array has a size and a capacity; the size is `Array.size` but the capacity
is not observable from lean code. Arrays perform best when unshared; as long
is not observable from Lean code. Arrays perform best when unshared; as long
as they are used "linearly" all updates will be performed destructively on the
array, so it has comparable performance to mutable arrays in imperative
programming languages.
@@ -3231,7 +3241,7 @@ instance (σ : Type u) (m : Type u → Type v) [MonadStateOf σ m] : MonadState
/--
`modify (f : σσ)` applies the function `f` to the state.
It is equivalent to `do put (f (← get))`, but `modify f` may be preferable
It is equivalent to `do set (f (← get))`, but `modify f` may be preferable
because the former does not use the state linearly (without sufficient inlining).
-/
@[always_inline, inline]

437
src/Init/PropLemmas.lean Normal file
View File

@@ -0,0 +1,437 @@
/-
Copyright (c) 2024 Lean FRO. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn, Mario Carneiro
This provides additional lemmas about propositional types beyond what is
needed for Core and SimpLemmas.
-/
prelude
import Init.Core
import Init.NotationExtra
set_option linter.missingDocs true -- keep it documented
/-! ## not -/
theorem not_not_em (a : Prop) : ¬¬(a ¬a) := fun h => h (.inr (h .inl))
/-! ## and -/
theorem and_self_iff : a a a := Iff.of_eq (and_self a)
theorem and_not_self_iff (a : Prop) : a ¬a False := iff_false_intro and_not_self
theorem not_and_self_iff (a : Prop) : ¬a a False := iff_false_intro not_and_self
theorem And.imp (f : a c) (g : b d) (h : a b) : c d := And.intro (f h.left) (g h.right)
theorem And.imp_left (h : a b) : a c b c := .imp h id
theorem And.imp_right (h : a b) : c a c b := .imp id h
theorem and_congr (h₁ : a c) (h₂ : b d) : a b c d :=
Iff.intro (And.imp h₁.mp h₂.mp) (And.imp h₁.mpr h₂.mpr)
theorem and_congr_left' (h : a b) : a c b c := and_congr h .rfl
theorem and_congr_right' (h : b c) : a b a c := and_congr .rfl h
theorem not_and_of_not_left (b : Prop) : ¬a ¬(a b) := mt And.left
theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b ¬(a b) := mt And.right
theorem and_congr_right_eq (h : a b = c) : (a b) = (a c) :=
propext (and_congr_right (Iff.of_eq h))
theorem and_congr_left_eq (h : c a = b) : (a c) = (b c) :=
propext (and_congr_left (Iff.of_eq h))
theorem and_left_comm : a b c b a c :=
Iff.intro (fun ha, hb, hc => hb, ha, hc)
(fun hb, ha, hc => ha, hb, hc)
theorem and_right_comm : (a b) c (a c) b :=
Iff.intro (fun ha, hb, hc => ha, hc, hb)
(fun ha, hc, hb => ha, hb, hc)
theorem and_rotate : a b c b c a := by rw [and_left_comm, @and_comm a c]
theorem and_and_and_comm : (a b) c d (a c) b d := by rw [ and_assoc, @and_right_comm a, and_assoc]
theorem and_and_left : a (b c) (a b) a c := by rw [and_and_and_comm, and_self]
theorem and_and_right : (a b) c (a c) b c := by rw [and_and_and_comm, and_self]
theorem and_iff_left (hb : b) : a b a := Iff.intro And.left (And.intro · hb)
theorem and_iff_right (ha : a) : a b b := Iff.intro And.right (And.intro ha ·)
/-! ## or -/
theorem or_self_iff : a a a := or_self _ .rfl
theorem not_or_intro {a b : Prop} (ha : ¬a) (hb : ¬b) : ¬(a b) := (·.elim ha hb)
theorem or_congr (h₁ : a c) (h₂ : b d) : (a b) (c d) := .imp h₁.mp h₂.mp, .imp h₁.mpr h₂.mpr
theorem or_congr_left (h : a b) : a c b c := or_congr h .rfl
theorem or_congr_right (h : b c) : a b a c := or_congr .rfl h
theorem or_left_comm : a (b c) b (a c) := by rw [ or_assoc, or_assoc, @or_comm a b]
theorem or_right_comm : (a b) c (a c) b := by rw [or_assoc, or_assoc, @or_comm b]
theorem or_or_or_comm : (a b) c d (a c) b d := by rw [ or_assoc, @or_right_comm a, or_assoc]
theorem or_or_distrib_left : a b c (a b) a c := by rw [or_or_or_comm, or_self]
theorem or_or_distrib_right : (a b) c (a c) b c := by rw [or_or_or_comm, or_self]
theorem or_rotate : a b c b c a := by simp only [or_left_comm, Or.comm]
theorem or_iff_left (hb : ¬b) : a b a := or_iff_left_iff_imp.mpr hb.elim
theorem or_iff_right (ha : ¬a) : a b b := or_iff_right_iff_imp.mpr ha.elim
/-! ## distributivity -/
theorem not_imp_of_and_not : a ¬b ¬(a b)
| ha, hb, h => hb <| h ha
theorem imp_and {α} : (α b c) (α b) (α c) :=
fun h => fun ha => (h ha).1, fun ha => (h ha).2, fun h ha => h.1 ha, h.2 ha
theorem not_and' : ¬(a b) b ¬a := Iff.trans not_and imp_not_comm
/-- `∧` distributes over `` (on the left). -/
theorem and_or_left : a (b c) (a b) (a c) :=
Iff.intro (fun ha, hbc => hbc.imp (.intro ha) (.intro ha))
(Or.rec (.imp_right .inl) (.imp_right .inr))
/-- `∧` distributes over `` (on the right). -/
theorem or_and_right : (a b) c (a c) (b c) := by rw [@and_comm (a b), and_or_left, @and_comm c, @and_comm c]
/-- `` distributes over `∧` (on the left). -/
theorem or_and_left : a (b c) (a b) (a c) :=
Iff.intro (Or.rec (fun ha => .inl ha, .inl ha) (.imp .inr .inr))
(And.rec <| .rec (fun _ => .inl ·) (.imp_right .intro))
/-- `` distributes over `∧` (on the right). -/
theorem and_or_right : (a b) c (a c) (b c) := by rw [@or_comm (a b), or_and_left, @or_comm c, @or_comm c]
theorem or_imp : (a b c) (a c) (b c) :=
Iff.intro (fun h => h .inl, h .inr) (fun ha, hb => Or.rec ha hb)
theorem not_or : ¬(p q) ¬p ¬q := or_imp
theorem not_and_of_not_or_not (h : ¬a ¬b) : ¬(a b) := h.elim (mt (·.1)) (mt (·.2))
/-! ## exists and forall -/
section quantifiers
variable {p q : α Prop} {b : Prop}
theorem forall_imp (h : a, p a q a) : ( a, p a) a, q a := fun h' a => h a (h' a)
/--
As `simp` does not index foralls, this `@[simp]` lemma is tried on every `forall` expression.
This is not ideal, and likely a performance issue, but it is difficult to remove this attribute at this time.
-/
@[simp] theorem forall_exists_index {q : ( x, p x) Prop} :
( h, q h) x (h : p x), q x, h :=
fun h x hpx => h x, hpx, fun h x, hpx => h x hpx
theorem Exists.imp (h : a, p a q a) : ( a, p a) a, q a
| a, hp => a, h a hp
theorem Exists.imp' {β} {q : β Prop} (f : α β) (hpq : a, p a q (f a)) :
( a, p a) b, q b
| _, hp => _, hpq _ hp
theorem exists_imp : (( x, p x) b) x, p x b := forall_exists_index
@[simp] theorem exists_const (α) [i : Nonempty α] : ( _ : α, b) b :=
fun _, h => h, i.elim Exists.intro
section forall_congr
theorem forall_congr' (h : a, p a q a) : ( a, p a) a, q a :=
fun H a => (h a).1 (H a), fun H a => (h a).2 (H a)
theorem exists_congr (h : a, p a q a) : ( a, p a) a, q a :=
Exists.imp fun x => (h x).1, Exists.imp fun x => (h x).2
variable {β : α Sort _}
theorem forall_congr {p q : a, β a Prop} (h : a b, p a b q a b) :
( a b, p a b) a b, q a b :=
forall_congr' fun a => forall_congr' <| h a
theorem exists₂_congr {p q : a, β a Prop} (h : a b, p a b q a b) :
( a b, p a b) a b, q a b :=
exists_congr fun a => exists_congr <| h a
variable {γ : a, β a Sort _}
theorem forall_congr {p q : a b, γ a b Prop} (h : a b c, p a b c q a b c) :
( a b c, p a b c) a b c, q a b c :=
forall_congr' fun a => forall_congr <| h a
theorem exists₃_congr {p q : a b, γ a b Prop} (h : a b c, p a b c q a b c) :
( a b c, p a b c) a b c, q a b c :=
exists_congr fun a => exists₂_congr <| h a
variable {δ : a b, γ a b Sort _}
theorem forall_congr {p q : a b c, δ a b c Prop} (h : a b c d, p a b c d q a b c d) :
( a b c d, p a b c d) a b c d, q a b c d :=
forall_congr' fun a => forall_congr <| h a
theorem exists₄_congr {p q : a b c, δ a b c Prop} (h : a b c d, p a b c d q a b c d) :
( a b c d, p a b c d) a b c d, q a b c d :=
exists_congr fun a => exists₃_congr <| h a
variable {ε : a b c, δ a b c Sort _}
theorem forall_congr {p q : a b c d, ε a b c d Prop}
(h : a b c d e, p a b c d e q a b c d e) :
( a b c d e, p a b c d e) a b c d e, q a b c d e :=
forall_congr' fun a => forall_congr <| h a
theorem exists₅_congr {p q : a b c d, ε a b c d Prop}
(h : a b c d e, p a b c d e q a b c d e) :
( a b c d e, p a b c d e) a b c d e, q a b c d e :=
exists_congr fun a => exists₄_congr <| h a
end forall_congr
@[simp] theorem not_exists : (¬ x, p x) x, ¬p x := exists_imp
theorem forall_and : ( x, p x q x) ( x, p x) ( x, q x) :=
fun h => fun x => (h x).1, fun x => (h x).2, fun h₁, h₂ x => h₁ x, h₂ x
theorem exists_or : ( x, p x q x) ( x, p x) x, q x :=
fun | x, .inl h => .inl x, h | x, .inr h => .inr x, h,
fun | .inl x, h => x, .inl h | .inr x, h => x, .inr h
@[simp] theorem exists_false : ¬( _a : α, False) := fun _, h => h
@[simp] theorem forall_const (α : Sort _) [i : Nonempty α] : (α b) b :=
i.elim, fun hb _ => hb
theorem Exists.nonempty : ( x, p x) Nonempty α | x, _ => x
theorem not_forall_of_exists_not {p : α Prop} : ( x, ¬p x) ¬ x, p x
| x, hn, h => hn (h x)
@[simp] theorem forall_eq {p : α Prop} {a' : α} : ( a, a = a' p a) p a' :=
fun h => h a' rfl, fun h _ e => e.symm h
@[simp] theorem forall_eq' {a' : α} : ( a, a' = a p a) p a' := by simp [@eq_comm _ a']
@[simp] theorem exists_eq : a, a = a' := _, rfl
@[simp] theorem exists_eq' : a, a' = a := _, rfl
@[simp] theorem exists_eq_left : ( a, a = a' p a) p a' :=
fun _, e, h => e h, fun h => _, rfl, h
@[simp] theorem exists_eq_right : ( a, p a a = a') p a' :=
(exists_congr <| by exact fun a => And.comm).trans exists_eq_left
@[simp] theorem exists_and_left : ( x, b p x) b ( x, p x) :=
fun x, h, hp => h, x, hp, fun h, x, hp => x, h, hp
@[simp] theorem exists_and_right : ( x, p x b) ( x, p x) b := by simp [And.comm]
@[simp] theorem exists_eq_left' : ( a, a' = a p a) p a' := by simp [@eq_comm _ a']
@[simp] theorem forall_eq_or_imp : ( a, a = a' q a p a) p a' a, q a p a := by
simp only [or_imp, forall_and, forall_eq]
@[simp] theorem exists_eq_or_imp : ( a, (a = a' q a) p a) p a' a, q a p a := by
simp only [or_and_right, exists_or, exists_eq_left]
@[simp] theorem exists_eq_right_right : ( (a : α), p a q a a = a') p a' q a' := by
simp [ and_assoc]
@[simp] theorem exists_eq_right_right' : ( (a : α), p a q a a' = a) p a' q a' := by
simp [@eq_comm _ a']
@[simp] theorem exists_prop : ( _h : a, b) a b :=
fun hp, hq => hp, hq, fun hp, hq => hp, hq
@[simp] theorem exists_apply_eq_apply (f : α β) (a' : α) : a, f a = f a' := a', rfl
theorem forall_prop_of_true {p : Prop} {q : p Prop} (h : p) : ( h' : p, q h') q h :=
@forall_const (q h) p h
theorem forall_comm {p : α β Prop} : ( a b, p a b) ( b a, p a b) :=
fun h b a => h a b, fun h a b => h b a
theorem exists_comm {p : α β Prop} : ( a b, p a b) ( b a, p a b) :=
fun a, b, h => b, a, h, fun b, a, h => a, b, h
@[simp] theorem forall_apply_eq_imp_iff {f : α β} {p : β Prop} :
( b a, f a = b p b) a, p (f a) := by simp [forall_comm]
@[simp] theorem forall_eq_apply_imp_iff {f : α β} {p : β Prop} :
( b a, b = f a p b) a, p (f a) := by simp [forall_comm]
@[simp] theorem forall_apply_eq_imp_iff₂ {f : α β} {p : α Prop} {q : β Prop} :
( b a, p a f a = b q b) a, p a q (f a) :=
fun h a ha => h (f a) a ha rfl, fun h _ a ha hb => hb h a ha
theorem forall_prop_of_false {p : Prop} {q : p Prop} (hn : ¬p) : ( h' : p, q h') True :=
iff_true_intro fun h => hn.elim h
end quantifiers
/-! ## decidable -/
theorem Decidable.not_not [Decidable p] : ¬¬p p := of_not_not, not_not_intro
theorem Decidable.by_contra [Decidable p] : (¬p False) p := of_not_not
/-- Construct a non-Prop by cases on an `Or`, when the left conjunct is decidable. -/
protected def Or.by_cases [Decidable p] {α : Sort u} (h : p q) (h₁ : p α) (h₂ : q α) : α :=
if hp : p then h₁ hp else h₂ (h.resolve_left hp)
/-- Construct a non-Prop by cases on an `Or`, when the right conjunct is decidable. -/
protected def Or.by_cases' [Decidable q] {α : Sort u} (h : p q) (h₁ : p α) (h₂ : q α) : α :=
if hq : q then h₂ hq else h₁ (h.resolve_right hq)
instance exists_prop_decidable {p} (P : p Prop)
[Decidable p] [ h, Decidable (P h)] : Decidable ( h, P h) :=
if h : p then
decidable_of_decidable_of_iff fun h2 => h, h2, fun _, h2 => h2
else isFalse fun h', _ => h h'
instance forall_prop_decidable {p} (P : p Prop)
[Decidable p] [ h, Decidable (P h)] : Decidable ( h, P h) :=
if h : p then
decidable_of_decidable_of_iff fun h2 _ => h2, fun al => al h
else isTrue fun h2 => absurd h2 h
theorem decide_eq_true_iff (p : Prop) [Decidable p] : (decide p = true) p := by simp
@[simp] theorem decide_eq_false_iff_not (p : Prop) {_ : Decidable p} : (decide p = false) ¬p :=
of_decide_eq_false, decide_eq_false
@[simp] theorem decide_eq_decide {p q : Prop} {_ : Decidable p} {_ : Decidable q} :
decide p = decide q (p q) :=
fun h => by rw [ decide_eq_true_iff p, h, decide_eq_true_iff], fun h => by simp [h]
theorem Decidable.of_not_imp [Decidable a] (h : ¬(a b)) : a :=
byContradiction (not_not_of_not_imp h)
theorem Decidable.not_imp_symm [Decidable a] (h : ¬a b) (hb : ¬b) : a :=
byContradiction <| hb h
theorem Decidable.not_imp_comm [Decidable a] [Decidable b] : (¬a b) (¬b a) :=
not_imp_symm, not_imp_symm
theorem Decidable.not_imp_self [Decidable a] : (¬a a) a := by
have := @imp_not_self (¬a); rwa [not_not] at this
theorem Decidable.or_iff_not_imp_left [Decidable a] : a b (¬a b) :=
Or.resolve_left, fun h => dite _ .inl (.inr h)
theorem Decidable.or_iff_not_imp_right [Decidable b] : a b (¬b a) :=
or_comm.trans or_iff_not_imp_left
theorem Decidable.not_imp_not [Decidable a] : (¬a ¬b) (b a) :=
fun h hb => byContradiction (h · hb), mt
theorem Decidable.not_or_of_imp [Decidable a] (h : a b) : ¬a b :=
if ha : a then .inr (h ha) else .inl ha
theorem Decidable.imp_iff_not_or [Decidable a] : (a b) (¬a b) :=
not_or_of_imp, Or.neg_resolve_left
theorem Decidable.imp_iff_or_not [Decidable b] : b a a ¬b :=
Decidable.imp_iff_not_or.trans or_comm
theorem Decidable.imp_or [h : Decidable a] : (a b c) (a b) (a c) :=
if h : a then by
rw [imp_iff_right h, imp_iff_right h, imp_iff_right h]
else by
rw [iff_false_intro h, false_imp_iff, false_imp_iff, true_or]
theorem Decidable.imp_or' [Decidable b] : (a b c) (a b) (a c) :=
if h : b then by simp [h] else by
rw [eq_false h, false_or]; exact (or_iff_right_of_imp fun hx x => (hx x).elim).symm
theorem Decidable.not_imp_iff_and_not [Decidable a] : ¬(a b) a ¬b :=
fun h => of_not_imp h, not_of_not_imp h, not_imp_of_and_not
theorem Decidable.peirce (a b : Prop) [Decidable a] : ((a b) a) a :=
if ha : a then fun _ => ha else fun h => h ha.elim
theorem peirce' {a : Prop} (H : b : Prop, (a b) a) : a := H _ id
theorem Decidable.not_iff_not [Decidable a] [Decidable b] : (¬a ¬b) (a b) := by
rw [@iff_def (¬a), @iff_def' a]; exact and_congr not_imp_not not_imp_not
theorem Decidable.not_iff_comm [Decidable a] [Decidable b] : (¬a b) (¬b a) := by
rw [@iff_def (¬a), @iff_def (¬b)]; exact and_congr not_imp_comm imp_not_comm
theorem Decidable.not_iff [Decidable b] : ¬(a b) (¬a b) :=
if h : b then by
rw [iff_true_right h, iff_true_right h]
else by
rw [iff_false_right h, iff_false_right h]
theorem Decidable.iff_not_comm [Decidable a] [Decidable b] : (a ¬b) (b ¬a) := by
rw [@iff_def a, @iff_def b]; exact and_congr imp_not_comm not_imp_comm
theorem Decidable.iff_iff_and_or_not_and_not {a b : Prop} [Decidable b] :
(a b) (a b) (¬a ¬b) :=
fun e => if h : b then .inl e.2 h, h else .inr mt e.1 h, h,
Or.rec (And.rec iff_of_true) (And.rec iff_of_false)
theorem Decidable.iff_iff_not_or_and_or_not [Decidable a] [Decidable b] :
(a b) (¬a b) (a ¬b) := by
rw [iff_iff_implies_and_implies a b]; simp only [imp_iff_not_or, Or.comm]
theorem Decidable.not_and_not_right [Decidable b] : ¬(a ¬b) (a b) :=
fun h ha => not_imp_symm (And.intro ha) h, fun h ha, hb => hb <| h ha
theorem Decidable.not_and_iff_or_not_not [Decidable a] : ¬(a b) ¬a ¬b :=
fun h => if ha : a then .inr (h ha, ·) else .inl ha, not_and_of_not_or_not
theorem Decidable.not_and_iff_or_not_not' [Decidable b] : ¬(a b) ¬a ¬b :=
fun h => if hb : b then .inl (h ·, hb) else .inr hb, not_and_of_not_or_not
theorem Decidable.or_iff_not_and_not [Decidable a] [Decidable b] : a b ¬(¬a ¬b) := by
rw [ not_or, not_not]
theorem Decidable.and_iff_not_or_not [Decidable a] [Decidable b] : a b ¬(¬a ¬b) := by
rw [ not_and_iff_or_not_not, not_not]
theorem Decidable.imp_iff_right_iff [Decidable a] : (a b b) a b :=
fun H => (Decidable.em a).imp_right fun ha' => H.1 fun ha => (ha' ha).elim,
fun H => H.elim imp_iff_right fun hb => iff_of_true (fun _ => hb) hb
theorem Decidable.and_or_imp [Decidable a] : a b (a c) a b c :=
if ha : a then by simp only [ha, true_and, true_imp_iff]
else by simp only [ha, false_or, false_and, false_imp_iff]
theorem Decidable.or_congr_left' [Decidable c] (h : ¬c (a b)) : a c b c := by
rw [or_iff_not_imp_right, or_iff_not_imp_right]; exact imp_congr_right h
theorem Decidable.or_congr_right' [Decidable a] (h : ¬a (b c)) : a b a c := by
rw [or_iff_not_imp_left, or_iff_not_imp_left]; exact imp_congr_right h
/-- Transfer decidability of `a` to decidability of `b`, if the propositions are equivalent.
**Important**: this function should be used instead of `rw` on `Decidable b`, because the
kernel will get stuck reducing the usage of `propext` otherwise,
and `decide` will not work. -/
@[inline] def decidable_of_iff (a : Prop) (h : a b) [Decidable a] : Decidable b :=
decidable_of_decidable_of_iff h
/-- Transfer decidability of `b` to decidability of `a`, if the propositions are equivalent.
This is the same as `decidable_of_iff` but the iff is flipped. -/
@[inline] def decidable_of_iff' (b : Prop) (h : a b) [Decidable b] : Decidable a :=
decidable_of_decidable_of_iff h.symm
instance Decidable.predToBool (p : α Prop) [DecidablePred p] :
CoeDep (α Prop) p (α Bool) := fun b => decide <| p b
/-- Prove that `a` is decidable by constructing a boolean `b` and a proof that `b ↔ a`.
(This is sometimes taken as an alternate definition of decidability.) -/
def decidable_of_bool : (b : Bool), (b a) Decidable a
| true, h => isTrue (h.1 rfl)
| false, h => isFalse (mt h.2 Bool.noConfusion)
protected theorem Decidable.not_forall {p : α Prop} [Decidable ( x, ¬p x)]
[ x, Decidable (p x)] : (¬ x, p x) x, ¬p x :=
Decidable.not_imp_symm fun nx x => Decidable.not_imp_symm (fun h => x, h) nx,
not_forall_of_exists_not
protected theorem Decidable.not_forall_not {p : α Prop} [Decidable ( x, p x)] :
(¬ x, ¬p x) x, p x :=
(@Decidable.not_iff_comm _ _ _ (decidable_of_iff (¬ x, p x) not_exists)).1 not_exists
protected theorem Decidable.not_exists_not {p : α Prop} [ x, Decidable (p x)] :
(¬ x, ¬p x) x, p x := by
simp only [not_exists, Decidable.not_not]

192
src/Init/RCases.lean Normal file
View File

@@ -0,0 +1,192 @@
/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Jacob von Raumer
-/
prelude
import Init.Tactics
import Init.NotationExtra
/-!
# Recursive cases (`rcases`) tactic and related tactics
`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to
destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c d` or
`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or
`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples.
Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which
are generated during the execution of `rcases` and represent individual elements destructured from
the input expression). An `rcases` pattern has the following grammar:
* A name like `x`, which names the active hypothesis as `x`.
* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the
hypothesis).
* A hyphen `-`, which clears the active hypothesis and any dependents.
* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the
hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa).
* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it
against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.)
* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series
of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`,
then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b`
and so on.
* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
while leaving the `@` off will only use the patterns on the explicit arguments.
* An alternation pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors,
or a nested disjunction like `a b c`.
The patterns are fairly liberal about the exact shape of the constructors, and will insert
additional alternation branches and tuple arguments if there are not enough arguments provided, and
reuse the tail for further matches if there are too many arguments provided to alternation and
tuple patterns.
This file also contains the `obtain` and `rintro` tactics, which use the same syntax of `rcases`
patterns but with a slightly different use case:
* `rintro` (or `rintros`) is used like `rintro x ⟨y, z⟩` and is the same as `intros` followed by
`rcases` on the newly introduced arguments.
* `obtain` is the same as `rcases` but with a syntax styled after `have` rather than `cases`.
`obtain ⟨hx, hy⟩ | hz := foo` is equivalent to `rcases foo with ⟨hx, hy⟩ | hz`. Unlike `rcases`,
`obtain` also allows one to omit `:= foo`, although a type must be provided in this case,
as in `obtain ⟨hx, hy⟩ | hz : a ∧ b c`, in which case it produces a subgoal for proving
`a ∧ b c` in addition to the subgoals `hx : a, hy : b |- goal` and `hz : c |- goal`.
## Tags
rcases, rintro, obtain, destructuring, cases, pattern matching, match
-/
namespace Lean.Parser.Tactic
/-- The syntax category of `rcases` patterns. -/
declare_syntax_cat rcasesPat
/-- A medium precedence `rcases` pattern is a list of `rcasesPat` separated by `|` -/
syntax rcasesPatMed := sepBy1(rcasesPat, " | ")
/-- A low precedence `rcases` pattern is a `rcasesPatMed` optionally followed by `: ty` -/
syntax rcasesPatLo := rcasesPatMed (" : " term)?
/-- `x` is a pattern which binds `x` -/
syntax (name := rcasesPat.one) ident : rcasesPat
/-- `_` is a pattern which ignores the value and gives it an inaccessible name -/
syntax (name := rcasesPat.ignore) "_" : rcasesPat
/-- `-` is a pattern which removes the value from the context -/
syntax (name := rcasesPat.clear) "-" : rcasesPat
/--
A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
while leaving the `@` off will only use the patterns on the explicit arguments.
-/
syntax (name := rcasesPat.explicit) "@" noWs rcasesPat : rcasesPat
/--
`⟨pat, ...⟩` is a pattern which matches on a tuple-like constructor
or multi-argument inductive constructor
-/
syntax (name := rcasesPat.tuple) "" rcasesPatLo,* "" : rcasesPat
/-- `(pat)` is a pattern which resets the precedence to low -/
syntax (name := rcasesPat.paren) "(" rcasesPatLo ")" : rcasesPat
/-- The syntax category of `rintro` patterns. -/
declare_syntax_cat rintroPat
/-- An `rcases` pattern is an `rintro` pattern -/
syntax (name := rintroPat.one) rcasesPat : rintroPat
/--
A multi argument binder `(pat1 pat2 : ty)` binds a list of patterns and gives them all type `ty`.
-/
syntax (name := rintroPat.binder) (priority := default+1) -- to override rcasesPat.paren
"(" rintroPat+ (" : " term)? ")" : rintroPat
/- TODO
/--
`rcases? e` will perform case splits on `e` in the same way as `rcases e`,
but rather than accepting a pattern, it does a maximal cases and prints the
pattern that would produce this case splitting. The default maximum depth is 5,
but this can be modified with `rcases? e : n`.
-/
syntax (name := rcases?) "rcases?" casesTarget,* (" : " num)? : tactic
-/
/--
`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to
destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c d` or
`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or
`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples.
Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which
are generated during the execution of `rcases` and represent individual elements destructured from
the input expression). An `rcases` pattern has the following grammar:
* A name like `x`, which names the active hypothesis as `x`.
* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the
hypothesis).
* A hyphen `-`, which clears the active hypothesis and any dependents.
* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the
hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa).
* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it
against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.)
* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series
of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`,
then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b`
and so on.
* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
while leaving the `@` off will only use the patterns on the explicit arguments.
* An alteration pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors,
or a nested disjunction like `a b c`.
A pattern like `⟨a, b, c⟩ | ⟨d, e⟩` will do a split over the inductive datatype,
naming the first three parameters of the first constructor as `a,b,c` and the
first two of the second constructor `d,e`. If the list is not as long as the
number of arguments to the constructor or the number of constructors, the
remaining variables will be automatically named. If there are nested brackets
such as `⟨⟨a⟩, b | c⟩ | d` then these will cause more case splits as necessary.
If there are too many arguments, such as `⟨a, b, c⟩` for splitting on
`∃ x, ∃ y, p x`, then it will be treated as `⟨a, ⟨b, c⟩⟩`, splitting the last
parameter as necessary.
`rcases` also has special support for quotient types: quotient induction into Prop works like
matching on the constructor `quot.mk`.
`rcases h : e with PAT` will do the same as `rcases e with PAT` with the exception that an
assumption `h : e = PAT` will be added to the context.
-/
syntax (name := rcases) "rcases" casesTarget,* (" with " rcasesPatLo)? : tactic
/--
The `obtain` tactic is a combination of `have` and `rcases`. See `rcases` for
a description of supported patterns.
```lean
obtain ⟨patt⟩ : type := proof
```
is equivalent to
```lean
have h : type := proof
rcases h with ⟨patt⟩
```
If `⟨patt⟩` is omitted, `rcases` will try to infer the pattern.
If `type` is omitted, `:= proof` is required.
-/
syntax (name := obtain) "obtain" (ppSpace rcasesPatMed)? (" : " term)? (" := " term,+)? : tactic
/- TODO
/--
`rintro?` will introduce and case split on variables in the same way as
`rintro`, but will also print the `rintro` invocation that would have the same
result. Like `rcases?`, `rintro? : n` allows for modifying the
depth of splitting; the default is 5.
-/
syntax (name := rintro?) "rintro?" (" : " num)? : tactic
-/
/--
The `rintro` tactic is a combination of the `intros` tactic with `rcases` to
allow for destructuring patterns while introducing variables. See `rcases` for
a description of supported patterns. For example, `rintro (a | ⟨b, c⟩) ⟨d, e⟩`
will introduce two variables, and then do case splits on both of them producing
two subgoals, one with variables `a d e` and the other with `b c d e`.
`rintro`, unlike `rcases`, also supports the form `(x y : ty)` for introducing
and type-ascripting multiple variables at once, similar to binders.
-/
syntax (name := rintro) "rintro" (ppSpace colGt rintroPat)+ (" : " term)? : tactic
end Lean.Parser.Tactic

View File

@@ -10,6 +10,7 @@ import Init.Core
set_option linter.missingDocs true -- keep it documented
theorem of_eq_true (h : p = True) : p := h trivial
theorem of_eq_false (h : p = False) : ¬ p := fun hp => False.elim (h.mp hp)
theorem eq_true (h : p) : p = True :=
propext fun _ => trivial, fun _ => h
@@ -30,6 +31,9 @@ theorem eq_false_of_decide {p : Prop} {_ : Decidable p} (h : decide p = false) :
theorem implies_congr {p₁ p₂ : Sort u} {q₁ q₂ : Sort v} (h₁ : p₁ = p₂) (h₂ : q₁ = q₂) : (p₁ q₁) = (p₂ q₂) :=
h₁ h₂ rfl
theorem iff_congr {p₁ p₂ q₁ q₂ : Prop} (h₁ : p₁ p₂) (h₂ : q₁ q₂) : (p₁ q₁) (p₂ q₂) :=
Iff.of_eq (propext h₁ propext h₂ rfl)
theorem implies_dep_congr_ctx {p₁ p₂ q₁ : Prop} (h₁ : p₁ = p₂) {q₂ : p₂ Prop} (h₂ : (h : p₂) q₁ = q₂ h) : (p₁ q₁) = ((h : p₂) q₂ h) :=
propext
fun hl hp₂ => (h₂ hp₂).mp (hl (h₁.mpr hp₂)),
@@ -84,12 +88,24 @@ theorem dite_congr {_ : Decidable b} [Decidable c]
@[simp] theorem ite_false (a b : α) : (if False then a else b) = b := rfl
@[simp] theorem dite_true {α : Sort u} {t : True α} {e : ¬ True α} : (dite True t e) = t True.intro := rfl
@[simp] theorem dite_false {α : Sort u} {t : False α} {e : ¬ False α} : (dite False t e) = e not_false := rfl
section SimprocHelperLemmas
set_option simprocs false
theorem ite_cond_eq_true {α : Sort u} {c : Prop} {_ : Decidable c} (a b : α) (h : c = True) : (if c then a else b) = a := by simp [h]
theorem ite_cond_eq_false {α : Sort u} {c : Prop} {_ : Decidable c} (a b : α) (h : c = False) : (if c then a else b) = b := by simp [h]
theorem dite_cond_eq_true {α : Sort u} {c : Prop} {_ : Decidable c} {t : c α} {e : ¬ c α} (h : c = True) : (dite c t e) = t (of_eq_true h) := by simp [h]
theorem dite_cond_eq_false {α : Sort u} {c : Prop} {_ : Decidable c} {t : c α} {e : ¬ c α} (h : c = False) : (dite c t e) = e (of_eq_false h) := by simp [h]
end SimprocHelperLemmas
@[simp] theorem ite_self {α : Sort u} {c : Prop} {d : Decidable c} (a : α) : ite c a a = a := by cases d <;> rfl
@[simp] theorem and_self (p : Prop) : (p p) = p := propext (·.1), fun h => h, h
@[simp] theorem and_true (p : Prop) : (p True) = p := propext (·.1), (·, trivial)
@[simp] theorem true_and (p : Prop) : (True p) = p := propext (·.2), (trivial, ·)
@[simp] theorem and_false (p : Prop) : (p False) = False := eq_false (·.2)
@[simp] theorem false_and (p : Prop) : (False p) = False := eq_false (·.1)
@[simp] theorem and_self (p : Prop) : (p p) = p := propext (·.left), fun h => h, h
@[simp] theorem and_not_self : ¬(a ¬a) | ha, hn => absurd ha hn
@[simp] theorem not_and_self : ¬(¬a a) := and_not_self And.symm
@[simp] theorem and_imp : (a b c) (a b c) := fun h ha hb => h ha, hb, fun h ha, hb => h ha hb
@[simp] theorem not_and : ¬(a b) (a ¬b) := and_imp
@[simp] theorem or_self (p : Prop) : (p p) = p := propext fun | .inl h | .inr h => h, .inl
@[simp] theorem or_true (p : Prop) : (p True) = True := eq_true (.inr trivial)
@[simp] theorem true_or (p : Prop) : (True p) = True := eq_true (.inl trivial)
@@ -106,6 +122,58 @@ theorem dite_congr {_ : Decidable b} [Decidable c]
@[simp] theorem not_false_eq_true : (¬ False) = True := eq_true False.elim
@[simp] theorem not_true_eq_false : (¬ True) = False := by decide
@[simp] theorem not_iff_self : ¬(¬a a) | H => iff_not_self H.symm
/-! ## and -/
theorem and_congr_right (h : a (b c)) : a b a c :=
Iff.intro (fun ha, hb => And.intro ha ((h ha).mp hb))
(fun ha, hb => And.intro ha ((h ha).mpr hb))
theorem and_congr_left (h : c (a b)) : a c b c :=
Iff.trans and_comm (Iff.trans (and_congr_right h) and_comm)
theorem and_assoc : (a b) c a (b c) :=
Iff.intro (fun ha, hb, hc => ha, hb, hc)
(fun ha, hb, hc => ha, hb, hc)
@[simp] theorem and_self_left : a (a b) a b := by rw [propext and_assoc, and_self]
@[simp] theorem and_self_right : (a b) b a b := by rw [ propext and_assoc, and_self]
@[simp] theorem and_congr_right_iff : (a b a c) (a (b c)) :=
Iff.intro (fun h ha => by simp [ha] at h; exact h) and_congr_right
@[simp] theorem and_congr_left_iff : (a c b c) c (a b) := by
rw [@and_comm _ c, @and_comm _ c, and_congr_right_iff]
theorem and_iff_left_of_imp (h : a b) : (a b) a := Iff.intro And.left (fun ha => And.intro ha (h ha))
theorem and_iff_right_of_imp (h : b a) : (a b) b := Iff.trans And.comm (and_iff_left_of_imp h)
@[simp] theorem and_iff_left_iff_imp : ((a b) a) (a b) := Iff.intro (And.right ·.mpr) and_iff_left_of_imp
@[simp] theorem and_iff_right_iff_imp : ((a b) b) (b a) := Iff.intro (And.left ·.mpr) and_iff_right_of_imp
@[simp] theorem iff_self_and : (p p q) (p q) := by rw [@Iff.comm p, and_iff_left_iff_imp]
@[simp] theorem iff_and_self : (p q p) (p q) := by rw [and_comm, iff_self_and]
/-! ## or -/
theorem Or.imp (f : a c) (g : b d) (h : a b) : c d := h.elim (inl f) (inr g)
theorem Or.imp_left (f : a b) : a c b c := .imp f id
theorem Or.imp_right (f : b c) : a b a c := .imp id f
theorem or_assoc : (a b) c a (b c) :=
Iff.intro (.rec (.imp_right .inl) (.inr .inr))
(.rec (.inl .inl) (.imp_left .inr))
@[simp] theorem or_self_left : a (a b) a b := by rw [propext or_assoc, or_self]
@[simp] theorem or_self_right : (a b) b a b := by rw [ propext or_assoc, or_self]
theorem or_iff_right_of_imp (ha : a b) : (a b) b := Iff.intro (Or.rec ha id) .inr
theorem or_iff_left_of_imp (hb : b a) : (a b) a := Iff.intro (Or.rec id hb) .inl
@[simp] theorem or_iff_left_iff_imp : (a b a) (b a) := Iff.intro (·.mp Or.inr) or_iff_left_of_imp
@[simp] theorem or_iff_right_iff_imp : (a b b) (a b) := by rw [or_comm, or_iff_left_iff_imp]
/-# Bool -/
@[simp] theorem Bool.or_false (b : Bool) : (b || false) = b := by cases b <;> rfl
@[simp] theorem Bool.or_true (b : Bool) : (b || true) = true := by cases b <;> rfl
@[simp] theorem Bool.false_or (b : Bool) : (false || b) = b := by cases b <;> rfl
@@ -158,11 +226,13 @@ theorem Bool.or_assoc (a b c : Bool) : (a || b || c) = (a || (b || c)) := by
@[simp] theorem bne_self_eq_false [BEq α] [LawfulBEq α] (a : α) : (a != a) = false := by simp [bne]
@[simp] theorem bne_self_eq_false' [DecidableEq α] (a : α) : (a != a) = false := by simp [bne]
@[simp] theorem Nat.le_zero_eq (a : Nat) : (a 0) = (a = 0) :=
propext fun h => Nat.le_antisymm h (Nat.zero_le ..), fun h => by rw [h]; decide
@[simp] theorem decide_False : decide False = false := rfl
@[simp] theorem decide_True : decide True = true := rfl
@[simp] theorem bne_iff_ne [BEq α] [LawfulBEq α] (a b : α) : a != b a b := by
simp [bne]; rw [ beq_iff_eq a b]; simp [-beq_iff_eq]
/-# Nat -/
@[simp] theorem Nat.le_zero_eq (a : Nat) : (a 0) = (a = 0) :=
propext fun h => Nat.le_antisymm h (Nat.zero_le ..), fun h => by rw [h]; decide

129
src/Init/Simproc.lean Normal file
View File

@@ -0,0 +1,129 @@
/-
Copyright (c) 2023 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.NotationExtra
namespace Lean.Parser
/--
A user-defined simplification procedure used by the `simp` tactic, and its variants.
Here is an example.
```lean
simproc reduce_add (_ + _) := fun e => do
unless (e.isAppOfArity ``HAdd.hAdd 6) do return none
let some n ← getNatValue? (e.getArg! 4) | return none
let some m ← getNatValue? (e.getArg! 5) | return none
return some (.done { expr := mkNatLit (n+m) })
```
The `simp` tactic invokes `reduce_add` whenever it finds a term of the form `_ + _`.
The simplification procedures are stored in an (imperfect) discrimination tree.
The procedure should **not** assume the term `e` perfectly matches the given pattern.
The body of a simplification procedure must have type `Simproc`, which is an alias for
`Expr → SimpM (Option Step)`.
You can instruct the simplifier to apply the procedure before its sub-expressions
have been simplified by using the modifier `↓` before the procedure name. Example.
```lean
simproc ↓ reduce_add (_ + _) := fun e => ...
```
Simplification procedures can be also scoped or local.
-/
syntax (docComment)? attrKind "simproc " (Tactic.simpPre <|> Tactic.simpPost)? ("[" ident,* "]")? ident " (" term ")" " := " term : command
/--
A user-defined simplification procedure declaration. To activate this procedure in `simp` tactic,
we must provide it as an argument, or use the command `attribute` to set its `[simproc]` attribute.
-/
syntax (docComment)? "simproc_decl " ident " (" term ")" " := " term : command
/--
A builtin simplification procedure.
-/
syntax (docComment)? attrKind "builtin_simproc " (Tactic.simpPre <|> Tactic.simpPost)? ("[" ident,* "]")? ident " (" term ")" " := " term : command
/--
A builtin simplification procedure declaration.
-/
syntax (docComment)? "builtin_simproc_decl " ident " (" term ")" " := " term : command
/--
Auxiliary command for associating a pattern with a simplification procedure.
-/
syntax (name := simprocPattern) "simproc_pattern% " term " => " ident : command
/--
Auxiliary command for associating a pattern with a builtin simplification procedure.
-/
syntax (name := simprocPatternBuiltin) "builtin_simproc_pattern% " term " => " ident : command
namespace Attr
/--
Auxiliary attribute for simplification procedures.
-/
syntax (name := simprocAttr) "simproc" (Tactic.simpPre <|> Tactic.simpPost)? : attr
/--
Auxiliary attribute for symbolic evaluation procedures.
-/
syntax (name := sevalprocAttr) "sevalproc" (Tactic.simpPre <|> Tactic.simpPost)? : attr
/--
Auxiliary attribute for builtin simplification procedures.
-/
syntax (name := simprocBuiltinAttr) "builtin_simproc" (Tactic.simpPre <|> Tactic.simpPost)? : attr
/--
Auxiliary attribute for builtin symbolic evaluation procedures.
-/
syntax (name := sevalprocBuiltinAttr) "builtin_sevalproc" (Tactic.simpPre <|> Tactic.simpPost)? : attr
end Attr
macro_rules
| `($[$doc?:docComment]? simproc_decl $n:ident ($pattern:term) := $body) => do
let simprocType := `Lean.Meta.Simp.Simproc
`($[$doc?:docComment]? def $n:ident : $(mkIdent simprocType) := $body
simproc_pattern% $pattern => $n)
macro_rules
| `($[$doc?:docComment]? builtin_simproc_decl $n:ident ($pattern:term) := $body) => do
let simprocType := `Lean.Meta.Simp.Simproc
`($[$doc?:docComment]? def $n:ident : $(mkIdent simprocType) := $body
builtin_simproc_pattern% $pattern => $n)
macro_rules
| `($[$doc?:docComment]? $kind:attrKind simproc $[$pre?]? $[ [ $ids?:ident,* ] ]? $n:ident ($pattern:term) := $body) => do
let mut cmds := #[( `($[$doc?:docComment]? simproc_decl $n ($pattern) := $body))]
let pushDefault (cmds : Array (TSyntax `command)) : MacroM (Array (TSyntax `command)) := do
return cmds.push ( `(attribute [$kind simproc $[$pre?]?] $n))
if let some ids := ids? then
for id in ids.getElems do
let idName := id.getId
let (attrName, attrKey) :=
if idName == `simp then
(`simprocAttr, "simproc")
else if idName == `seval then
(`sevalprocAttr, "sevalproc")
else
let idName := idName.appendAfter "_proc"
(`Parser.Attr ++ idName, idName.toString)
let attrStx : TSyntax `attr := mkNode attrName #[mkAtom attrKey, mkOptionalNode pre?]
cmds := cmds.push ( `(attribute [$kind $attrStx] $n))
else
cmds pushDefault cmds
return mkNullNode cmds
macro_rules
| `($[$doc?:docComment]? $kind:attrKind builtin_simproc $[$pre?]? $n:ident ($pattern:term) := $body) => do
`($[$doc?:docComment]? builtin_simproc_decl $n ($pattern) := $body
attribute [$kind builtin_simproc $[$pre?]?] $n)
| `($[$doc?:docComment]? $kind:attrKind builtin_simproc $[$pre?]? [seval] $n:ident ($pattern:term) := $body) => do
`($[$doc?:docComment]? builtin_simproc_decl $n ($pattern) := $body
attribute [$kind builtin_sevalproc $[$pre?]?] $n)
| `($[$doc?:docComment]? $kind:attrKind builtin_simproc $[$pre?]? [simp, seval] $n:ident ($pattern:term) := $body) => do
`($[$doc?:docComment]? builtin_simproc_decl $n ($pattern) := $body
attribute [$kind builtin_simproc $[$pre?]?] $n
attribute [$kind builtin_sevalproc $[$pre?]?] $n)
end Lean.Parser

View File

@@ -101,6 +101,21 @@ def withFileName (p : FilePath) (fname : String) : FilePath :=
| none => fname
| some p => p / fname
/-- Appends the extension `ext` to a path `p`.
`ext` should not contain a leading `.`, as this function adds one.
If `ext` is the empty string, no `.` is added.
Unlike `System.FilePath.withExtension`, this does not remove any existing extension. -/
def addExtension (p : FilePath) (ext : String) : FilePath :=
match p.fileName with
| none => p
| some fname => p.withFileName (if ext.isEmpty then fname else fname ++ "." ++ ext)
/-- Replace the current extension in a path `p` with `ext`.
`ext` should not contain a `.`, as this function adds one.
If `ext` is the empty string, no `.` is added. -/
def withExtension (p : FilePath) (ext : String) : FilePath :=
match p.fileStem with
| none => p

View File

@@ -117,20 +117,23 @@ opaque asTask (act : BaseIO α) (prio := Task.Priority.default) : BaseIO (Task
/-- See `BaseIO.asTask`. -/
@[extern "lean_io_map_task"]
opaque mapTask (f : α BaseIO β) (t : Task α) (prio := Task.Priority.default) : BaseIO (Task β) :=
opaque mapTask (f : α BaseIO β) (t : Task α) (prio := Task.Priority.default) (sync := false) :
BaseIO (Task β) :=
Task.pure <$> f t.get
/-- See `BaseIO.asTask`. -/
@[extern "lean_io_bind_task"]
opaque bindTask (t : Task α) (f : α BaseIO (Task β)) (prio := Task.Priority.default) : BaseIO (Task β) :=
opaque bindTask (t : Task α) (f : α BaseIO (Task β)) (prio := Task.Priority.default)
(sync := false) : BaseIO (Task β) :=
f t.get
def mapTasks (f : List α BaseIO β) (tasks : List (Task α)) (prio := Task.Priority.default) : BaseIO (Task β) :=
def mapTasks (f : List α BaseIO β) (tasks : List (Task α)) (prio := Task.Priority.default)
(sync := false) : BaseIO (Task β) :=
go tasks []
where
go
| t::ts, as =>
BaseIO.bindTask t (fun a => go ts (a :: as)) prio
BaseIO.bindTask t (fun a => go ts (a :: as)) prio sync
| [], as => f as.reverse |>.asTask prio
end BaseIO
@@ -142,16 +145,20 @@ namespace EIO
act.toBaseIO.asTask prio
/-- `EIO` specialization of `BaseIO.mapTask`. -/
@[inline] def mapTask (f : α EIO ε β) (t : Task α) (prio := Task.Priority.default) : BaseIO (Task (Except ε β)) :=
BaseIO.mapTask (fun a => f a |>.toBaseIO) t prio
@[inline] def mapTask (f : α EIO ε β) (t : Task α) (prio := Task.Priority.default)
(sync := false) : BaseIO (Task (Except ε β)) :=
BaseIO.mapTask (fun a => f a |>.toBaseIO) t prio sync
/-- `EIO` specialization of `BaseIO.bindTask`. -/
@[inline] def bindTask (t : Task α) (f : α EIO ε (Task (Except ε β))) (prio := Task.Priority.default) : BaseIO (Task (Except ε β)) :=
BaseIO.bindTask t (fun a => f a |>.catchExceptions fun e => return Task.pure <| Except.error e) prio
@[inline] def bindTask (t : Task α) (f : α EIO ε (Task (Except ε β)))
(prio := Task.Priority.default) (sync := false) : BaseIO (Task (Except ε β)) :=
BaseIO.bindTask t (fun a => f a |>.catchExceptions fun e => return Task.pure <| Except.error e)
prio sync
/-- `EIO` specialization of `BaseIO.mapTasks`. -/
@[inline] def mapTasks (f : List α EIO ε β) (tasks : List (Task α)) (prio := Task.Priority.default) : BaseIO (Task (Except ε β)) :=
BaseIO.mapTasks (fun as => f as |>.toBaseIO) tasks prio
@[inline] def mapTasks (f : List α EIO ε β) (tasks : List (Task α))
(prio := Task.Priority.default) (sync := false) : BaseIO (Task (Except ε β)) :=
BaseIO.mapTasks (fun as => f as |>.toBaseIO) tasks prio sync
end EIO
@@ -184,16 +191,19 @@ def sleep (ms : UInt32) : BaseIO Unit :=
EIO.asTask act prio
/-- `IO` specialization of `EIO.mapTask`. -/
@[inline] def mapTask (f : α IO β) (t : Task α) (prio := Task.Priority.default) : BaseIO (Task (Except IO.Error β)) :=
EIO.mapTask f t prio
@[inline] def mapTask (f : α IO β) (t : Task α) (prio := Task.Priority.default) (sync := false) :
BaseIO (Task (Except IO.Error β)) :=
EIO.mapTask f t prio sync
/-- `IO` specialization of `EIO.bindTask`. -/
@[inline] def bindTask (t : Task α) (f : α IO (Task (Except IO.Error β))) (prio := Task.Priority.default) : BaseIO (Task (Except IO.Error β)) :=
EIO.bindTask t f prio
@[inline] def bindTask (t : Task α) (f : α IO (Task (Except IO.Error β)))
(prio := Task.Priority.default) (sync := false) : BaseIO (Task (Except IO.Error β)) :=
EIO.bindTask t f prio sync
/-- `IO` specialization of `EIO.mapTasks`. -/
@[inline] def mapTasks (f : List α IO β) (tasks : List (Task α)) (prio := Task.Priority.default) : BaseIO (Task (Except IO.Error β)) :=
EIO.mapTasks f tasks prio
@[inline] def mapTasks (f : List α IO β) (tasks : List (Task α)) (prio := Task.Priority.default)
(sync := false) : BaseIO (Task (Except IO.Error β)) :=
EIO.mapTasks f tasks prio sync
/-- Check if the task's cancellation flag has been set by calling `IO.cancel` or dropping the last reference to the task. -/
@[extern "lean_io_check_canceled"] opaque checkCanceled : BaseIO Bool

View File

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Basic
import Init.Data.String.Basic
namespace System
namespace Platform
@@ -17,5 +18,10 @@ def isWindows : Bool := getIsWindows ()
def isOSX : Bool := getIsOSX ()
def isEmscripten : Bool := getIsEmscripten ()
@[extern "lean_system_platform_target"] opaque getTarget : Unit String
/-- The LLVM target triple of the current platform. Empty if missing at Lean compile time. -/
def target : String := getTarget ()
end Platform
end System

View File

@@ -6,11 +6,15 @@ Authors: Gabriel Ebner
prelude
import Init.System.IO
set_option linter.missingDocs true
namespace IO
/-- Internally, a `Promise` is just a `Task` that is in the "Promised" or "Finished" state. -/
private opaque PromiseImpl (α : Type) : { P : Type // Nonempty α Nonempty P } :=
Task α, fun _ => _, fun _ => _
private opaque PromisePointed : NonemptyType.{0}
private structure PromiseImpl (α : Type) : Type where
prom : PromisePointed.type
h : Nonempty α
/--
`Promise α` allows you to create a `Task α` whose value is provided later by calling `resolve`.
@@ -26,10 +30,10 @@ Every promise must eventually be resolved.
Otherwise the memory used for the promise will be leaked,
and any tasks depending on the promise's result will wait forever.
-/
def Promise (α : Type) : Type := (PromiseImpl α).1
def Promise (α : Type) : Type := PromiseImpl α
instance [Nonempty α] : Nonempty (Promise α) :=
(PromiseImpl α).2.1 inferInstance
instance [s : Nonempty α] : Nonempty (Promise α) :=
Nonempty.intro { prom := Classical.choice PromisePointed.property, h := s }
/-- Creates a new `Promise`. -/
@[extern "lean_io_promise_new"]
@@ -43,15 +47,12 @@ Only the first call to this function has an effect.
@[extern "lean_io_promise_resolve"]
opaque Promise.resolve (value : α) (promise : @& Promise α) : BaseIO Unit
private unsafe def Promise.resultImpl (promise : Promise α) : Task α :=
unsafeCast promise
/--
The result task of a `Promise`.
The task blocks until `Promise.resolve` is called.
-/
@[implemented_by Promise.resultImpl]
@[extern "lean_io_promise_result"]
opaque Promise.result (promise : Promise α) : Task α :=
have : Nonempty α := (PromiseImpl α).2.2 promise
have : Nonempty α := promise.h
Classical.choice inferInstance

View File

@@ -39,8 +39,75 @@ be a `let` or function type.
syntax (name := intro) "intro" notFollowedBy("|") (ppSpace colGt term:max)* : tactic
/--
`intros x...` behaves like `intro x...`, but then keeps introducing (anonymous)
hypotheses until goal is not of a function type.
Introduces zero or more hypotheses, optionally naming them.
- `intros` is equivalent to repeatedly applying `intro`
until the goal is not an obvious candidate for `intro`, which is to say
that so long as the goal is a `let` or a pi type (e.g. an implication, function, or universal quantifier),
the `intros` tactic will introduce an anonymous hypothesis.
This tactic does not unfold definitions.
- `intros x y ...` is equivalent to `intro x y ...`,
introducing hypotheses for each supplied argument and unfolding definitions as necessary.
Each argument can be either an identifier or a `_`.
An identifier indicates a name to use for the corresponding introduced hypothesis,
and a `_` indicates that the hypotheses should be introduced anonymously.
## Examples
Basic properties:
```lean
def AllEven (f : Nat → Nat) := ∀ n, f n % 2 = 0
-- Introduces the two obvious hypotheses automatically
example : ∀ (f : Nat → Nat), AllEven f → AllEven (fun k => f (k + 1)) := by
intros
/- Tactic state
f✝ : Nat → Nat
a✝ : AllEven f✝
⊢ AllEven fun k => f✝ (k + 1) -/
sorry
-- Introduces exactly two hypotheses, naming only the first
example : (f : Nat Nat), AllEven f AllEven (fun k => f (k + 1)) := by
intros g _
/- Tactic state
g : Nat → Nat
a✝ : AllEven g
⊢ AllEven fun k => g (k + 1) -/
sorry
-- Introduces exactly three hypotheses, which requires unfolding `AllEven`
example : (f : Nat Nat), AllEven f AllEven (fun k => f (k + 1)) := by
intros f h n
/- Tactic state
f : Nat → Nat
h : AllEven f
n : Nat
⊢ (fun k => f (k + 1)) n % 2 = 0 -/
apply h
```
Implications:
```lean
example (p q : Prop) : p q p := by
intros
/- Tactic state
a✝¹ : p
a✝ : q
⊢ p -/
assumption
```
Let bindings:
```lean
example : let n := 1; let k := 2; n + k = 3 := by
intros
/- n✝ : Nat := 1
k✝ : Nat := 2
⊢ n✝ + k✝ = 3 -/
rfl
```
-/
syntax (name := intros) "intros" (ppSpace colGt (ident <|> hole))* : tactic
@@ -140,6 +207,28 @@ the first matching constructor, or else fails.
-/
syntax (name := constructor) "constructor" : tactic
/--
Applies the second constructor when
the goal is an inductive type with exactly two constructors, or fails otherwise.
```
example : True False := by
left
trivial
```
-/
syntax (name := left) "left" : tactic
/--
Applies the second constructor when
the goal is an inductive type with exactly two constructors, or fails otherwise.
```
example {p q : Prop} (h : q) : p q := by
right
exact h
```
-/
syntax (name := right) "right" : tactic
/--
* `case tag => tac` focuses on the goal with case name `tag` and solves it using `tac`,
or else fails.
@@ -256,9 +345,14 @@ 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`).
-/
macro "rfl" : tactic => `(tactic| eq_refl)
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).
@@ -268,8 +362,8 @@ macro "rfl'" : tactic => `(tactic| set_option smartUnfolding false in with_unfol
/--
`ac_rfl` proves equalities up to application of an associative and commutative operator.
```
instance : IsAssociative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
instance : IsCommutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩
instance : Associative (α := Nat) (.+.) := ⟨Nat.add_assoc⟩
instance : Commutative (α := Nat) (.+.) := ⟨Nat.add_comm⟩
example (a b c d : Nat) : a + b + c + d = d + (b + c) + a := by ac_rfl
```
@@ -304,7 +398,7 @@ syntax locationWildcard := " *"
A hypothesis location specification consists of 1 or more hypothesis references
and optionally `⊢` denoting the goal.
-/
syntax locationHyp := (ppSpace colGt term:max)+ ppSpace patternIgnore( atomic("|" noWs "-") <|> "")?
syntax locationHyp := (ppSpace colGt term:max)+ patternIgnore(ppSpace (atomic("|" noWs "-") <|> ""))?
/--
Location specifications are used by many tactics that can operate on either the
@@ -365,13 +459,17 @@ syntax (name := rewriteSeq) "rewrite" (config)? rwRuleSeq (location)? : tactic
/--
`rw` is like `rewrite`, but also tries to close the goal by "cheap" (reducible) `rfl` afterwards.
-/
macro (name := rwSeq) "rw" c:(config)? s:rwRuleSeq l:(location)? : tactic =>
macro (name := rwSeq) "rw " c:(config)? s:rwRuleSeq l:(location)? : tactic =>
match s with
| `(rwRuleSeq| [$rs,*]%$rbrak) =>
-- We show the `rfl` state on `]`
`(tactic| (rewrite $(c)? [$rs,*] $(l)?; with_annotate_state $rbrak (try (with_reducible rfl))))
| _ => Macro.throwUnsupported
/-- `rwa` calls `rw`, then closes any remaining goals using `assumption`. -/
macro "rwa " rws:rwRuleSeq loc:(location)? : tactic =>
`(tactic| (rw $rws:rwRuleSeq $[$loc:location]?; assumption))
/--
The `injection` tactic is based on the fact that constructors of inductive data
types are injections.
@@ -559,7 +657,7 @@ You can use `with` to provide the variables names for each constructor.
- `induction e`, where `e` is an expression instead of a variable,
generalizes `e` in the goal, and then performs induction on the resulting variable.
- `induction e using r` allows the user to specify the principle of induction that should be used.
Here `r` should be a theorem whose result type must be of the form `C t`,
Here `r` should be a term whose result type must be of the form `C t`,
where `C` is a bound variable and `t` is a (possibly empty) sequence of bound variables
- `induction e generalizing z₁ ... zₙ`, where `z₁ ... zₙ` are variables in the local context,
generalizes over `z₁ ... zₙ` before applying the induction but then introduces them in each goal.
@@ -567,7 +665,7 @@ You can use `with` to provide the variables names for each constructor.
- Given `x : Nat`, `induction x with | zero => tac₁ | succ x' ih => tac₂`
uses tactic `tac₁` for the `zero` case, and `tac₂` for the `succ` case.
-/
syntax (name := induction) "induction " term,+ (" using " ident)?
syntax (name := induction) "induction " term,+ (" using " term)?
(" generalizing" (ppSpace colGt term:max)+)? (inductionAlts)? : tactic
/-- A `generalize` argument, of the form `term = x` or `h : term = x`. -/
@@ -610,7 +708,7 @@ You can use `with` to provide the variables names for each constructor.
performs cases on `e` as above, but also adds a hypothesis `h : e = ...` to each hypothesis,
where `...` is the constructor instance for that particular case.
-/
syntax (name := cases) "cases " casesTarget,+ (" using " ident)? (inductionAlts)? : tactic
syntax (name := cases) "cases " casesTarget,+ (" using " term)? (inductionAlts)? : tactic
/-- `rename_i x_1 ... x_n` renames the last `n` inaccessible names using the given names. -/
syntax (name := renameI) "rename_i" (ppSpace colGt binderIdent)+ : tactic
@@ -749,11 +847,120 @@ while `congr 2` produces the intended `⊢ x + y = y + x`.
-/
syntax (name := congr) "congr" (ppSpace num)? : tactic
/--
In tactic mode, `if h : t then tac1 else tac2` can be used as alternative syntax for:
```
by_cases h : t
· tac1
· tac2
```
It performs case distinction on `h : t` or `h : ¬t` and `tac1` and `tac2` are the subproofs.
You can use `?_` or `_` for either subproof to delay the goal to after the tactic, but
if a tactic sequence is provided for `tac1` or `tac2` then it will require the goal to be closed
by the end of the block.
-/
syntax (name := tacDepIfThenElse)
ppRealGroup(ppRealFill(ppIndent("if " binderIdent " : " term " then") ppSpace matchRhsTacticSeq)
ppDedent(ppSpace) ppRealFill("else " matchRhsTacticSeq)) : tactic
/--
In tactic mode, `if t then tac1 else tac2` is alternative syntax for:
```
by_cases t
· tac1
· tac2
```
It performs case distinction on `h† : t` or `h† : ¬t`, where `h†` is an anonymous
hypothesis, and `tac1` and `tac2` are the subproofs. (It doesn't actually use
nondependent `if`, since this wouldn't add anything to the context and hence would be
useless for proving theorems. To actually insert an `ite` application use
`refine if t then ?_ else ?_`.)
-/
syntax (name := tacIfThenElse)
ppRealGroup(ppRealFill(ppIndent("if " term " then") ppSpace matchRhsTacticSeq)
ppDedent(ppSpace) ppRealFill("else " matchRhsTacticSeq)) : tactic
/--
The tactic `nofun` is shorthand for `exact nofun`: it introduces the assumptions, then performs an
empty pattern match, closing the goal if the introduced pattern is impossible.
-/
macro "nofun" : tactic => `(tactic| exact nofun)
/--
The tactic `nomatch h` is shorthand for `exact nomatch h`.
-/
macro "nomatch " es:term,+ : tactic =>
`(tactic| exact nomatch $es:term,*)
/--
Acts like `have`, but removes a hypothesis with the same name as
this one if possible. For example, if the state is:
```lean
f : α → β
h : α
⊢ goal
```
Then after `replace h := f h` the state will be:
```lean
f : α → β
h : β
⊢ goal
```
whereas `have h := f h` would result in:
```lean
f : α → β
h† : α
h : β
⊢ goal
```
This can be used to simulate the `specialize` and `apply at` tactics of Coq.
-/
syntax (name := replace) "replace" haveDecl : tactic
/--
`repeat' tac` runs `tac` on all of the goals to produce a new list of goals,
then runs `tac` again on all of those goals, and repeats until `tac` fails on all remaining goals.
-/
syntax (name := repeat') "repeat' " tacticSeq : tactic
/--
`repeat1' tac` applies `tac` to main goal at least once. If the application succeeds,
the tactic is applied recursively to the generated subgoals until it eventually fails.
-/
syntax (name := repeat1') "repeat1' " tacticSeq : tactic
/-- `and_intros` applies `And.intro` until it does not make progress. -/
syntax "and_intros" : tactic
macro_rules | `(tactic| and_intros) => `(tactic| repeat' refine And.intro ?_ ?_)
/--
`subst_eq` repeatedly substitutes according to the equality proof hypotheses in the context,
replacing the left side of the equality with the right, until no more progress can be made.
-/
syntax (name := substEqs) "subst_eqs" : tactic
/-- The `run_tac doSeq` tactic executes code in `TacticM Unit`. -/
syntax (name := runTac) "run_tac " doSeq : tactic
/-- `haveI` behaves like `have`, but inlines the value instead of producing a `let_fun` term. -/
macro "haveI" d:haveDecl : tactic => `(tactic| refine_lift haveI $d:haveDecl; ?_)
/-- `letI` behaves like `let`, but inlines the value instead of producing a `let_fun` term. -/
macro "letI" d:haveDecl : tactic => `(tactic| refine_lift letI $d:haveDecl; ?_)
end Tactic
namespace Attr
/--
Theorems tagged with the `simp` attribute are by the simplifier
Theorems tagged with the `simp` attribute are used by the simplifier
(i.e., the `simp` tactic, and its variants) to simplify expressions occurring in your goals.
We call theorems tagged with the `simp` attribute "simp theorems" or "simp lemmas".
Lean maintains a database/index containing all active simp theorems.

View File

@@ -0,0 +1,66 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import Init.Tactics
import Init.NotationExtra
/-!
Extra tactics and implementation for some tactics defined at `Init/Tactic.lean`
-/
namespace Lean.Parser.Tactic
private def expandIfThenElse
(ifTk thenTk elseTk pos neg : Syntax)
(mkIf : Term Term MacroM Term) : MacroM (TSyntax `tactic) := do
let mkCase tk holeOrTacticSeq mkName : MacroM (Term × Array (TSyntax `tactic)) := do
if holeOrTacticSeq.isOfKind `Lean.Parser.Term.syntheticHole then
pure (holeOrTacticSeq, #[])
else if holeOrTacticSeq.isOfKind `Lean.Parser.Term.hole then
pure ( mkName, #[])
else
let hole withFreshMacroScope mkName
let holeId := hole.raw[1]
let case (open TSyntax.Compat in `(tactic|
case $holeId:ident =>%$tk
-- annotate `then/else` with state after `case`
with_annotate_state $tk skip
$holeOrTacticSeq))
pure (hole, #[case])
let (posHole, posCase) mkCase thenTk pos `(?pos)
let (negHole, negCase) mkCase elseTk neg `(?neg)
`(tactic| (open Classical in refine%$ifTk $( mkIf posHole negHole); $[$(posCase ++ negCase)]*))
macro_rules
| `(tactic| if%$tk $h : $c then%$ttk $pos else%$etk $neg) =>
expandIfThenElse tk ttk etk pos neg fun pos neg => `(if $h : $c then $pos else $neg)
macro_rules
| `(tactic| if%$tk $c then%$ttk $pos else%$etk $neg) =>
expandIfThenElse tk ttk etk pos neg fun pos neg => `(if h : $c then $pos else $neg)
/--
`iterate n tac` runs `tac` exactly `n` times.
`iterate tac` runs `tac` repeatedly until failure.
`iterate`'s argument is a tactic sequence,
so multiple tactics can be run using `iterate n (tac₁; tac₂; ⋯)` or
```lean
iterate n
tac₁
tac₂
```
-/
syntax "iterate" (ppSpace num)? ppSpace tacticSeq : tactic
macro_rules
| `(tactic| iterate $seq:tacticSeq) =>
`(tactic| try ($seq:tacticSeq); iterate $seq:tacticSeq)
| `(tactic| iterate $n $seq:tacticSeq) =>
match n.1.toNat with
| 0 => `(tactic| skip)
| n+1 => `(tactic| ($seq:tacticSeq); iterate $(quote n) $seq:tacticSeq)
end Lean.Parser.Tactic

View File

@@ -206,12 +206,39 @@ protected inductive Lex : α × β → α × β → Prop where
| left {a₁} (b₁) {a₂} (b₂) (h : ra a₁ a₂) : Prod.Lex (a₁, b₁) (a₂, b₂)
| right (a) {b₁ b₂} (h : rb b₁ b₂) : Prod.Lex (a, b₁) (a, b₂)
theorem lex_def (r : α α Prop) (s : β β Prop) {p q : α × β} :
Prod.Lex r s p q r p.1 q.1 p.1 = q.1 s p.2 q.2 :=
fun h => by cases h <;> simp [*], fun h =>
match p, q, h with
| (a, b), (c, d), Or.inl h => Lex.left _ _ h
| (a, b), (c, d), Or.inr e, h => by subst e; exact Lex.right _ h
namespace Lex
instance [αeqDec : DecidableEq α] {r : α α Prop} [rDec : DecidableRel r]
{s : β β Prop} [sDec : DecidableRel s] : DecidableRel (Prod.Lex r s)
| (a, b), (a', b') =>
match rDec a a' with
| isTrue raa' => isTrue $ left b b' raa'
| isFalse nraa' =>
match αeqDec a a' with
| isTrue eq => by
subst eq
cases sDec b b' with
| isTrue sbb' => exact isTrue $ right a sbb'
| isFalse nsbb' =>
apply isFalse; intro contra; cases contra <;> contradiction
| isFalse neqaa' => by
apply isFalse; intro contra; cases contra <;> contradiction
-- TODO: generalize
def Lex.right' {a₁ : Nat} {b₁ : β} (h₁ : a₁ a₂) (h₂ : rb b₁ b₂) : Prod.Lex Nat.lt rb (a₁, b₁) (a₂, b₂) :=
def right' {a₁ : Nat} {b₁ : β} (h₁ : a₁ a₂) (h₂ : rb b₁ b₂) : Prod.Lex Nat.lt rb (a₁, b₁) (a₂, b₂) :=
match Nat.eq_or_lt_of_le h₁ with
| Or.inl h => h Prod.Lex.right a₁ h₂
| Or.inr h => Prod.Lex.left b₁ _ h
end Lex
-- relational product based on ra and rb
inductive RProd : α × β α × β Prop where
| intro {a₁ b₁ a₂ b₂} (h₁ : ra a₁ a₂) (h₂ : rb b₁ b₂) : RProd (a₁, b₁) (a₂, b₂)

View File

@@ -90,6 +90,11 @@ def toCInitName (n : Name) : M String := do
def emitCInitName (n : Name) : M Unit :=
toCInitName n >>= emit
def shouldExport (n : Name) : Bool :=
-- HACK: exclude symbols very unlikely to be used by the interpreter or other consumers of
-- libleanshared to avoid Windows symbol limit
!(`Lean.Compiler.LCNF).isPrefixOf n
def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M Unit := do
let ps := decl.params
let env getEnv
@@ -98,7 +103,7 @@ def emitFnDeclAux (decl : Decl) (cppBaseName : String) (isExternal : Bool) : M U
else if isExternal then emit "extern "
else emit "LEAN_EXPORT "
else
if !isExternal then emit "LEAN_EXPORT "
if !isExternal && shouldExport decl.name then emit "LEAN_EXPORT "
emit (toCType decl.resultType ++ " " ++ cppBaseName)
unless ps.isEmpty do
emit "("
@@ -640,7 +645,7 @@ def emitDeclAux (d : Decl) : M Unit := do
let baseName toCName f;
if xs.size == 0 then
emit "static "
else
else if shouldExport f then
emit "LEAN_EXPORT " -- make symbol visible to the interpreter
emit (toCType t); emit " ";
if xs.size > 0 then

View File

@@ -25,9 +25,13 @@ def leanMainFn := "_lean_main"
namespace LLVM
-- TODO(bollu): instantiate target triple and find out what size_t is.
def size_tType (llvmctx : LLVM.Context) : IO (LLVM.LLVMType llvmctx) :=
def size_tType (llvmctx : LLVM.Context) : BaseIO (LLVM.LLVMType llvmctx) :=
LLVM.i64Type llvmctx
-- TODO(bollu): instantiate target triple and find out what unsigned is.
def unsignedType (llvmctx : LLVM.Context) : BaseIO (LLVM.LLVMType llvmctx) :=
LLVM.i32Type llvmctx
-- Helper to add a function if it does not exist, and to return the function handle if it does.
def getOrAddFunction (m : LLVM.Module ctx) (name : String) (type : LLVM.LLVMType ctx) : BaseIO (LLVM.Value ctx) := do
match ( LLVM.getNamedFunction m name) with
@@ -96,6 +100,15 @@ def getDecl (n : Name) : M llvmctx Decl := do
| some d => pure d
| none => throw s!"unknown declaration {n}"
def constInt8 (n : Nat) : M llvmctx (LLVM.Value llvmctx) := do
LLVM.constInt8 llvmctx (UInt64.ofNat n)
def constInt64 (n : Nat) : M llvmctx (LLVM.Value llvmctx) := do
LLVM.constInt64 llvmctx (UInt64.ofNat n)
def constIntSizeT (n : Nat) : M llvmctx (LLVM.Value llvmctx) := do
LLVM.constIntSizeT llvmctx (UInt64.ofNat n)
def constIntUnsigned (n : Nat) : M llvmctx (LLVM.Value llvmctx) := do
LLVM.constIntUnsigned llvmctx (UInt64.ofNat n)
@@ -162,14 +175,14 @@ def callLeanUnsignedToNatFn (builder : LLVM.Builder llvmctx)
let retty LLVM.voidPtrType llvmctx
let f getOrCreateFunctionPrototype mod retty "lean_unsigned_to_nat" argtys
let fnty LLVM.functionType retty argtys
let nv LLVM.constInt32 llvmctx (UInt64.ofNat n)
let nv constIntUnsigned n
LLVM.buildCall2 builder fnty f #[nv] name
def callLeanMkStringFromBytesFn (builder : LLVM.Builder llvmctx)
(strPtr nBytes : LLVM.Value llvmctx) (name : String) : M llvmctx (LLVM.Value llvmctx) := do
let fnName := "lean_mk_string_from_bytes"
let retty LLVM.voidPtrType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.i64Type llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
LLVM.buildCall2 builder fnty fn #[strPtr, nBytes] name
@@ -218,9 +231,9 @@ def callLeanAllocCtor (builder : LLVM.Builder llvmctx)
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
let tag LLVM.constInt32 llvmctx (UInt64.ofNat tag)
let num_objs LLVM.constInt32 llvmctx (UInt64.ofNat num_objs)
let scalar_sz LLVM.constInt32 llvmctx (UInt64.ofNat scalar_sz)
let tag constIntUnsigned tag
let num_objs constIntUnsigned num_objs
let scalar_sz constIntUnsigned scalar_sz
LLVM.buildCall2 builder fnty fn #[tag, num_objs, scalar_sz] name
def callLeanCtorSet (builder : LLVM.Builder llvmctx)
@@ -228,7 +241,7 @@ def callLeanCtorSet (builder : LLVM.Builder llvmctx)
let fnName := "lean_ctor_set"
let retty LLVM.voidType llvmctx
let voidptr LLVM.voidPtrType llvmctx
let unsigned LLVM.size_tType llvmctx
let unsigned LLVM.unsignedType llvmctx
let argtys := #[voidptr, unsigned, voidptr]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
@@ -248,7 +261,7 @@ def callLeanAllocClosureFn (builder : LLVM.Builder llvmctx)
(f arity nys : LLVM.Value llvmctx) (retName : String := "") : M llvmctx (LLVM.Value llvmctx) := do
let fnName := "lean_alloc_closure"
let retty LLVM.voidPtrType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx, LLVM.size_tType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx, LLVM.unsignedType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
LLVM.buildCall2 builder fnty fn #[f, arity, nys] retName
@@ -257,7 +270,7 @@ def callLeanClosureSetFn (builder : LLVM.Builder llvmctx)
(closure ix arg : LLVM.Value llvmctx) (retName : String := "") : M llvmctx Unit := do
let fnName := "lean_closure_set"
let retty LLVM.voidType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx, LLVM.voidPtrType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx, LLVM.voidPtrType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
let _ LLVM.buildCall2 builder fnty fn #[closure, ix, arg] retName
@@ -285,7 +298,7 @@ def callLeanCtorRelease (builder : LLVM.Builder llvmctx)
(closure i : LLVM.Value llvmctx) (retName : String := "") : M llvmctx Unit := do
let fnName := "lean_ctor_release"
let retty LLVM.voidType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
let _ LLVM.buildCall2 builder fnty fn #[closure, i] retName
@@ -294,7 +307,7 @@ def callLeanCtorSetTag (builder : LLVM.Builder llvmctx)
(closure i : LLVM.Value llvmctx) (retName : String := "") : M llvmctx Unit := do
let fnName := "lean_ctor_set_tag"
let retty LLVM.voidType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.i8Type llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
let _ LLVM.buildCall2 builder fnty fn #[closure, i] retName
@@ -347,6 +360,31 @@ def builderAppendBasicBlock (builder : LLVM.Builder llvmctx) (name : String) : M
let fn builderGetInsertionFn builder
LLVM.appendBasicBlockInContext llvmctx fn name
/--
Add an alloca to the first BB of the current function. The builders final position
will be the end of the BB that we came from.
If it is possible to put an alloca in the first BB this approach is to be preferred
over putting it in other BBs. This is because mem2reg only inspects allocas in the first BB,
leading to missed optimizations for allocas in other BBs.
-/
def buildPrologueAlloca (builder : LLVM.Builder llvmctx) (ty : LLVM.LLVMType llvmctx) (name : @&String := "") : M llvmctx (LLVM.Value llvmctx) := do
let origBB LLVM.getInsertBlock builder
let fn builderGetInsertionFn builder
if ( LLVM.countBasicBlocks fn) == 0 then
throw "Attempt to obtain first BB of function without BBs"
let entryBB LLVM.getEntryBasicBlock fn
match LLVM.getFirstInstruction entryBB with
| some instr => LLVM.positionBuilderBefore builder instr
| none => LLVM.positionBuilderAtEnd builder entryBB
let alloca LLVM.buildAlloca builder ty name
LLVM.positionBuilderAtEnd builder origBB
return alloca
def buildWhile_ (builder : LLVM.Builder llvmctx) (name : String)
(condcodegen : LLVM.Builder llvmctx M llvmctx (LLVM.Value llvmctx))
(bodycodegen : LLVM.Builder llvmctx M llvmctx Unit) : M llvmctx Unit := do
@@ -428,7 +466,7 @@ def buildIfThenElse_ (builder : LLVM.Builder llvmctx) (name : String) (brval :
-- Recall that lean uses `i8` for booleans, not `i1`, so we need to compare with `true`.
def buildLeanBoolTrue? (builder : LLVM.Builder llvmctx)
(b : LLVM.Value llvmctx) (name : String := "") : M llvmctx (LLVM.Value llvmctx) := do
LLVM.buildICmp builder LLVM.IntPredicate.NE b ( LLVM.constInt8 llvmctx 0) name
LLVM.buildICmp builder LLVM.IntPredicate.NE b ( constInt8 0) name
def emitFnDeclAux (mod : LLVM.Module llvmctx)
(decl : Decl) (cppBaseName : String) (isExternal : Bool) : M llvmctx (LLVM.Value llvmctx) := do
@@ -513,8 +551,8 @@ def emitArgSlot_ (builder : LLVM.Builder llvmctx)
| Arg.var x => emitLhsSlot_ x
| _ => do
let slotty LLVM.voidPtrType llvmctx
let slot LLVM.buildAlloca builder slotty "irrelevant_slot"
let v callLeanBox builder ( LLVM.constIntUnsigned llvmctx 0) "irrelevant_val"
let slot buildPrologueAlloca builder slotty "irrelevant_slot"
let v callLeanBox builder ( constIntSizeT 0) "irrelevant_val"
let _ LLVM.buildStore builder v slot
return (slotty, slot)
@@ -536,7 +574,7 @@ def emitCtorSetArgs (builder : LLVM.Builder llvmctx)
ys.size.forM fun i => do
let zv emitLhsVal builder z
let (_yty, yv) emitArgVal builder ys[i]!
let iv LLVM.constIntUnsigned llvmctx (UInt64.ofNat i)
let iv constIntUnsigned i
callLeanCtorSet builder zv iv yv
emitLhsSlotStore builder z zv
pure ()
@@ -545,7 +583,7 @@ def emitCtor (builder : LLVM.Builder llvmctx)
(z : VarId) (c : CtorInfo) (ys : Array Arg) : M llvmctx Unit := do
let (_llvmty, slot) emitLhsSlot_ z
if c.size == 0 && c.usize == 0 && c.ssize == 0 then do
let v callLeanBox builder ( constIntUnsigned c.cidx) "lean_box_outv"
let v callLeanBox builder ( constIntSizeT c.cidx) "lean_box_outv"
let _ LLVM.buildStore builder v slot
else do
let v emitAllocCtor builder c
@@ -557,7 +595,7 @@ def emitInc (builder : LLVM.Builder llvmctx)
let xv emitLhsVal builder x
if n != 1
then do
let nv LLVM.constIntUnsigned llvmctx (UInt64.ofNat n)
let nv constIntSizeT n
callLeanRefcountFn builder (kind := RefcountKind.inc) (checkRef? := checkRef?) (delta := nv) xv
else callLeanRefcountFn builder (kind := RefcountKind.inc) (checkRef? := checkRef?) xv
@@ -671,7 +709,7 @@ def emitPartialApp (builder : LLVM.Builder llvmctx) (z : VarId) (f : FunId) (ys
def emitApp (builder : LLVM.Builder llvmctx) (z : VarId) (f : VarId) (ys : Array Arg) : M llvmctx Unit := do
if ys.size > closureMaxArgs then do
let aargs LLVM.buildAlloca builder ( LLVM.arrayType ( LLVM.voidPtrType llvmctx) (UInt64.ofNat ys.size)) "aargs"
let aargs buildPrologueAlloca builder ( LLVM.arrayType ( LLVM.voidPtrType llvmctx) (UInt64.ofNat ys.size)) "aargs"
for i in List.range ys.size do
let (yty, yv) emitArgVal builder ys[i]!
let aslot LLVM.buildInBoundsGEP2 builder yty aargs #[ constIntUnsigned 0, constIntUnsigned i] s!"param_{i}_slot"
@@ -680,7 +718,7 @@ def emitApp (builder : LLVM.Builder llvmctx) (z : VarId) (f : VarId) (ys : Array
let retty LLVM.voidPtrType llvmctx
let args := #[ emitLhsVal builder f, constIntUnsigned ys.size, aargs]
-- '1 + ...'. '1' for the fn and 'args' for the arguments
let argtys := #[ LLVM.voidPtrType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx, LLVM.voidPtrType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
let zv LLVM.buildCall2 builder fnty fn args
@@ -722,18 +760,18 @@ def emitFullApp (builder : LLVM.Builder llvmctx)
def emitLit (builder : LLVM.Builder llvmctx)
(z : VarId) (t : IRType) (v : LitVal) : M llvmctx (LLVM.Value llvmctx) := do
let llvmty toLLVMType t
let zslot LLVM.buildAlloca builder llvmty
let zslot buildPrologueAlloca builder llvmty
addVartoState z zslot llvmty
let zv match v with
| LitVal.num v => emitNumLit builder t v
| LitVal.str v =>
let zero LLVM.constIntUnsigned llvmctx 0
let zero constIntUnsigned 0
let str_global LLVM.buildGlobalString builder v
-- access through the global, into the 0th index of the array
let strPtr LLVM.buildInBoundsGEP2 builder
( LLVM.opaquePointerTypeInContext llvmctx)
str_global #[zero] ""
let nbytes LLVM.constIntUnsigned llvmctx (UInt64.ofNat (v.utf8ByteSize))
let nbytes constIntSizeT v.utf8ByteSize
callLeanMkStringFromBytesFn builder strPtr nbytes ""
LLVM.buildStore builder zv zslot
return zslot
@@ -757,7 +795,7 @@ def callLeanCtorGetUsize (builder : LLVM.Builder llvmctx)
(x i : LLVM.Value llvmctx) (retName : String) : M llvmctx (LLVM.Value llvmctx) := do
let fnName := "lean_ctor_get_usize"
let retty LLVM.size_tType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx]
let fnty LLVM.functionType retty argtys
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
LLVM.buildCall2 builder fnty fn #[x, i] retName
@@ -784,7 +822,7 @@ def emitSProj (builder : LLVM.Builder llvmctx)
| IRType.uint32 => pure ("lean_ctor_get_uint32", LLVM.i32Type llvmctx)
| IRType.uint64 => pure ("lean_ctor_get_uint64", LLVM.i64Type llvmctx)
| _ => throw s!"Invalid type for lean_ctor_get: '{t}'"
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let xval emitLhsVal builder x
let offset emitOffset builder n offset
@@ -891,7 +929,7 @@ def emitReset (builder : LLVM.Builder llvmctx) (z : VarId) (n : Nat) (x : VarId)
(fun builder => do
let xv emitLhsVal builder x
callLeanDecRef builder xv
let box0 callLeanBox builder ( constIntUnsigned 0) "box0"
let box0 callLeanBox builder ( constIntSizeT 0) "box0"
emitLhsSlotStore builder z box0
return ShouldForwardControlFlow.yes
)
@@ -912,7 +950,7 @@ def emitReuse (builder : LLVM.Builder llvmctx)
emitLhsSlotStore builder z xv
if updtHeader then
let zv emitLhsVal builder z
callLeanCtorSetTag builder zv ( constIntUnsigned c.cidx)
callLeanCtorSetTag builder zv ( constInt8 c.cidx)
return ShouldForwardControlFlow.yes
)
emitCtorSetArgs builder z ys
@@ -935,7 +973,7 @@ def emitVDecl (builder : LLVM.Builder llvmctx) (z : VarId) (t : IRType) (v : Exp
def declareVar (builder : LLVM.Builder llvmctx) (x : VarId) (t : IRType) : M llvmctx Unit := do
let llvmty toLLVMType t
let alloca LLVM.buildAlloca builder llvmty "varx"
let alloca buildPrologueAlloca builder llvmty "varx"
addVartoState x alloca llvmty
partial def declareVars (builder : LLVM.Builder llvmctx) (f : FnBody) : M llvmctx Unit := do
@@ -961,7 +999,7 @@ def emitTag (builder : LLVM.Builder llvmctx) (x : VarId) (xType : IRType) : M ll
def emitSet (builder : LLVM.Builder llvmctx) (x : VarId) (i : Nat) (y : Arg) : M llvmctx Unit := do
let fnName := "lean_ctor_set"
let retty LLVM.voidType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx, LLVM.voidPtrType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx , LLVM.voidPtrType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
let _ LLVM.buildCall2 builder fnty fn #[ emitLhsVal builder x, constIntUnsigned i, ( emitArgVal builder y).2]
@@ -969,7 +1007,7 @@ def emitSet (builder : LLVM.Builder llvmctx) (x : VarId) (i : Nat) (y : Arg) : M
def emitUSet (builder : LLVM.Builder llvmctx) (x : VarId) (i : Nat) (y : VarId) : M llvmctx Unit := do
let fnName := "lean_ctor_set_usize"
let retty LLVM.voidType llvmctx
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx, LLVM.size_tType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx, LLVM.size_tType llvmctx]
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let fnty LLVM.functionType retty argtys
let _ LLVM.buildCall2 builder fnty fn #[ emitLhsVal builder x, constIntUnsigned i, ( emitLhsVal builder y)]
@@ -1008,7 +1046,7 @@ def emitSSet (builder : LLVM.Builder llvmctx) (x : VarId) (n : Nat) (offset : Na
| IRType.uint32 => pure ("lean_ctor_set_uint32", LLVM.i32Type llvmctx)
| IRType.uint64 => pure ("lean_ctor_set_uint64", LLVM.i64Type llvmctx)
| _ => throw s!"invalid type for 'lean_ctor_set': '{t}'"
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx, setty]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.unsignedType llvmctx, setty]
let retty LLVM.voidType llvmctx
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty fnName argtys
let xv emitLhsVal builder x
@@ -1026,12 +1064,12 @@ def emitDel (builder : LLVM.Builder llvmctx) (x : VarId) : M llvmctx Unit := do
let _ LLVM.buildCall2 builder fnty fn #[xv]
def emitSetTag (builder : LLVM.Builder llvmctx) (x : VarId) (i : Nat) : M llvmctx Unit := do
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.size_tType llvmctx]
let argtys := #[ LLVM.voidPtrType llvmctx, LLVM.i8Type llvmctx]
let retty LLVM.voidType llvmctx
let fn getOrCreateFunctionPrototype ( getLLVMModule) retty "lean_ctor_set_tag" argtys
let xv emitLhsVal builder x
let fnty LLVM.functionType retty argtys
let _ LLVM.buildCall2 builder fnty fn #[xv, constIntUnsigned i]
let _ LLVM.buildCall2 builder fnty fn #[xv, constInt8 i]
def ensureHasDefault' (alts : Array Alt) : Array Alt :=
if alts.any Alt.isDefault then alts
@@ -1057,7 +1095,7 @@ partial def emitCase (builder : LLVM.Builder llvmctx)
match alt with
| Alt.ctor c b =>
let destbb builderAppendBasicBlock builder s!"case_{xType}_{c.name}_{c.cidx}"
LLVM.addCase switch ( constIntUnsigned c.cidx) destbb
LLVM.addCase switch ( constIntSizeT c.cidx) destbb
LLVM.positionBuilderAtEnd builder destbb
emitFnBody builder b
| Alt.default b =>
@@ -1141,14 +1179,14 @@ def emitFnArgs (builder : LLVM.Builder llvmctx)
-- pv := *(argsi) = *(args + i)
let pv LLVM.buildLoad2 builder llvmty argsi
-- slot for arg[i] which is always void* ?
let alloca LLVM.buildAlloca builder llvmty s!"arg_{i}"
let alloca buildPrologueAlloca builder llvmty s!"arg_{i}"
LLVM.buildStore builder pv alloca
addVartoState params[i]!.x alloca llvmty
else
let n LLVM.countParams llvmfn
for i in (List.range n.toNat) do
let llvmty toLLVMType params[i]!.ty
let alloca LLVM.buildAlloca builder llvmty s!"arg_{i}"
let alloca buildPrologueAlloca builder llvmty s!"arg_{i}"
let arg LLVM.getParam llvmfn (UInt64.ofNat i)
let _ LLVM.buildStore builder arg alloca
addVartoState params[i]!.x alloca llvmty
@@ -1300,7 +1338,7 @@ def emitInitFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M
let ginit?v LLVM.buildLoad2 builder ginit?ty ginit?slot "init_v"
buildIfThen_ builder "isGInitialized" ginit?v
(fun builder => do
let box0 callLeanBox builder ( LLVM.constIntUnsigned llvmctx 0) "box0"
let box0 callLeanBox builder ( constIntSizeT 0) "box0"
let out callLeanIOResultMKOk builder box0 "retval"
let _ LLVM.buildRet builder out
pure ShouldForwardControlFlow.no)
@@ -1318,7 +1356,7 @@ def emitInitFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M
callLeanDecRef builder res
let decls := getDecls env
decls.reverse.forM (emitDeclInit builder initFn)
let box0 callLeanBox builder ( LLVM.constIntUnsigned llvmctx 0) "box0"
let box0 callLeanBox builder ( constIntSizeT 0) "box0"
let out callLeanIOResultMKOk builder box0 "retval"
let _ LLVM.buildRet builder out
@@ -1432,15 +1470,15 @@ def emitMainFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M
#endif
-/
let inty LLVM.voidPtrType llvmctx
let inslot LLVM.buildAlloca builder ( LLVM.pointerType inty) "in"
let inslot buildPrologueAlloca builder ( LLVM.pointerType inty) "in"
let resty LLVM.voidPtrType llvmctx
let res LLVM.buildAlloca builder ( LLVM.pointerType resty) "res"
let res buildPrologueAlloca builder ( LLVM.pointerType resty) "res"
if usesLeanAPI then callLeanInitialize builder else callLeanInitializeRuntimeModule builder
/- We disable panic messages because they do not mesh well with extracted closed terms.
See issue #534. We can remove this workaround after we implement issue #467. -/
callLeanSetPanicMessages builder ( LLVM.constFalse llvmctx)
let world callLeanIOMkWorld builder
let resv callModInitFn builder ( getModName) ( LLVM.constInt8 llvmctx 1) world (( getModName).toString ++ "_init_out")
let resv callModInitFn builder ( getModName) ( constInt8 1) world (( getModName).toString ++ "_init_out")
let _ LLVM.buildStore builder resv res
callLeanSetPanicMessages builder ( LLVM.constTrue llvmctx)
@@ -1453,21 +1491,21 @@ def emitMainFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M
callLeanDecRef builder resv
callLeanInitTaskManager builder
if xs.size == 2 then
let inv callLeanBox builder ( LLVM.constInt ( LLVM.size_tType llvmctx) 0) "inv"
let inv callLeanBox builder ( constIntSizeT 0) "inv"
let _ LLVM.buildStore builder inv inslot
let ity LLVM.size_tType llvmctx
let islot LLVM.buildAlloca builder ity "islot"
let islot buildPrologueAlloca builder ity "islot"
let argcval LLVM.getParam main 0
let argvval LLVM.getParam main 1
LLVM.buildStore builder argcval islot
buildWhile_ builder "argv"
(condcodegen := fun builder => do
let iv LLVM.buildLoad2 builder ity islot "iv"
let i_gt_1 LLVM.buildICmp builder LLVM.IntPredicate.UGT iv ( constIntUnsigned 1) "i_gt_1"
let i_gt_1 LLVM.buildICmp builder LLVM.IntPredicate.UGT iv ( constIntSizeT 1) "i_gt_1"
return i_gt_1)
(bodycodegen := fun builder => do
let iv LLVM.buildLoad2 builder ity islot "iv"
let iv_next LLVM.buildSub builder iv ( constIntUnsigned 1) "iv.next"
let iv_next LLVM.buildSub builder iv ( constIntSizeT 1) "iv.next"
LLVM.buildStore builder iv_next islot
let nv callLeanAllocCtor builder 1 2 0 "nv"
let argv_i_next_slot LLVM.buildGEP2 builder ( LLVM.voidPtrType llvmctx) argvval #[iv_next] "argv.i.next.slot"
@@ -1509,7 +1547,7 @@ def emitMainFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M
pure ShouldForwardControlFlow.no
else do
callLeanDecRef builder resv
let _ LLVM.buildRet builder ( LLVM.constInt64 llvmctx 0)
let _ LLVM.buildRet builder ( constInt64 0)
pure ShouldForwardControlFlow.no
)
@@ -1517,7 +1555,7 @@ def emitMainFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M
let resv LLVM.buildLoad2 builder resty res "resv"
callLeanIOResultShowError builder resv
callLeanDecRef builder resv
let _ LLVM.buildRet builder ( LLVM.constInt64 llvmctx 1)
let _ LLVM.buildRet builder ( constInt64 1)
pure ShouldForwardControlFlow.no)
-- at the merge
let _ LLVM.buildUnreachable builder
@@ -1592,6 +1630,8 @@ def emitLLVM (env : Environment) (modName : Name) (filepath : String) : IO Unit
let some fn LLVM.getNamedFunction emitLLVMCtx.llvmmodule name
| throw <| IO.Error.userError s!"ERROR: linked module must have function from runtime module: '{name}'"
LLVM.setLinkage fn LLVM.Linkage.internal
if let some err LLVM.verifyModule emitLLVMCtx.llvmmodule then
throw <| .userError err
LLVM.writeBitcodeToFile emitLLVMCtx.llvmmodule filepath
LLVM.disposeModule emitLLVMCtx.llvmmodule
| .error err => throw (IO.Error.userError err)

View File

@@ -182,6 +182,18 @@ opaque createBuilderInContext (ctx : Context) : BaseIO (Builder ctx)
@[extern "lean_llvm_append_basic_block_in_context"]
opaque appendBasicBlockInContext (ctx : Context) (fn : Value ctx) (name : @&String) : BaseIO (BasicBlock ctx)
@[extern "lean_llvm_count_basic_blocks"]
opaque countBasicBlocks (fn : Value ctx) : BaseIO UInt64
@[extern "lean_llvm_get_entry_basic_block"]
opaque getEntryBasicBlock (fn : Value ctx) : BaseIO (BasicBlock ctx)
@[extern "lean_llvm_get_first_instruction"]
opaque getFirstInstruction (bb : BasicBlock ctx) : BaseIO (Option (Value ctx))
@[extern "lean_llvm_position_builder_before"]
opaque positionBuilderBefore (builder : Builder ctx) (instr : Value ctx) : BaseIO Unit
@[extern "lean_llvm_position_builder_at_end"]
opaque positionBuilderAtEnd (builder : Builder ctx) (bb : BasicBlock ctx) : BaseIO Unit
@@ -326,6 +338,9 @@ opaque disposeTargetMachine (tm : TargetMachine ctx) : BaseIO Unit
@[extern "lean_llvm_dispose_module"]
opaque disposeModule (m : Module ctx) : BaseIO Unit
@[extern "lean_llvm_verify_module"]
opaque verifyModule (m : Module ctx) : BaseIO (Option String)
@[extern "lean_llvm_create_string_attribute"]
opaque createStringAttribute (key : String) (value : String) : BaseIO (Attribute ctx)
@@ -439,6 +454,11 @@ def constInt32 (ctx : Context) (value : UInt64) (signExtend : Bool := false) : B
def constInt64 (ctx : Context) (value : UInt64) (signExtend : Bool := false) : BaseIO (Value ctx) :=
constInt' ctx 64 value signExtend
def constIntUnsigned (ctx : Context) (value : UInt64) (signExtend : Bool := false) : BaseIO (Value ctx) :=
def constIntSizeT (ctx : Context) (value : UInt64) (signExtend : Bool := false) : BaseIO (Value ctx) :=
-- TODO: make this stick to the actual size_t of the target machine
constInt' ctx 64 value signExtend
def constIntUnsigned (ctx : Context) (value : UInt64) (signExtend : Bool := false) : BaseIO (Value ctx) :=
-- TODO: make this stick to the actual unsigned of the target machine
constInt' ctx 32 value signExtend
end LLVM

View File

@@ -75,10 +75,10 @@ def eqvLetValue (e₁ e₂ : LetValue) : EqvM Bool := do
go (i+1)
else
x
termination_by params₁.size - i
go 0
else
return false
termination_by go i => params₁.size - i
def sortAlts (alts : Array Alt) : Array Alt :=
alts.qsort fun
@@ -133,4 +133,4 @@ Return `true` if `c₁` and `c₂` are alpha equivalent.
def Code.alphaEqv (c₁ c₂ : Code) : Bool :=
AlphaEqv.eqv c₁ c₂ |>.run {}
end Lean.Compiler.LCNF
end Lean.Compiler.LCNF

View File

@@ -181,8 +181,8 @@ def expandCodeDecls (decls : Array CodeDecl) (body : LetValue) : CompilerM Expr
go (i+1) (subst.push value)
else
(body.toExpr.abstract xs).instantiateRev subst
termination_by values.size - i
return go 0 #[]
termination_by go => values.size - i
/--
Create the "key" that uniquely identifies a code specialization.

View File

@@ -234,7 +234,7 @@ where
throwError "invalid instantiateForall, too many parameters"
else
return type
termination_by go i _ => ps.size - i
termination_by ps.size - i
/--
Return `true` if `type` is a predicate.

View File

@@ -28,8 +28,8 @@ def filterPairsM {m} [Monad m] {α} (a : Array α) (f : αα → m (Bool ×
let mut numRemoved := 0
for h1 : i in [:a.size] do for h2 : j in [i+1:a.size] do
unless removed[i]! || removed[j]! do
let xi := a[i]'h1.2
let xj := a[j]'h2.2
let xi := a[i]
let xj := a[j]
let (keepi, keepj) f xi xj
unless keepi do
numRemoved := numRemoved + 1
@@ -40,7 +40,7 @@ def filterPairsM {m} [Monad m] {α} (a : Array α) (f : αα → m (Bool ×
let mut a' := Array.mkEmpty numRemoved
for h : i in [:a.size] do
unless removed[i]! do
a' := a'.push (a[i]'h.2)
a' := a'.push a[i]
return a'
end Array

View File

@@ -89,7 +89,7 @@ def moveEntries [Hashable α] (i : Nat) (source : Array (AssocList α β)) (targ
let target := es.foldl (reinsertAux hash) target
moveEntries (i+1) source target
else target
termination_by _ i source _ => source.size - i
termination_by source.size - i
def expand [Hashable α] (size : Nat) (buckets : HashMapBucket α β) : HashMapImp α β :=
let bucketsNew : HashMapBucket α β :=
@@ -227,3 +227,17 @@ def ofListWith (l : List (α × β)) (f : β → β → β) : HashMap α β :=
match m.find? p.fst with
| none => m.insert p.fst p.snd
| some v => m.insert p.fst $ f v p.snd)
end Lean.HashMap
/--
Groups all elements `x`, `y` in `xs` with `key x == key y` into the same array
`(xs.groupByKey key).find! (key x)`. Groups preserve the relative order of elements in `xs`.
-/
def Array.groupByKey [BEq α] [Hashable α] (key : β α) (xs : Array β)
: Lean.HashMap α (Array β) := Id.run do
let mut groups :=
for x in xs do
let group := groups.findD (key x) #[]
groups := groups.erase (key x) -- make `group` referentially unique
groups := groups.insert (key x) (group.push x)
return groups

View File

@@ -80,7 +80,7 @@ def moveEntries [Hashable α] (i : Nat) (source : Array (List α)) (target : Has
moveEntries (i+1) source target
else
target
termination_by _ i source _ => source.size - i
termination_by source.size - i
def expand [Hashable α] (size : Nat) (buckets : HashSetBucket α) : HashSetImp α :=
let bucketsNew : HashSetBucket α :=
@@ -194,3 +194,11 @@ def insertMany [ForIn Id ρ α] (s : HashSet α) (as : ρ) : HashSet α := Id.ru
for a in as do
s := s.insert a
return s
/--
`O(|t|)` amortized. Merge two `HashSet`s.
-/
@[inline]
def merge {α : Type u} [BEq α] [Hashable α] (s t : HashSet α) : HashSet α :=
t.fold (init := s) fun s a => s.insert a
-- We don't use `insertMany` here because it gives weird universes.

View File

@@ -8,3 +8,4 @@ import Lean.Data.Json.Stream
import Lean.Data.Json.Printer
import Lean.Data.Json.Parser
import Lean.Data.Json.FromToJson
import Lean.Data.Json.Elab

View File

@@ -0,0 +1,79 @@
/-
Copyright (c) 2022 E.W.Ayers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: E.W.Ayers, Wojciech Nawrocki
-/
import Lean.Data.Json.FromToJson
import Lean.Syntax
/-!
# JSON-like syntax for Lean.
Now you can write
```lean
open Lean.Json
#eval json% {
hello : "world",
cheese : ["edam", "cheddar", {kind : "spicy", rank : 100.2}],
lemonCount : 100e30,
isCool : true,
isBug : null,
lookACalc: $(23 + 54 * 2)
}
```
-/
namespace Lean.Json
/-- Json syntactic category -/
declare_syntax_cat json (behavior := symbol)
/-- Json null value syntax. -/
syntax "null" : json
/-- Json true value syntax. -/
syntax "true" : json
/-- Json false value syntax. -/
syntax "false" : json
/-- Json string syntax. -/
syntax str : json
/-- Json number negation syntax for ordinary numbers. -/
syntax "-"? num : json
/-- Json number negation syntax for scientific numbers. -/
syntax "-"? scientific : json
/-- Json array syntax. -/
syntax "[" json,* "]" : json
/-- Json identifier syntax. -/
syntax jsonIdent := ident <|> str
/-- Json key/value syntax. -/
syntax jsonField := jsonIdent ": " json
/-- Json object syntax. -/
syntax "{" jsonField,* "}" : json
/-- Allows to use Json syntax in a Lean file. -/
syntax "json% " json : term
macro_rules
| `(json% null) => `(Lean.Json.null)
| `(json% true) => `(Lean.Json.bool Bool.true)
| `(json% false) => `(Lean.Json.bool Bool.false)
| `(json% $n:str) => `(Lean.Json.str $n)
| `(json% $n:num) => `(Lean.Json.num $n)
| `(json% $n:scientific) => `(Lean.Json.num $n)
| `(json% -$n:num) => `(Lean.Json.num (-$n))
| `(json% -$n:scientific) => `(Lean.Json.num (-$n))
| `(json% [$[$xs],*]) => `(Lean.Json.arr #[$[json% $xs],*])
| `(json% {$[$ks:jsonIdent : $vs:json],*}) => do
let ks : Array (TSyntax `term) ks.mapM fun
| `(jsonIdent| $k:ident) => pure (k.getId |> toString |> quote)
| `(jsonIdent| $k:str) => pure k
| _ => Macro.throwUnsupported
`(Lean.Json.mkObj [$[($ks, json% $vs)],*])
| `(json% $stx) =>
if stx.raw.isAntiquot then
let stx := stx.raw.getAntiquotTerm
`(Lean.toJson $stx)
else
Macro.throwUnsupported
end Lean.Json

View File

@@ -74,6 +74,7 @@ structure ServerCapabilities where
declarationProvider : Bool := false
typeDefinitionProvider : Bool := false
referencesProvider : Bool := false
callHierarchyProvider : Bool := false
renameProvider? : Option RenameOptions := none
workspaceSymbolProvider : Bool := false
foldingRangeProvider : Bool := false

View File

@@ -8,6 +8,8 @@ Authors: Joscha Mennicken
import Lean.Expr
import Lean.Data.Lsp.Basic
set_option linter.missingDocs true -- keep it documented
/-! This file contains types for communication between the watchdog and the
workers. These messages are not visible externally to users of the LSP server.
-/
@@ -17,17 +19,27 @@ namespace Lean.Lsp
/-! Most reference-related types have custom FromJson/ToJson implementations to
reduce the size of the resulting JSON. -/
/--
Identifier of a reference.
-/
inductive RefIdent where
/-- Named identifier. These are used in all references that are globally available. -/
| const : Name RefIdent
| fvar : FVarId RefIdent
/-- Unnamed identifier. These are used for all local references. -/
| fvar : FVarId RefIdent
deriving BEq, Hashable, Inhabited
namespace RefIdent
/-- Converts the reference identifier to a string by prefixing it with a symbol. -/
def toString : RefIdent String
| RefIdent.const n => s!"c:{n}"
| RefIdent.fvar id => s!"f:{id.name}"
/--
Converts the string representation of a reference identifier back to a reference identifier.
The string representation must have been created by `RefIdent.toString`.
-/
def fromString (s : String) : Except String RefIdent := do
let sPrefix := s.take 2
let sName := s.drop 2
@@ -43,33 +55,92 @@ def fromString (s : String) : Except String RefIdent := do
| "f:" => return RefIdent.fvar <| FVarId.mk name
| _ => throw "string must start with 'c:' or 'f:'"
instance : FromJson RefIdent where
fromJson?
| (s : String) => fromString s
| j => Except.error s!"expected a String, got {j}"
instance : ToJson RefIdent where
toJson ident := toString ident
end RefIdent
/-- Information about the declaration surrounding a reference. -/
structure RefInfo.ParentDecl where
/-- Name of the declaration surrounding a reference. -/
name : Name
/-- Range of the declaration surrounding a reference. -/
range : Lsp.Range
/-- Selection range of the declaration surrounding a reference. -/
selectionRange : Lsp.Range
deriving ToJson
/--
Denotes the range of a reference, as well as the parent declaration of the reference.
If the reference is itself a declaration, then it contains no parent declaration.
-/
structure RefInfo.Location where
/-- Range of the reference. -/
range : Lsp.Range
/-- Parent declaration of the reference. `none` if the reference is itself a declaration. -/
parentDecl? : Option RefInfo.ParentDecl
/-- Definition site and usage sites of a reference. Obtained from `Lean.Server.RefInfo`. -/
structure RefInfo where
definition : Option Lsp.Range
usages : Array Lsp.Range
/-- Definition site of the reference. May be `none` when we cannot find a definition site. -/
definition? : Option RefInfo.Location
/-- Usage sites of the reference. -/
usages : Array RefInfo.Location
instance : ToJson RefInfo where
toJson i :=
let rangeToList (r : Lsp.Range) : List Nat :=
[r.start.line, r.start.character, r.end.line, r.end.character]
let parentDeclToList (d : RefInfo.ParentDecl) : List Json :=
let name := d.name.toString |> toJson
let range := rangeToList d.range |>.map toJson
let selectionRange := rangeToList d.selectionRange |>.map toJson
[name] ++ range ++ selectionRange
let locationToList (l : RefInfo.Location) : List Json :=
let range := rangeToList l.range |>.map toJson
let parentDecl := l.parentDecl?.map parentDeclToList |>.getD []
range ++ parentDecl
Json.mkObj [
("definition", toJson $ i.definition.map rangeToList),
("usages", toJson $ i.usages.map rangeToList)
("definition", toJson $ i.definition?.map locationToList),
("usages", toJson $ i.usages.map locationToList)
]
instance : FromJson RefInfo where
fromJson? j := do
let listToRange (l : List Nat) : Except String Lsp.Range := match l with
let toRange : List Nat Except String Lsp.Range
| [sLine, sChar, eLine, eChar] => pure sLine, sChar, eLine, eChar
| _ => throw s!"Expected list of length 4, not {l.length}"
let definition j.getObjValAs? (Option $ List Nat) "definition"
let definition match definition with
| l => throw s!"Expected list of length 4, not {l.length}"
let toParentDecl (a : Array Json) : Except String RefInfo.ParentDecl := do
let name := String.toName <| fromJson? a[0]!
let range a[1:5].toArray.toList |>.mapM fromJson?
let range toRange range
let selectionRange a[5:].toArray.toList |>.mapM fromJson?
let selectionRange toRange selectionRange
return name, range, selectionRange
let toLocation (l : List Json) : Except String RefInfo.Location := do
let l := l.toArray
if l.size != 4 && l.size != 13 then
.error "Expected list of length 4 or 13, not {l.size}"
let range l[:4].toArray.toList |>.mapM fromJson?
let range toRange range
if l.size == 13 then
let parentDecl toParentDecl l[4:].toArray
return range, parentDecl
else
return range, none
let definition? j.getObjValAs? (Option $ List Json) "definition"
let definition? match definition? with
| none => pure none
| some list => some <$> listToRange list
let usages j.getObjValAs? (Array $ List Nat) "usages"
let usages usages.mapM listToRange
pure { definition, usages }
| some list => some <$> toLocation list
let usages j.getObjValAs? (Array $ List Json) "usages"
let usages usages.mapM toLocation
pure { definition?, usages }
/-- References from a single module/file -/
def ModuleRefs := HashMap RefIdent RefInfo
@@ -88,7 +159,8 @@ instance : FromJson ModuleRefs where
Contains the file's definitions and references. -/
structure LeanIleanInfoParams where
/-- Version of the file these references are from. -/
version : Nat
version : Nat
/-- All references for the file. -/
references : ModuleRefs
deriving FromJson, ToJson

View File

@@ -36,16 +36,16 @@ instance : FromJson CompletionItemKind where
structure InsertReplaceEdit where
newText : String
insert : Range
insert : Range
replace : Range
deriving FromJson, ToJson
structure CompletionItem where
label : String
detail? : Option String := none
label : String
detail? : Option String := none
documentation? : Option MarkupContent := none
kind? : Option CompletionItemKind := none
textEdit? : Option InsertReplaceEdit := none
kind? : Option CompletionItemKind := none
textEdit? : Option InsertReplaceEdit := none
/-
tags? : CompletionItemTag[]
deprecated? : boolean
@@ -63,7 +63,7 @@ structure CompletionItem where
structure CompletionList where
isIncomplete : Bool
items : Array CompletionItem
items : Array CompletionItem
deriving FromJson, ToJson
structure CompletionParams extends TextDocumentPositionParams where
@@ -74,7 +74,7 @@ structure Hover where
/- NOTE we should also accept MarkedString/MarkedString[] here
but they are deprecated, so maybe can get away without. -/
contents : MarkupContent
range? : Option Range := none
range? : Option Range := none
deriving ToJson, FromJson
structure HoverParams extends TextDocumentPositionParams
@@ -153,45 +153,76 @@ inductive SymbolKind where
| event
| operator
| typeParameter
deriving BEq, Hashable, Inhabited
instance : FromJson SymbolKind where
fromJson?
| 1 => .ok .file
| 2 => .ok .module
| 3 => .ok .namespace
| 4 => .ok .package
| 5 => .ok .class
| 6 => .ok .method
| 7 => .ok .property
| 8 => .ok .field
| 9 => .ok .constructor
| 10 => .ok .enum
| 11 => .ok .interface
| 12 => .ok .function
| 13 => .ok .variable
| 14 => .ok .constant
| 15 => .ok .string
| 16 => .ok .number
| 17 => .ok .boolean
| 18 => .ok .array
| 19 => .ok .object
| 20 => .ok .key
| 21 => .ok .null
| 22 => .ok .enumMember
| 23 => .ok .struct
| 24 => .ok .event
| 25 => .ok .operator
| 26 => .ok .typeParameter
| j => .error s!"invalid symbol kind {j}"
instance : ToJson SymbolKind where
toJson
| SymbolKind.file => 1
| SymbolKind.module => 2
| SymbolKind.namespace => 3
| SymbolKind.package => 4
| SymbolKind.class => 5
| SymbolKind.method => 6
| SymbolKind.property => 7
| SymbolKind.field => 8
| SymbolKind.constructor => 9
| SymbolKind.enum => 10
| SymbolKind.interface => 11
| SymbolKind.function => 12
| SymbolKind.variable => 13
| SymbolKind.constant => 14
| SymbolKind.string => 15
| SymbolKind.number => 16
| SymbolKind.boolean => 17
| SymbolKind.array => 18
| SymbolKind.object => 19
| SymbolKind.key => 20
| SymbolKind.null => 21
| SymbolKind.enumMember => 22
| SymbolKind.struct => 23
| SymbolKind.event => 24
| SymbolKind.operator => 25
| SymbolKind.typeParameter => 26
toJson
| .file => 1
| .module => 2
| .namespace => 3
| .package => 4
| .class => 5
| .method => 6
| .property => 7
| .field => 8
| .constructor => 9
| .enum => 10
| .interface => 11
| .function => 12
| .variable => 13
| .constant => 14
| .string => 15
| .number => 16
| .boolean => 17
| .array => 18
| .object => 19
| .key => 20
| .null => 21
| .enumMember => 22
| .struct => 23
| .event => 24
| .operator => 25
| .typeParameter => 26
structure DocumentSymbolAux (Self : Type) where
name : String
detail? : Option String := none
kind : SymbolKind
name : String
detail? : Option String := none
kind : SymbolKind
-- tags? : Array SymbolTag
range : Range
range : Range
selectionRange : Range
children? : Option (Array Self) := none
deriving ToJson
children? : Option (Array Self) := none
deriving FromJson, ToJson
inductive DocumentSymbol where
| mk (sym : DocumentSymbolAux DocumentSymbol)
@@ -212,18 +243,56 @@ instance : ToJson DocumentSymbolResult where
inductive SymbolTag where
| deprecated
deriving BEq, Hashable, Inhabited
instance : FromJson SymbolTag where
fromJson?
| 1 => .ok .deprecated
| j => .error s!"unknown symbol tag {j}"
instance : ToJson SymbolTag where
toJson
| SymbolTag.deprecated => 1
toJson
| .deprecated => 1
structure SymbolInformation where
name : String
kind : SymbolKind
tags : Array SymbolTag := #[]
location : Location
name : String
kind : SymbolKind
tags : Array SymbolTag := #[]
location : Location
containerName? : Option String := none
deriving ToJson
deriving FromJson, ToJson
structure CallHierarchyPrepareParams extends TextDocumentPositionParams
deriving FromJson, ToJson
structure CallHierarchyItem where
name : String
kind : SymbolKind
tags? : Option (Array SymbolTag) := none
detail? : Option String := none
uri : DocumentUri
range : Range
selectionRange : Range
-- data? : Option unknown
deriving FromJson, ToJson, BEq, Hashable, Inhabited
structure CallHierarchyIncomingCallsParams where
item : CallHierarchyItem
deriving FromJson, ToJson
structure CallHierarchyIncomingCall where
«from» : CallHierarchyItem
fromRanges : Array Range
deriving FromJson, ToJson, Inhabited
structure CallHierarchyOutgoingCallsParams where
item : CallHierarchyItem
deriving FromJson, ToJson
structure CallHierarchyOutgoingCall where
to : CallHierarchyItem
fromRanges : Array Range
deriving FromJson, ToJson, Inhabited
inductive SemanticTokenType where
-- Used by Lean
@@ -304,14 +373,14 @@ example {v : SemanticTokenModifier} : open SemanticTokenModifier in
cases v <;> native_decide
structure SemanticTokensLegend where
tokenTypes : Array String
tokenTypes : Array String
tokenModifiers : Array String
deriving FromJson, ToJson
structure SemanticTokensOptions where
legend : SemanticTokensLegend
range : Bool
full : Bool /- | {
range : Bool
full : Bool /- | {
delta?: boolean;
} -/
deriving FromJson, ToJson
@@ -322,12 +391,12 @@ structure SemanticTokensParams where
structure SemanticTokensRangeParams where
textDocument : TextDocumentIdentifier
range : Range
range : Range
deriving FromJson, ToJson
structure SemanticTokens where
resultId? : Option String := none
data : Array Nat
data : Array Nat
deriving FromJson, ToJson
structure FoldingRangeParams where
@@ -343,12 +412,12 @@ instance : ToJson FoldingRangeKind where
toJson
| FoldingRangeKind.comment => "comment"
| FoldingRangeKind.imports => "imports"
| FoldingRangeKind.region => "region"
| FoldingRangeKind.region => "region"
structure FoldingRange where
startLine : Nat
endLine : Nat
kind? : Option FoldingRangeKind := none
endLine : Nat
kind? : Option FoldingRangeKind := none
deriving ToJson
structure RenameOptions where

View File

@@ -8,6 +8,7 @@ import Init.Data.String
import Init.Data.Array
import Lean.Data.Lsp.Basic
import Lean.Data.Position
import Lean.DeclarationRange
/-! LSP uses UTF-16 for indexing, so we need to provide some primitives
to interact with Lean strings using UTF-16 indices. -/
@@ -86,3 +87,13 @@ def utf8PosToLspPos (text : FileMap) (pos : String.Pos) : Lsp.Position :=
end FileMap
end Lean
/--
Convert the Lean `DeclarationRange` to an LSP `Range` by turning the 1-indexed line numbering into a
0-indexed line numbering and converting the character offset within the line to a UTF-16 indexed
offset.
-/
def Lean.DeclarationRange.toLspRange (r : Lean.DeclarationRange) : Lsp.Range := {
start := r.pos.line - 1, r.charUtf16
«end» := r.endPos.line - 1, r.endCharUtf16
}

View File

@@ -96,6 +96,12 @@ def quickCmp (n₁ n₂ : Name) : Ordering :=
def quickLt (n₁ n₂ : Name) : Bool :=
quickCmp n₁ n₂ == Ordering.lt
/-- Returns true if the name has any numeric components. -/
def hasNum : Name Bool
| .anonymous => false
| .str p _ => p.hasNum
| .num _ _ => true
/-- The frontend does not allow user declarations to start with `_` in any of its parts.
We use name parts starting with `_` internally to create auxiliary names (e.g., `_private`). -/
def isInternal : Name Bool
@@ -103,6 +109,17 @@ def isInternal : Name → Bool
| num p _ => isInternal p
| _ => false
/--
The frontend does not allow user declarations to start with `_` in any of its parts.
We use name parts starting with `_` internally to create auxiliary names (e.g., `_private`).
This function checks if any component of the name starts with `_`, or is numeric.
-/
def isInternalOrNum : Name Bool
| .str p s => s.get 0 == '_' || isInternalOrNum p
| .num _ _ => true
| _ => false
/--
Checks whether the name is an implementation-detail hypothesis name.

View File

@@ -29,9 +29,16 @@ instance : ToExpr Position where
end Position
/-- Content of a file together with precalculated positions of newlines. -/
structure FileMap where
/-- The content of the file. -/
source : String
/-- The positions of newline characters.
The first entry is always `0` and the last always the index of the last character.
In particular, if the last character is a newline, that index will appear twice. -/
positions : Array String.Pos
/-- The line numbers associated with the `positions`.
Has the same length as `positions` and is always of the form `#[1, 2, …, n-1, n-1]`. -/
lines : Array Nat
deriving Inhabited
@@ -77,6 +84,26 @@ partial def toPosition (fmap : FileMap) (pos : String.Pos) : Position :=
-- Can also happen with EOF errors, which are not strictly inside the file.
lines.back, (pos - ps.back).byteIdx
/-- Convert a `Lean.Position` to a `String.Pos`. -/
def ofPosition (text : FileMap) (pos : Position) : String.Pos :=
let colPos :=
if h : pos.line - 1 < text.positions.size then
text.positions.get pos.line - 1, h
else if text.positions.isEmpty then
0
else
text.positions.back
String.Iterator.nextn text.source, colPos pos.column |>.pos
/--
Returns the position of the start of (1-based) line `line`.
This gives the stame result as `map.ofPosition ⟨line, 0⟩`, but is more efficient.
-/
def lineStart (map : FileMap) (line : Nat) : String.Pos :=
if h : line - 1 < map.positions.size then
map.positions.get line - 1, h
else map.positions.back?.getD 0
end FileMap
end Lean

View File

@@ -159,7 +159,7 @@ def appendTrees : RBNode α β → RBNode α β → RBNode α β
| bc => balLeft a kx vx (node black bc ky vy d)
| a, node red b kx vx c => node red (appendTrees a b) kx vx c
| node red a kx vx b, c => node red a kx vx (appendTrees b c)
termination_by _ x y => x.size + y.size
termination_by x y => x.size + y.size
section Erase

View File

@@ -36,13 +36,12 @@ where
if it.atEnd then r
else if it.curr == ' ' || it.curr == '\t' then consumeSpaces n it.next r
else saveLine it r
termination_by (it, 1)
saveLine (it : String.Iterator) (r : String) : String :=
if it.atEnd then r
else if it.curr == '\n' then consumeSpaces n it.next (r.push '\n')
else saveLine it.next (r.push it.curr)
termination_by
consumeSpaces n it r => (it, 1)
saveLine it r => (it, 0)
termination_by (it, 0)
def removeLeadingSpaces (s : String) : String :=
let n := findLeadingSpacesSize s

View File

@@ -10,6 +10,7 @@ import Lean.Elab.Command
import Lean.Elab.Term
import Lean.Elab.App
import Lean.Elab.Binders
import Lean.Elab.BinderPredicates
import Lean.Elab.LetRec
import Lean.Elab.Frontend
import Lean.Elab.BuiltinNotation

View File

@@ -690,10 +690,10 @@ builtin_initialize elabAsElim : TagAttribute ←
(applicationTime := .afterCompilation)
fun declName => do
let go : MetaM Unit := do
discard <| getElimInfo declName
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
go.run' {} {}
/-! # Eliminator-like function application elaborator -/
@@ -937,6 +937,7 @@ 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
unless ( read).heedElabAsElim do return none
if explicit || ellipsis then return none
let .const declName _ := f | return none
unless ( shouldElabAsElim declName) do return none
@@ -957,8 +958,7 @@ where
The idea is that the contribute to motive inference. See comment at `ElamElim.Context.extraArgsPos`.
-/
getElabAsElimExtraArgsPos (elimInfo : ElimInfo) : MetaM (Array Nat) := do
let cinfo getConstInfo elimInfo.name
forallTelescope cinfo.type fun xs type => do
forallTelescope elimInfo.elimType fun xs type => do
let resultArgs := type.getAppArgs
let mut extraArgsPos := #[]
for i in [:xs.size] do

View File

@@ -0,0 +1,41 @@
/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner
-/
import Lean.Parser.Syntax
import Lean.Elab.MacroArgUtil
import Lean.Linter.MissingDocs
namespace Lean.Elab.Command
@[builtin_command_elab binderPredicate] def elabBinderPred : CommandElab := fun stx => do
match stx with
| `($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind binder_predicate%$tk
$[(name := $name?)]? $[(priority := $prio?)]? $x $args:macroArg* => $rhs) => do
let prio liftMacroM do evalOptPrio prio?
let (stxParts, patArgs) := ( args.mapM expandMacroArg).unzip
let name match name? with
| some name => pure name.getId
| none => liftMacroM do mkNameFromParserSyntax `binderTerm (mkNullNode stxParts)
let nameTk := name?.getD (mkIdentFrom tk name)
/- The command `syntax [<kind>] ...` adds the current namespace to the syntax node kind.
So, we must include current namespace when we create a pattern for the following
`macro_rules` commands. -/
let pat : TSyntax `binderPred := (mkNode (( getCurrNamespace) ++ name) patArgs).1
elabCommand <|<-
`($[$doc?:docComment]? $[@[$attrs?,*]]? $attrKind:attrKind syntax%$tk
(name := $nameTk) (priority := $(quote prio)) $[$stxParts]* : binderPred
$[$doc?:docComment]? macro_rules%$tk
| `(satisfies_binder_pred% $$($x):term $pat:binderPred) => $rhs)
| _ => throwUnsupportedSyntax
open Linter.MissingDocs Parser Term in
/-- Missing docs handler for `binder_predicate` -/
@[builtin_missing_docs_handler Lean.Parser.Command.binderPredicate]
def checkBinderPredicate : SimpleHandler := fun stx => do
if stx[0].isNone && stx[2][0][0].getKind != ``«local» then
if stx[4].isNone then lint stx[3] "binder predicate"
else lintNamed stx[4][0][3] "binder predicate"
end Lean.Elab.Command

View File

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
import Lean.Elab.Quotation.Precheck
import Lean.Elab.Term
import Lean.Elab.BindersUtil
import Lean.Elab.PreDefinition.WF.TerminationHint
namespace Lean.Elab.Term
open Meta
@@ -570,7 +571,8 @@ def expandMatchAltsIntoMatchTactic (ref : Syntax) (matchAlts : Syntax) : MacroM
-/
def expandMatchAltsWhereDecls (matchAltsWhereDecls : Syntax) : MacroM Syntax :=
let matchAlts := matchAltsWhereDecls[0]
let whereDeclsOpt := matchAltsWhereDecls[1]
-- matchAltsWhereDecls[1] is the termination hints, collected elsewhere
let whereDeclsOpt := matchAltsWhereDecls[2]
let rec loop (i : Nat) (discrs : Array Syntax) : MacroM Syntax :=
match i with
| 0 => do

View File

@@ -656,35 +656,40 @@ unsafe def elabEvalUnsafe : CommandElab
return e
-- Evaluate using term using `MetaEval` class.
let elabMetaEval : CommandElabM Unit := do
-- act? is `some act` if elaborated `term` has type `CommandElabM α`
let act? runTermElabM fun _ => Term.withDeclName declName do
let e elabEvalTerm
let eType instantiateMVars ( inferType e)
if eType.isAppOfArity ``CommandElabM 1 then
let mut stx Term.exprToSyntax e
unless ( isDefEq eType.appArg! (mkConst ``Unit)) do
stx `($stx >>= fun v => IO.println (repr v))
let act Lean.Elab.Term.evalTerm (CommandElabM Unit) (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) stx
pure <| some act
else
let e mkRunMetaEval e
let env getEnv
let opts getOptions
let act try addAndCompile e; evalConst (Environment Options IO (String × Except IO.Error Environment)) declName finally setEnv env
let (out, res) act env opts -- we execute `act` using the environment
logInfoAt tk out
match res with
| Except.error e => throwError e.toString
| Except.ok env => do setEnv env; pure none
let some act := act? | return ()
act
-- Generate an action without executing it. We use `withoutModifyingEnv` to ensure
-- we don't polute 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))
runTermElabM fun _ => Term.withDeclName declName do withoutModifyingEnv do
let e elabEvalTerm
let eType instantiateMVars ( inferType e)
if eType.isAppOfArity ``CommandElabM 1 then
let mut stx Term.exprToSyntax e
unless ( isDefEq eType.appArg! (mkConst ``Unit)) do
stx `($stx >>= fun v => IO.println (repr v))
let act Lean.Elab.Term.evalTerm (CommandElabM Unit) (mkApp (mkConst ``CommandElabM) (mkConst ``Unit)) stx
pure <| Sum.inl act
else
let e mkRunMetaEval e
addAndCompile e
let act evalConst (Environment Options IO (String × Except IO.Error Environment)) declName
pure <| Sum.inr act
match act with
| .inl act => act
| .inr act =>
let (out, res) act ( getEnv) ( getOptions)
logInfoAt tk out
match res with
| Except.error e => throwError e.toString
| Except.ok env => setEnv env; pure ()
-- Evaluate using term using `Eval` class.
let elabEval : CommandElabM Unit := runTermElabM fun _ => Term.withDeclName declName do
let elabEval : CommandElabM Unit := runTermElabM fun _ => Term.withDeclName declName do withoutModifyingEnv do
-- fall back to non-meta eval if MetaEval hasn't been defined yet
-- modify e to `runEval e`
let e mkRunEval ( elabEvalTerm)
let env getEnv
let act try addAndCompile e; evalConst (IO (String × Except IO.Error Unit)) declName finally setEnv env
addAndCompile e
let act evalConst (IO (String × Except IO.Error Unit)) declName
let (out, res) liftM (m := IO) act
logInfoAt tk out
match res with
@@ -699,6 +704,39 @@ unsafe def elabEvalUnsafe : CommandElab
@[builtin_command_elab «eval», implemented_by elabEvalUnsafe]
opaque elabEval : CommandElab
private def checkImportsForRunCmds : CommandElabM Unit := do
unless ( getEnv).contains ``CommandElabM do
throwError "to use this command, include `import Lean.Elab.Command`"
@[builtin_command_elab runCmd]
def elabRunCmd : CommandElab
| `(run_cmd $elems:doSeq) => do
checkImportsForRunCmds
( liftTermElabM <| Term.withDeclName `_run_cmd <|
unsafe Term.evalTerm (CommandElabM Unit)
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
( `(discard do $elems)))
| _ => throwUnsupportedSyntax
@[builtin_command_elab runElab]
def elabRunElab : CommandElab
| `(run_elab $elems:doSeq) => do
checkImportsForRunCmds
( liftTermElabM <| Term.withDeclName `_run_elab <|
unsafe Term.evalTerm (CommandElabM Unit)
(mkApp (mkConst ``CommandElabM) (mkConst ``Unit))
( `(Command.liftTermElabM <| discard do $elems)))
| _ => throwUnsupportedSyntax
@[builtin_command_elab runMeta]
def elabRunMeta : CommandElab := fun stx =>
match stx with
| `(run_meta $elems:doSeq) => do
checkImportsForRunCmds
let stxNew `(command| run_elab (show Lean.Meta.MetaM Unit from do $elems))
withMacroExpansion stx stxNew do elabCommand stxNew
| _ => throwUnsupportedSyntax
@[builtin_command_elab «synth»] def elabSynth : CommandElab := fun stx => do
let term := stx[1]
withoutModifyingEnv <| runTermElabM fun _ => Term.withDeclName `_synth_cmd do
@@ -722,6 +760,8 @@ opaque elabEval : CommandElab
match stx with
| `($doc:docComment add_decl_doc $id) =>
let declName resolveGlobalConstNoOverloadWithInfo id
unless (( getEnv).getModuleIdxFor? declName).isNone do
throwError "invalid 'add_decl_doc', declaration is in an imported module"
if let .none findDeclarationRangesCore? declName then
-- this is only relevant for declarations added without a declaration range
-- in particular `Quot.mk` et al which are added by `init_quot`

View File

@@ -1,12 +1,16 @@
/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
Authors: Leonardo de Moura, Gabriel Ebner
-/
import Lean.Compiler.BorrowedAnnotation
import Lean.Meta.KAbstract
import Lean.Meta.Closure
import Lean.Meta.MatchUtil
import Lean.Compiler.ImplementedByAttr
import Lean.Elab.SyntheticMVars
import Lean.Elab.Eval
import Lean.Elab.Binders
namespace Lean.Elab.Term
open Meta
@@ -19,6 +23,20 @@ open Meta
throwError "invalid coercion notation, expected type is not known"
ensureHasType expectedType? e
@[builtin_term_elab coeFunNotation] def elabCoeFunNotation : TermElab := fun stx _ => do
let x elabTerm stx[1] none
if let some ty coerceToFunction? x then
return ty
else
throwError "cannot coerce to function{indentExpr x}"
@[builtin_term_elab coeSortNotation] def elabCoeSortNotation : TermElab := fun stx _ => do
let x elabTerm stx[1] none
if let some ty coerceToSort? x then
return ty
else
throwError "cannot coerce to sort{indentExpr x}"
@[builtin_term_elab anonymousCtor] def elabAnonymousCtor : TermElab := fun stx expectedType? =>
match stx with
| `($args,*) => do
@@ -411,4 +429,67 @@ private def withLocalIdentFor (stx : Term) (e : Expr) (k : Term → TermElabM Ex
let e elabTerm stx[1] expectedType?
return DiscrTree.mkNoindexAnnotation e
@[builtin_term_elab «unsafe»]
def elabUnsafe : TermElab := fun stx expectedType? =>
match stx with
| `(unsafe $t) => do
let t elabTermAndSynthesize t expectedType?
if ( logUnassignedUsingErrorInfos ( getMVars t)) then
throwAbortTerm
let t mkAuxDefinitionFor ( mkAuxName `unsafe) t
let .const unsafeFn unsafeLvls .. := t.getAppFn | unreachable!
let .defnInfo unsafeDefn getConstInfo unsafeFn | unreachable!
let implName mkAuxName `unsafe_impl
addDecl <| Declaration.defnDecl {
name := implName
type := unsafeDefn.type
levelParams := unsafeDefn.levelParams
value := ( mkOfNonempty unsafeDefn.type)
hints := .opaque
safety := .safe
}
setImplementedBy implName unsafeFn
return mkAppN (Lean.mkConst implName unsafeLvls) t.getAppArgs
| _ => throwUnsupportedSyntax
/-- Elaborator for `by_elab`. -/
@[builtin_term_elab byElab] def elabRunElab : TermElab := fun stx expectedType? =>
match stx with
| `(by_elab $cmds:doSeq) => do
if let `(Lean.Parser.Term.doSeq| $e:term) := cmds then
if e matches `(Lean.Parser.Term.doSeq| fun $[$_args]* => $_) then
let tac unsafe evalTerm
(Option Expr TermElabM Expr)
(Lean.mkForall `x .default
(mkApp (Lean.mkConst ``Option) (Lean.mkConst ``Expr))
(mkApp (Lean.mkConst ``TermElabM) (Lean.mkConst ``Expr))) e
return tac expectedType?
( unsafe evalTerm (TermElabM Expr) (mkApp (Lean.mkConst ``TermElabM) (Lean.mkConst ``Expr))
( `(do $cmds)))
| _ => throwUnsupportedSyntax
@[builtin_term_elab Lean.Parser.Term.haveI] def elabHaveI : TermElab := fun stx expectedType? => do
match stx with
| `(haveI $x:ident $bs* : $ty := $val; $body) =>
withExpectedType expectedType? fun expectedType => do
let (ty, val) elabBinders bs fun bs => do
let ty elabType ty
let val elabTermEnsuringType val ty
pure ( mkForallFVars bs ty, mkLambdaFVars bs val)
withLocalDeclD x.getId ty fun x => do
return ( ( elabTerm body expectedType).abstractM #[x]).instantiate #[val]
| _ => throwUnsupportedSyntax
@[builtin_term_elab Lean.Parser.Term.letI] def elabLetI : TermElab := fun stx expectedType? => do
match stx with
| `(letI $x:ident $bs* : $ty := $val; $body) =>
withExpectedType expectedType? fun expectedType => do
let (ty, val) elabBinders bs fun bs => do
let ty elabType ty
let val elabTermEnsuringType val ty
pure ( mkForallFVars bs ty, mkLambdaFVars bs val)
withLetDecl x.getId ty val fun x => do
return ( ( elabTerm body expectedType).abstractM #[x]).instantiate #[val]
| _ => throwUnsupportedSyntax
end Lean.Elab.Term

View File

@@ -1,10 +1,11 @@
/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
Authors: Leonardo de Moura, Gabriel Ebner
-/
import Lean.Elab.Binders
import Lean.Elab.SyntheticMVars
import Lean.Elab.SetOption
namespace Lean.Elab.Command
@@ -238,10 +239,11 @@ private def mkInfoTree (elaborator : Name) (stx : Syntax) (trees : PersistentArr
let s get
let scope := s.scopes.head!
let tree := InfoTree.node (Info.ofCommandInfo { elaborator, stx }) trees
return InfoTree.context {
let ctx := PartialContextInfo.commandCtx {
env := s.env, fileMap := ctx.fileMap, mctx := {}, currNamespace := scope.currNamespace,
openDecls := scope.openDecls, options := scope.opts, ngen := s.ngen
} tree
}
return InfoTree.context ctx tree
private def elabCommandUsing (s : State) (stx : Syntax) : List (KeyedDeclsAttribute.AttributeEntry CommandElab) CommandElabM Unit
| [] => withInfoTreeContext (mkInfoTree := mkInfoTree `no_elab stx) <| throwError "unexpected syntax{indentD stx}"
@@ -502,6 +504,49 @@ def expandDeclId (declId : Syntax) (modifiers : Modifiers) : CommandElabM Expand
end Elab.Command
open Elab Command MonadRecDepth
/--
Lifts an action in `CommandElabM` into `CoreM`, updating the traces and the environment.
Commands that modify the processing of subsequent commands,
such as `open` and `namespace` commands,
only have an effect for the remainder of the `CommandElabM` computation passed here,
and do not affect subsequent commands.
-/
def liftCommandElabM (cmd : CommandElabM α) : CoreM α := do
let (a, commandState)
cmd.run {
fileName := getFileName
fileMap := getFileMap
ref := getRef
tacticCache? := none
} |>.run {
env := getEnv
maxRecDepth := getMaxRecDepth
scopes := [{ header := "", opts := getOptions }]
}
modify fun coreState => { coreState with
traceState.traces := coreState.traceState.traces ++ commandState.traceState.traces
env := commandState.env
}
if let some err := commandState.messages.msgs.toArray.find? (·.severity matches .error) then
throwError err.data
pure a
/--
Given a command elaborator `cmd`, returns a new command elaborator that
first evaluates any local `set_option ... in ...` clauses and then invokes `cmd` on what remains.
-/
partial def withSetOptionIn (cmd : CommandElab) : CommandElab := fun stx => do
if stx.getKind == ``Lean.Parser.Command.in &&
stx[0].getKind == ``Lean.Parser.Command.set_option then
let opts Elab.elabSetOption stx[0][1] stx[0][2]
Command.withScope (fun scope => { scope with opts }) do
withSetOptionIn cmd stx[1]
else
cmd stx
export Elab.Command (Linter addLinter)
end Lean

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