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).
149 lines
3.4 KiB
Text
149 lines
3.4 KiB
Text
/-!
|
||
Examples of partial functions taken from
|
||
https://github.com/AeneasVerif/aeneas/blob/9d3febaff93ff02756c648561c9ad2b18d5d9b62/backends/lean/Base/Diverge/Elab.lean
|
||
and using Option instead of Result
|
||
-/
|
||
|
||
abbrev Result := Option
|
||
abbrev Result.ok := @Option.some
|
||
|
||
def list_nth {a: Type u} (ls : List a) (i : Int) : Option a :=
|
||
match ls with
|
||
| [] => none
|
||
| x :: ls => do
|
||
if i = 0 then pure x
|
||
else pure (← list_nth ls (i - 1))
|
||
partial_fixpoint
|
||
|
||
def list_nth_with_back {a: Type} (ls : List a) (i : Int) :
|
||
Result (a × (a → Result (List a))) :=
|
||
match ls with
|
||
| [] => none
|
||
| x :: ls =>
|
||
if i = 0 then return (x, (λ ret => return (ret :: ls)))
|
||
else do
|
||
let (x, back) ← list_nth_with_back ls (i - 1)
|
||
return (x,
|
||
(λ ret => do
|
||
let ls ← back ret
|
||
return (x :: ls)))
|
||
partial_fixpoint
|
||
|
||
|
||
mutual
|
||
def is_even (i : Int) : Result Bool :=
|
||
if i = 0 then return true else return (← is_odd (i - 1))
|
||
partial_fixpoint
|
||
|
||
def is_odd (i : Int) : Result Bool :=
|
||
if i = 0 then return false else return (← is_even (i - 1))
|
||
partial_fixpoint
|
||
end
|
||
|
||
mutual
|
||
def foo (i : Int) : Result Nat :=
|
||
if i > 10 then return (← foo (i / 10)) + (← bar i) else bar 10
|
||
partial_fixpoint
|
||
|
||
def bar (i : Int) : Result Nat :=
|
||
if i > 20 then foo (i / 20) else .ok 42
|
||
partial_fixpoint
|
||
end
|
||
|
||
def test1 (_ : Option Bool) (_ : Unit) : Result Unit
|
||
:= test1 Option.none ()
|
||
partial_fixpoint
|
||
|
||
def infinite_loop : Result Unit := do
|
||
let _ ← infinite_loop
|
||
Result.ok ()
|
||
partial_fixpoint
|
||
|
||
def infinite_loop1 : Result Unit :=
|
||
infinite_loop1
|
||
partial_fixpoint
|
||
|
||
section HigherOrder
|
||
inductive Tree (a : Type u) where
|
||
| leaf (x : a)
|
||
| node (tl : List (Tree a))
|
||
|
||
def Tree.id {a : Type u} (t : Tree a) : Result (Tree a) :=
|
||
match t with
|
||
| .leaf x => .ok (.leaf x)
|
||
| .node tl =>
|
||
do
|
||
let tl ← List.mapM Tree.id tl
|
||
.ok (.node tl)
|
||
partial_fixpoint
|
||
|
||
def id1 {a : Type u} (t : Tree a) : Result (Tree a) :=
|
||
match t with
|
||
| .leaf x => .ok (.leaf x)
|
||
| .node tl =>
|
||
do
|
||
let tl ← List.mapM (fun x => id1 x) tl
|
||
.ok (.node tl)
|
||
partial_fixpoint
|
||
|
||
def id2 {a : Type u} (t : Tree a) : Result (Tree a) :=
|
||
match t with
|
||
| .leaf x => .ok (.leaf x)
|
||
| .node tl =>
|
||
do
|
||
let tl ← List.mapM (fun x => do let _ ← id2 x; id2 x) tl
|
||
.ok (.node tl)
|
||
partial_fixpoint
|
||
|
||
def incr (t : Tree Nat) : Result (Tree Nat) :=
|
||
match t with
|
||
| .leaf x => .ok (.leaf (x + 1))
|
||
| .node tl =>
|
||
do
|
||
let tl ← List.mapM incr tl
|
||
.ok (.node tl)
|
||
partial_fixpoint
|
||
|
||
def id3 (t : Tree Nat) : Result (Tree Nat) :=
|
||
match t with
|
||
| .leaf x => .ok (.leaf (x + 1))
|
||
| .node tl =>
|
||
do
|
||
let f := id3
|
||
let tl ← List.mapM f tl
|
||
.ok (.node tl)
|
||
partial_fixpoint
|
||
|
||
def id4 (t : Tree Nat) : Result (Tree Nat) :=
|
||
match t with
|
||
| .leaf x => .ok (.leaf (x + 1))
|
||
| .node tl =>
|
||
do
|
||
let f x := do
|
||
let x1 ← id4 x
|
||
id4 x1
|
||
let tl ← List.mapM f tl
|
||
.ok (.node tl)
|
||
partial_fixpoint
|
||
|
||
|
||
-- Like aeneas, we cannot handle the following
|
||
|
||
/--
|
||
error: Could not prove 'id5' to be monotone in its recursive calls:
|
||
Cannot eliminate recursive call `id5` enclosed in
|
||
Result.ok id5
|
||
-/
|
||
#guard_msgs in
|
||
def id5 (t : Tree Nat) : Result (Tree Nat) :=
|
||
match t with
|
||
| .leaf x => .ok (.leaf (x + 1))
|
||
| .node tl =>
|
||
do
|
||
let f ← .ok id5
|
||
let tl ← List.mapM f tl
|
||
.ok (.node tl)
|
||
partial_fixpoint
|
||
|
||
|
||
end HigherOrder
|