39286862e3
we keep running into examples where working with well-founded recursion is slow because defeq checks (which are all over the place, including failing ones that are back-tracked) unfold well-founded definitions. The definition of a function defined by well-founded recursion should be an implementation detail that should only be peeked inside by the equation generator and the functional induction generator. We now mark the mutual recursive function as irreducible (if the user did not set a flag explicitly), and use `withAtLeastTransparency .all` when producing the equations. Proofs can be fixed by using rewriting, or – a bit blunt, but nice for adjusting existing proofs – using `unseal` (a.k.a. `attribute [local semireducible]`). Mathlib performance does not change a whole lot: http://speed.lean-fro.org/mathlib4/compare/08b82265-75db-4a28-b12b-08751b9ad04a/to/16f46d5e-28b1-41c4-a107-a6f6594841f8 Build instructions -0.126 %, four modules with significant instructions decrease. To reduce impact, these definitions were changed: * `Nat.mod`, to make `1 % n` reduce definitionally, so that `1` as a `Fin 2` literal works nicely. Theorems with larger `Fin` literals tend to need a `unseal Nat.modCore` https://github.com/leanprover/lean4/pull/4098 * `List.ofFn` rewritten to be structurally recursive and not go via `Array.ofFn`: https://github.com/leanprover-community/batteries/pull/784 Alternative designs explored were * Making `WellFounded.fix` irreducible. One benefit is that recursive functions with equal definitions (possibly after instantiating fixed parameters) are defeq; this is used in mathlib to relate [`OrdinalApprox.gfpApprox`](https://leanprover-community.github.io/mathlib4_docs/Mathlib/SetTheory/Ordinal/FixedPointApproximants.html#OrdinalApprox.gfpApprox) with `.lfpApprox`. But the downside is that one cannot use `unseal` in a targeted way, being explicit in which recursive function needs to be reducible here. And in cases where Lean does unwanted unfolding, we’d still unfold the recursive definition once to expose `WellFounded.fix`, leading to large terms for often no good reason. * Defining `WellFounded.fix` to unroll defintionally once before hitting a irreducible `WellFounded.fixF`. This was explored in #4002. It shares most of the ups and downs with the previous variant, with the additional neat benefit that function calls that do not lead to recursive cases (e.g. a `[]` base case) reduce nicely. This means that the majority of existing `rfl` proofs continue to work. Issue #4051, which demonstrates how badly things can go if wf recursive functions can be unrolled, showed that making the recursive function irreducible there leads to noticeably faster elaboration than making `WellFounded.fix` irreducible; this is good evidence that the present PR is the way to go. This fixes https://github.com/leanprover/lean4/issues/3988 --------- Co-authored-by: Leonardo de Moura <leomoura@amazon.com>
115 lines
3.5 KiB
Text
115 lines
3.5 KiB
Text
inductive ListSplit : List α → Type _
|
||
| split l₁ l₂ : ListSplit (l₁ ++ l₂)
|
||
|
||
def splitList : (l : List α) → ListSplit l
|
||
| [] => ListSplit.split [] []
|
||
| h :: t => ListSplit.split [h] t
|
||
|
||
@[simp] def ListSplit.left {as : List α} : ListSplit as → List α
|
||
| split a b => a
|
||
|
||
@[simp] def ListSplit.right {as : List α} : ListSplit as → List α
|
||
| split a b => b
|
||
|
||
/-- Helper theorem for justifying termination. -/
|
||
theorem splitList_length (as : List α) (h₁ : as.length > 1) (h₂ : as = bs) : (splitList as).left.length < bs.length ∧ (splitList as).right.length < bs.length := by
|
||
match as with
|
||
| [] => contradiction
|
||
| a :: as => simp_arith [← h₂, splitList]; simp_arith at h₁; assumption
|
||
|
||
def len : List α → Nat
|
||
| [] => 0
|
||
| a :: [] => 1
|
||
| l@h₁:(a :: b :: as) =>
|
||
-- Remark: we didn't use `_` because we currently don't have a way for getting a hypothesis stating that the previous two case were not taken here.
|
||
-- h₁ : l = a :: b :: as
|
||
match h₂ : splitList l with
|
||
| ListSplit.split fst snd =>
|
||
-- Remark: `match` refined `h₁`s type to `h₁ : fst ++ snd = a :: b :: as`
|
||
-- h₂ : HEq (splitList l) (ListSplit.split fst snd)
|
||
have := splitList_length (fst ++ snd) (by simp_arith [h₁]) h₁
|
||
-- The following two proofs ase used to justify the recursive applications `len fst` and `len snd`
|
||
have dec₁ : fst.length < as.length + 2 := by subst l; simp_arith [eq_of_heq h₂] at this |- ; simp [this]
|
||
have dec₂ : snd.length < as.length + 2 := by subst l; simp_arith [eq_of_heq h₂] at this |- ; simp [this]
|
||
len fst + len snd
|
||
termination_by xs => xs.length
|
||
|
||
|
||
-- The equational theorems are
|
||
#check @len.eq_1
|
||
#check @len.eq_2
|
||
#check @len.eq_3
|
||
#check @len.eq_def
|
||
|
||
theorem len_nil : len ([] : List α) = 0 := by
|
||
simp [len]
|
||
|
||
theorem len_1 (a : α) : len [a] = 1 := by
|
||
simp [len]
|
||
|
||
theorem len_2 (a b : α) (bs : List α) : len (a::b::bs) = 1 + len (b::bs) := by
|
||
simp [len, splitList]
|
||
|
||
theorem len_cons (a : α) (as : List α) : len (a::as) = 1 + len as := by
|
||
cases as with
|
||
| nil => simp [len_1, len_nil]
|
||
| cons b bs => simp [len_2]
|
||
|
||
theorem listlen : ∀ l : List α, l.length = len l := by
|
||
intro l
|
||
induction l with
|
||
| nil => simp [len_nil]
|
||
| cons h t ih =>
|
||
simp [List.length, len_cons, ih]
|
||
rw [Nat.add_comm]
|
||
|
||
namespace Ex2
|
||
|
||
/--
|
||
`len` example again but with the proofs at `decreasing_by`
|
||
-/
|
||
def len : List α → Nat
|
||
| [] => 0
|
||
| a :: [] => 1
|
||
| l@h₁:(a :: b :: as) =>
|
||
match h₂ : l, h₃ : splitList l with
|
||
| _, ListSplit.split fst snd =>
|
||
len fst + len snd
|
||
termination_by xs => xs.length
|
||
decreasing_by
|
||
all_goals
|
||
simp_wf
|
||
have := splitList_length (fst ++ snd) (by simp_arith [h₁]) h₁
|
||
subst h₂
|
||
simp_arith [eq_of_heq h₃] at this |- ; simp [this]
|
||
|
||
-- The equational theorems are
|
||
#check @len.eq_1
|
||
#check @len.eq_2
|
||
#check @len.eq_3
|
||
#check @len.eq_def
|
||
|
||
theorem len_nil : len ([] : List α) = 0 := by
|
||
simp [len]
|
||
|
||
theorem len_1 (a : α) : len [a] = 1 := by
|
||
simp [len]
|
||
|
||
theorem len_2 (a b : α) (bs : List α) : len (a::b::bs) = 1 + len (b::bs) := by
|
||
conv => lhs; unfold len
|
||
simp [len, splitList]
|
||
|
||
theorem len_cons (a : α) (as : List α) : len (a::as) = 1 + len as := by
|
||
cases as with
|
||
| nil => simp [len_1, len_nil]
|
||
| cons b bs => simp [len_2]
|
||
|
||
theorem listlen : ∀ l : List α, l.length = len l := by
|
||
intro l
|
||
induction l with
|
||
| nil => simp [len_nil]
|
||
| cons h t ih =>
|
||
simp [List.length, len_cons, ih]
|
||
rw [Nat.add_comm]
|
||
|
||
end Ex2
|