1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-26 09:04:18 +03:00
juvix/test/Termination/Positive.hs
Łukasz Czajka 9f25ffde16
Detect termination for nested local definitions (#3169)
* Closes #3147 

When we call a function that is currently being defined (there may be
several such due to nested local definitions), we add a reflexive edge
in the call map instead of adding an edge from the most nested
definition. For example, for

```juvix
go {A B} (f : A -> B) : List A -> List B
  | nil := nil
  | (elem :: next) :=
    let var1 := f elem;
        var2 := go f next;
    in var1 :: var2;
```

we add an edge from `go` to the recursive call `go f next`, instead of
adding an edge from `var2` to `go f next` as before.

This makes the above type-check.

The following still doesn't type-check, because `next'` is not a
subpattern of the clause pattern of `go`. But this is a less pressing
problem.

```juvix
go {A B} (f : A -> B) : List A -> List B
  | nil := nil
  | (elem :: next) :=
    let var1 := f elem;
        var2 (next' : List A) : List B := go f next';
    in myCons var1 (var2 next);
```
2024-11-15 12:30:18 +01:00

110 lines
3.0 KiB
Haskell

module Termination.Positive where
import Base
import Termination.Negative qualified as N
data PosTest = PosTest
{ _name :: String,
_relDir :: Path Rel Dir,
_file :: Path Rel File
}
root :: Path Abs Dir
root = relToProject $(mkRelDir "tests/positive/Termination")
testDescr :: PosTest -> TestDescr
testDescr PosTest {..} =
let tRoot = root <//> _relDir
file' = tRoot <//> _file
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Single $ do
entryPoint <- set entryPointNoStdlib True <$> testDefaultEntryPointIO tRoot file'
(void . testRunIO entryPoint) upToInternalTyped
}
--------------------------------------------------------------------------------
-- Testing --no-termination flag with all termination negative tests
--------------------------------------------------------------------------------
rootNegTests :: Path Abs Dir
rootNegTests = relToProject $(mkRelDir "tests/negative/Termination")
testDescrFlag :: N.NegTest -> TestDescr
testDescrFlag N.NegTest {..} =
let tRoot = rootNegTests <//> _relDir
file' = tRoot <//> _file
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Single $ do
entryPoint <-
set entryPointNoTermination True
. set entryPointNoStdlib True
<$> testDefaultEntryPointIO tRoot file'
(void . testRunIO entryPoint) upToInternalTyped
}
tests :: [PosTest]
tests =
[ PosTest
"Ackerman nice def. is terminating"
$(mkRelDir ".")
$(mkRelFile "Ack.juvix"),
PosTest
"Fibonacci with nested pattern"
$(mkRelDir ".")
$(mkRelFile "Fib.juvix"),
PosTest
"Recursive functions on Lists"
$(mkRelDir ".")
$(mkRelFile "Data/List.juvix"),
PosTest
"Recursive function on a tree"
$(mkRelDir ".")
$(mkRelFile "TreeGen.juvix"),
PosTest
"Ignore instance arguments"
$(mkRelDir ".")
$(mkRelFile "issue2414.juvix"),
PosTest
"Nested local definitions"
$(mkRelDir ".")
$(mkRelFile "Nested1.juvix"),
PosTest
"Named arguments"
$(mkRelDir ".")
$(mkRelFile "Nested2.juvix")
]
testsWithKeyword :: [PosTest]
testsWithKeyword =
[ PosTest
"terminating for all functions in the mutual block"
$(mkRelDir ".")
$(mkRelFile "Mutual.juvix"),
PosTest
"Undefined is terminating by assumption"
$(mkRelDir ".")
$(mkRelFile "Undefined.juvix")
]
negTests :: [N.NegTest]
negTests = N.tests
allTests :: TestTree
allTests =
testGroup
"Termination positive tests"
[ testGroup
"Well-known terminating functions"
(map (mkTest . testDescr) tests),
testGroup
"Bypass termination checking using --non-termination flag on negative tests"
(map (mkTest . testDescrFlag) negTests),
testGroup
"Terminating keyword"
(map (mkTest . testDescr) testsWithKeyword)
]