7b813d4f5d
This PR adds the ability to define possibly non-terminating functions
and still be able to reason about them equationally, as long as they are
tail-recursive or monadic.
Typical uses of this feature are
```lean4
def ack : (n m : Nat) → Option Nat
| 0, y => some (y+1)
| x+1, 0 => ack x 1
| x+1, y+1 => do ack x (← ack (x+1) y)
partial_fixpiont
def whileSome (f : α → Option α) (x : α) : α :=
match f x with
| none => x
| some x' => whileSome f x'
partial_fixpiont
def computeLfp {α : Type u} [DecidableEq α] (f : α → α) (x : α) : α :=
let next := f x
if x ≠ next then
computeLfp f next
else
x
partial_fixpiont
noncomputable def geom : Distr Nat := do
let head ← coin
if head then
return 0
else
let n ← geom
return (n + 1)
partial_fixpiont
```
This PR contains
* The necessary fragment of domain theory, up to (a variant of)
Knaster–Tarski theorem (merged as
https://github.com/leanprover/lean4/pull/6477)
* A tactic to solve monotonicity goals compositionally (a bit like
mathlib’s `fun_prop`) (merged as
https://github.com/leanprover/lean4/pull/6506)
* An attribute to extend that tactic (merged as
https://github.com/leanprover/lean4/pull/6506)
* A “derecursifier” that uses that machinery to define recursive
function, including support for dependent functions and mutual
recursion.
* Fixed-point induction principles (technical, tedious to use)
* For `Option`-valued functions: Partial correctness induction theorems
that hide all the domain theory
This is heavily inspired by [Isabelle’s `partial_function`
command](https://isabelle.in.tum.de/doc/codegen.pdf).
97 lines
3.3 KiB
Text
97 lines
3.3 KiB
Text
/-!
|
||
Johannes Hölzl pointed out that the `partial_fixpoint` machinery can be applied to `Prop` to define
|
||
inductive or (when using the dual order) coinductive predicates.
|
||
|
||
Without an induction principle this isn't so useful, though.
|
||
-/
|
||
|
||
open Lean.Order
|
||
|
||
instance : PartialOrder Prop where
|
||
rel x y := y → x -- NB: Dual
|
||
rel_refl := fun x => x
|
||
rel_trans h₁ h₂ := fun x => h₁ (h₂ x)
|
||
rel_antisymm h₁ h₂ := propext ⟨h₂, h₁⟩
|
||
|
||
instance : CCPO Prop where
|
||
csup c := ∀ p, c p → p
|
||
csup_spec := fun _ =>
|
||
⟨fun h y hcy hx => h hx y hcy, fun h hx y hcy => h y hcy hx ⟩
|
||
|
||
@[partial_fixpoint_monotone] theorem monotone_exists
|
||
{α} [PartialOrder α] {β} (f : α → β → Prop)
|
||
(h : monotone f) :
|
||
monotone (fun x => Exists (f x)) :=
|
||
fun x y hxy ⟨w, hw⟩ => ⟨w, monotone_apply w f h x y hxy hw⟩
|
||
|
||
@[partial_fixpoint_monotone] theorem monotone_and
|
||
{α} [PartialOrder α] (f₁ : α → Prop) (f₂ : α → Prop)
|
||
(h₁ : monotone f₁) (h₂ : monotone f₂) :
|
||
monotone (fun x => f₁ x ∧ f₂ x) :=
|
||
fun x y hxy ⟨hfx₁, hfx₂⟩ => ⟨h₁ x y hxy hfx₁, h₂ x y hxy hfx₂⟩
|
||
|
||
def univ (n : Nat) : Prop :=
|
||
univ (n + 1)
|
||
partial_fixpoint
|
||
|
||
/-
|
||
The following models a coinductive predicate defined as
|
||
```
|
||
coinductive infinite_chain step : α → Prop where
|
||
| intro : ∀ y x, step x = some y → infinite_chain step y → infinite_chain step
|
||
```
|
||
-/
|
||
def infinite_chain {α} (step : α → Option α) (x : α) : Prop :=
|
||
∃ y, step x = some y ∧ infinite_chain step y
|
||
partial_fixpoint
|
||
|
||
theorem infinite_chain.intro {α} (step : α → Option α) (y x : α) :
|
||
step x = some y → infinite_chain step y → infinite_chain step x := by
|
||
intros; unfold infinite_chain; simp [*]
|
||
|
||
theorem infinite_chain.coinduct {α} (P : α → Prop) (step : α → Option α)
|
||
(h : ∀ (x : α), P x → ∃ y, step x = some y ∧ P y) :
|
||
∀ x, P x → infinite_chain step x := by
|
||
apply infinite_chain.fixpoint_induct step
|
||
(motive := fun i => ∀ (x : α), P x → i x)
|
||
case adm =>
|
||
clear h step
|
||
apply admissible_pi
|
||
intro a
|
||
intro c hchain h hPa Q ⟨f, hcf, hfaQ⟩
|
||
subst Q
|
||
apply h f hcf hPa
|
||
case h =>
|
||
intro ic hPic x hPx
|
||
obtain ⟨y, hstepx, h⟩ := h x hPx
|
||
exact ⟨y, hstepx, hPic y h⟩
|
||
|
||
/--
|
||
Isabelle generates a stronger coinduction theorem from
|
||
```
|
||
coinductive infinite_chain :: "('a ⇒ 'a option) ⇒ 'a ⇒ bool" for step :: "'a ⇒ 'a option" where
|
||
intro: "infinite_chain step x" if "step x = Some y" and "infinite_chain step y"
|
||
```
|
||
Note the occurrence of `infinite_chain` in the step:
|
||
```
|
||
Scratch.infinite_chain.coinduct:
|
||
?X ?x ⟹
|
||
(⋀x. ?X x ⟹ ∃xa y. x = xa ∧ ?step xa = Some y ∧ (?X y ∨ infinite_chain ?step y)) ⟹
|
||
infinite_chain ?step ?x
|
||
```
|
||
We can prove that from the one above.
|
||
-/
|
||
theorem infinite_chain.coinduct_strong {α} (P : α → Prop) (step : α → Option α)
|
||
(h : ∀ (x : α), P x → ∃ y, step x = some y ∧ (P y ∨ infinite_chain step y)) :
|
||
∀ x, P x → infinite_chain step x := by
|
||
suffices ∀ x, (P x ∨ infinite_chain step x) → infinite_chain step x by
|
||
intro x hPx
|
||
exact this x (.inl hPx)
|
||
apply infinite_chain.coinduct
|
||
intro x hor
|
||
cases hor
|
||
next hPx => exact h _ hPx
|
||
next hicx =>
|
||
unfold infinite_chain at hicx
|
||
obtain ⟨y, hstepx, h⟩ := hicx
|
||
exact ⟨y, hstepx, .inr h⟩
|