lean4-htt/tests/lean/guessLex.lean
Joachim Breitner d6c81f8594
feat: GuessLex: print inferred termination argument (#3012)
With

    set_option showInferredTerminationBy true

this prints a message like

    Inferred termination argument:
    termination_by
      ackermann n m => (sizeOf n, sizeOf m)

it tries hard to use names that

 * match the names that the user used, if present
 * have no daggers (so that it can be copied)
 * do not shadow each other
 * do not shadow anything from the environment (just to be nice)

it does so by appending sufficient `'` to the name.

Some of the emitted `sizeOf` calls are unnecessary, but they are needed
sometimes with dependent parameters. A follow-up PR will not emit them
for non-dependent arguments, so that in most cases the output is pretty.

Somewhen down the road we also want a code action, maybe triggered by
`termination_by?`. This should come after #2921, as that simplifies that
feature (no need to merge termination arguments from different cliques
for example.)
2023-12-05 09:41:52 +00:00

144 lines
4.1 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/-!
This files tests Lean's ability to guess the right lexicographic order.
TODO: Once lean spits out the guessed order (probably guarded by an
option), turn this on and check the output.
When writing tests for GuesLex, keep in mind that it doesn't do anything
when there is only one plausible measure (one function, only one varying argument).
-/
set_option showInferredTerminationBy true
def ackermann (n m : Nat) := match n, m with
| 0, m => m + 1
| .succ n, 0 => ackermann n 1
| .succ n, .succ m => ackermann n (ackermann (n + 1) m)
def ackermann2 (n m : Nat) := match n, m with
| m, 0 => m + 1
| 0, .succ n => ackermann2 1 n
| .succ m, .succ n => ackermann2 (ackermann2 m (n + 1)) n
def ackermannList (n m : List Unit) := match n, m with
| [], m => () :: m
| ()::n, [] => ackermannList n [()]
| ()::n, ()::m => ackermannList n (ackermannList (()::n) m)
def foo2 : Nat → Nat → Nat
| .succ n, 1 => foo2 n 1
| .succ n, 2 => foo2 (.succ n) 1
| n, 3 => foo2 (.succ n) 2
| .succ n, 4 => foo2 (if n > 10 then n else .succ n) 3
| n, 5 => foo2 (n - 1) 4
| n, .succ m => foo2 n m
| _, _ => 0
mutual
def even : Nat → Bool
| 0 => true
| .succ n => not (odd n)
def odd : Nat → Bool
| 0 => false
| .succ n => not (even n)
end
mutual
def evenWithFixed (m : String) : Nat → Bool
| 0 => true
| .succ n => not (oddWithFixed m n)
def oddWithFixed (m : String) : Nat → Bool
| 0 => false
| .succ n => not (evenWithFixed m n)
end
def ping (n : Nat) := pong n
where pong : Nat → Nat
| 0 => 0
| .succ n => ping n
def hasForbiddenArg (n : Nat) (_h : n = n) (m : Nat) : Nat :=
match n, m with
| 0, 0 => 0
| .succ m, n => hasForbiddenArg m rfl n
| m, .succ n => hasForbiddenArg (.succ m) rfl n
/-!
Example from “Finding Lexicographic Orders for Termination Proofs in
Isabelle/HOL” by Lukas Bulwahn, Alexander Krauss, and Tobias Nipkow,
10.1007/978-3-540-74591-4_5
-/
def blowup : Nat → Nat → Nat → Nat → Nat → Nat → Nat → Nat → Nat
| 0, 0, 0, 0, 0, 0, 0, 0 => 0
| 0, 0, 0, 0, 0, 0, 0, .succ i => .succ (blowup i i i i i i i i)
| 0, 0, 0, 0, 0, 0, .succ h, i => .succ (blowup h h h h h h h i)
| 0, 0, 0, 0, 0, .succ g, h, i => .succ (blowup g g g g g g h i)
| 0, 0, 0, 0, .succ f, g, h, i => .succ (blowup f f f f f g h i)
| 0, 0, 0, .succ e, f, g, h, i => .succ (blowup e e e e f g h i)
| 0, 0, .succ d, e, f, g, h, i => .succ (blowup d d d e f g h i)
| 0, .succ c, d, e, f, g, h, i => .succ (blowup c c d e f g h i)
| .succ b, c, d, e, f, g, h, i => .succ (blowup b c d e f g h i)
-- Lets try to confuse the lexicographic guessing function's
-- unpacking of packed n-ary arguments
def confuseLex1 : Nat → @PSigma Nat (fun _ => Nat) → Nat
| 0, _p => 0
| .succ n, ⟨x,y⟩ => confuseLex1 n ⟨x, .succ y⟩
def confuseLex2 : @PSigma Nat (fun _ => Nat) → Nat
| ⟨_,0⟩ => 0
| ⟨0,_⟩ => 0
| ⟨.succ y,.succ n⟩ => confuseLex2 ⟨y,n⟩
def dependent : (n : Nat) → (m : Fin n) → Nat
| 0, i => Fin.elim0 i
| .succ 0, 0 => 0
| .succ (.succ n), 0 => dependent (.succ n) ⟨n, n.lt_succ_self⟩
| .succ (.succ n), ⟨.succ m, h⟩ =>
dependent (.succ (.succ n)) ⟨m, Nat.lt_of_le_of_lt (Nat.le_succ _) h⟩
-- An example based on a real world problem, condensed by Leo
inductive Expr where
| add (a b : Expr)
| val (n : Nat)
mutual
def eval (a : Expr) : Nat :=
match a with
| .add x y => eval_add (x, y)
| .val n => n
def eval_add (a : Expr × Expr) : Nat :=
match a with
| (x, y) => eval x + eval y
end
namespace VarNames
/-! Test that varnames are inferred nicely. -/
def shadow1 (x2 : Nat) : Nat → Nat
| 0 => 0
| .succ n => shadow1 (x2 + 1) n
decreasing_by decreasing_tactic
def some_n : Nat := 1
def shadow2 (some_n : Nat) : Nat → Nat
| 0 => 0
| .succ n => shadow2 (some_n + 1) n
decreasing_by decreasing_tactic
def shadow3 (sizeOf : Nat) : Nat → Nat
| 0 => 0
| .succ n => shadow3 (sizeOf + 1) n
decreasing_by decreasing_tactic
def sizeOf : Nat := 2 -- should cause sizeOf to be qualfied below
def qualifiedSizeOf (m : Nat) : Nat → Nat
| 0 => 0
| .succ n => qualifiedSizeOf (m + 1) n
decreasing_by decreasing_tactic
end VarNames