1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-19 12:51:39 +03:00
juvix/test/Typecheck/Positive.hs

326 lines
8.7 KiB
Haskell
Raw Normal View History

module Typecheck.Positive where
import Base
2023-01-17 11:41:07 +03:00
import Compilation.Positive qualified as Compilation
Run test suite in parallel (#2507) ## Overview This PR makes the compiler pipeline thread-safe so that the test suite can be run in parallel. This is achieved by: * Removing use of `{get, set, with}CurrentDir` functions. * Adding locking around shared file resources like the the global-project and internal build directory. NB: **Locking is disabled for the main compiler target**, as it is single threaded they are not required. ## Run test suite in parallel To run the test suite in parallel you must add `--ta '+RTS -N -RTS'` to your stack test arguments. For example: ``` stack test --fast --ta '+RTS -N -RTS' ``` The `-N` instructs the Haskell runtime to choose the number of threads to use based on how many processors there are on your machine. You can use `-Nn` to see the number of threads to `n`. These flags are already [set in the Makefile](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/Makefile#L26) when you or CI uses `stack test`. ## Locking The Haskell package [filelock](https://hackage.haskell.org/package/filelock) is used for locking. File locks are used instead of MVars because Juvix code does not control when new threads are created, they are created by the test suite. This means that MVars created by Juvix code will have no effect, because they are created independently on each test-suite thread. Additionally the resources we're locking live on the filesystem and so can be conveniently tagged by path. ### FileLock The filelock library is wrapped in a FileLock effect: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Base.hs#L6-L8 There is an [IO interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/IO.hs#L8) that uses filelock and an [no-op interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Permissive.hs#L7) that just runs actions unconditionally. ### TaggedLock To make the file locks simpler to use a TaggedLock effect is introduced: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock/Base.hs#L5-L11 And convenience function: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock.hs#L28 This allows an action to be locked, tagged by a directory that may or may not exist. For example in the following code, an action is performed on a directory `root` that may delete the directory before repopulating the files. So the lockfile cannot be stored in the `root` itself. https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Extra/Files.hs#L55-L60 ## Pipeline As noted above, we only use locking in the test suite. The main app target pipeline is single threaded and so locking is unnecessary. So the interpretation of locks is parameterised so that locking can be disabled https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Compiler/Pipeline/Run.hs#L64
2023-11-16 18:19:52 +03:00
import Juvix.Data.Effect.TaggedLock
import Typecheck.Negative qualified as N
data PosTest = PosTest
2022-04-08 13:46:37 +03:00
{ _name :: String,
2023-01-17 11:41:07 +03:00
_dir :: Path Abs Dir,
_file :: Path Abs File
}
makeLenses ''PosTest
2022-12-20 15:05:40 +03:00
root :: Path Abs Dir
root = relToProject $(mkRelDir "tests/positive")
2023-01-17 11:41:07 +03:00
posTest :: String -> Path Rel Dir -> Path Rel File -> PosTest
posTest _name rdir rfile = posTestAbsDir _name (root <//> rdir) rfile
posTestAbsDir :: String -> Path Abs Dir -> Path Rel File -> PosTest
posTestAbsDir _name _dir f =
PosTest
{ _file = _dir <//> f,
_dir,
_name
}
2023-01-17 11:41:07 +03:00
testDescr :: PosTest -> TestDescr
testDescr PosTest {..} =
2023-01-17 11:41:07 +03:00
TestDescr
{ _testName = _name,
_testRoot = _dir,
_testAssertion = Single $ do
Run test suite in parallel (#2507) ## Overview This PR makes the compiler pipeline thread-safe so that the test suite can be run in parallel. This is achieved by: * Removing use of `{get, set, with}CurrentDir` functions. * Adding locking around shared file resources like the the global-project and internal build directory. NB: **Locking is disabled for the main compiler target**, as it is single threaded they are not required. ## Run test suite in parallel To run the test suite in parallel you must add `--ta '+RTS -N -RTS'` to your stack test arguments. For example: ``` stack test --fast --ta '+RTS -N -RTS' ``` The `-N` instructs the Haskell runtime to choose the number of threads to use based on how many processors there are on your machine. You can use `-Nn` to see the number of threads to `n`. These flags are already [set in the Makefile](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/Makefile#L26) when you or CI uses `stack test`. ## Locking The Haskell package [filelock](https://hackage.haskell.org/package/filelock) is used for locking. File locks are used instead of MVars because Juvix code does not control when new threads are created, they are created by the test suite. This means that MVars created by Juvix code will have no effect, because they are created independently on each test-suite thread. Additionally the resources we're locking live on the filesystem and so can be conveniently tagged by path. ### FileLock The filelock library is wrapped in a FileLock effect: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Base.hs#L6-L8 There is an [IO interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/IO.hs#L8) that uses filelock and an [no-op interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Permissive.hs#L7) that just runs actions unconditionally. ### TaggedLock To make the file locks simpler to use a TaggedLock effect is introduced: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock/Base.hs#L5-L11 And convenience function: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock.hs#L28 This allows an action to be locked, tagged by a directory that may or may not exist. For example in the following code, an action is performed on a directory `root` that may delete the directory before repopulating the files. So the lockfile cannot be stored in the `root` itself. https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Extra/Files.hs#L55-L60 ## Pipeline As noted above, we only use locking in the test suite. The main app target pipeline is single threaded and so locking is unnecessary. So the interpretation of locks is parameterised so that locking can be disabled https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Compiler/Pipeline/Run.hs#L64
2023-11-16 18:19:52 +03:00
entryPoint <- defaultEntryPointIO' LockModeExclusive _dir _file
(void . runIOExclusive entryPoint) upToInternalTyped
2023-01-17 11:41:07 +03:00
}
2022-12-20 15:05:40 +03:00
rootNegTests :: Path Abs Dir
rootNegTests = relToProject $(mkRelDir "tests/negative/")
-- Testing --no-positivity flag with all related negative tests
testNoPositivityFlag :: N.NegTest -> TestDescr
testNoPositivityFlag N.NegTest {..} =
2022-12-20 15:05:40 +03:00
let tRoot = rootNegTests <//> _relDir
file' = tRoot <//> _file
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Single $ do
entryPoint <-
set entryPointNoPositivity True
Run test suite in parallel (#2507) ## Overview This PR makes the compiler pipeline thread-safe so that the test suite can be run in parallel. This is achieved by: * Removing use of `{get, set, with}CurrentDir` functions. * Adding locking around shared file resources like the the global-project and internal build directory. NB: **Locking is disabled for the main compiler target**, as it is single threaded they are not required. ## Run test suite in parallel To run the test suite in parallel you must add `--ta '+RTS -N -RTS'` to your stack test arguments. For example: ``` stack test --fast --ta '+RTS -N -RTS' ``` The `-N` instructs the Haskell runtime to choose the number of threads to use based on how many processors there are on your machine. You can use `-Nn` to see the number of threads to `n`. These flags are already [set in the Makefile](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/Makefile#L26) when you or CI uses `stack test`. ## Locking The Haskell package [filelock](https://hackage.haskell.org/package/filelock) is used for locking. File locks are used instead of MVars because Juvix code does not control when new threads are created, they are created by the test suite. This means that MVars created by Juvix code will have no effect, because they are created independently on each test-suite thread. Additionally the resources we're locking live on the filesystem and so can be conveniently tagged by path. ### FileLock The filelock library is wrapped in a FileLock effect: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Base.hs#L6-L8 There is an [IO interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/IO.hs#L8) that uses filelock and an [no-op interpreter](https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/FileLock/Permissive.hs#L7) that just runs actions unconditionally. ### TaggedLock To make the file locks simpler to use a TaggedLock effect is introduced: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock/Base.hs#L5-L11 And convenience function: https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Data/Effect/TaggedLock.hs#L28 This allows an action to be locked, tagged by a directory that may or may not exist. For example in the following code, an action is performed on a directory `root` that may delete the directory before repopulating the files. So the lockfile cannot be stored in the `root` itself. https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Extra/Files.hs#L55-L60 ## Pipeline As noted above, we only use locking in the test suite. The main app target pipeline is single threaded and so locking is unnecessary. So the interpretation of locks is parameterised so that locking can be disabled https://github.com/anoma/juvix/blob/e6dca22cfdcff936add5e7134f9c6f20416504a5/src/Juvix/Compiler/Pipeline/Run.hs#L64
2023-11-16 18:19:52 +03:00
<$> defaultEntryPointIO' LockModeExclusive tRoot file'
(void . runIOExclusive entryPoint) upToInternalTyped
}
negPositivityTests :: [N.NegTest]
negPositivityTests = N.negPositivityTests
testWellDefinedInductiveDefs :: [PosTest]
testWellDefinedInductiveDefs =
[ posTest
"Rose tree definition is well-defined"
$(mkRelDir "Internal/Positivity")
$(mkRelFile "RoseTree.juvix")
]
testPositivityKeyword :: [PosTest]
testPositivityKeyword =
2023-01-17 11:41:07 +03:00
[ posTest
"Mark T0 data type as strictly positive"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal/Positivity")
$(mkRelFile "E5.juvix")
]
positivityTestGroup :: TestTree
positivityTestGroup =
testGroup
"Positive tests for the positivity condition"
[ testGroup
"Bypass positivity checking using --non-positivity flag on negative tests"
(map (mkTest . testNoPositivityFlag) negPositivityTests),
testGroup
"Usages of the positive keyword"
(map (mkTest . testDescr) testPositivityKeyword),
testGroup
"Well-defined inductive definitions"
(map (mkTest . testDescr) testWellDefinedInductiveDefs)
]
allTests :: TestTree
allTests =
testGroup
"Typecheck positive tests"
[ testGroup
"General typechecking tests"
(map (mkTest . testDescr) tests),
positivityTestGroup
]
2023-01-17 11:41:07 +03:00
compilationTest :: Compilation.PosTest -> PosTest
compilationTest Compilation.PosTest {..} = PosTest {..}
tests :: [PosTest]
tests =
2023-01-17 11:41:07 +03:00
[ posTest
"Simple"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "Simple.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Literal String matches any type"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "LiteralString.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Box type"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "Box.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Literal Int matches any type"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "LiteralInt.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Axiom"
2022-12-20 15:05:40 +03:00
$(mkRelDir ".")
$(mkRelFile "Axiom.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Inductive"
2022-12-20 15:05:40 +03:00
$(mkRelDir ".")
$(mkRelFile "Inductive.juvix"),
posTest
"ADT"
$(mkRelDir ".")
$(mkRelFile "Adt.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Operators"
2022-12-20 15:05:40 +03:00
$(mkRelDir ".")
$(mkRelFile "Operators.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Holes in type signature"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "HoleInSignature.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Polymorphism and higher rank functions"
2022-12-20 15:05:40 +03:00
$(mkRelDir ".")
$(mkRelFile "Polymorphism.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Polymorphism and higher rank functions with explicit holes"
2022-12-20 15:05:40 +03:00
$(mkRelDir ".")
$(mkRelFile "PolymorphismHoles.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Implicit arguments"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "Implicit.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Simple type alias"
2022-12-20 15:05:40 +03:00
$(mkRelDir ".")
$(mkRelFile "TypeAlias.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Refine hole in type signature"
2022-12-20 15:05:40 +03:00
$(mkRelDir "272")
$(mkRelFile "M.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Pattern match a hole type"
2022-12-20 15:05:40 +03:00
$(mkRelDir "265")
$(mkRelFile "M.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Pattern match type synonym"
2022-12-20 15:05:40 +03:00
$(mkRelDir "issue1466")
$(mkRelFile "M.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Import a builtin multiple times"
2022-12-20 15:05:40 +03:00
$(mkRelDir "BuiltinsMultiImport")
$(mkRelFile "Input.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"Basic lambda functions"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "Lambda.juvix"),
2023-01-17 11:41:07 +03:00
posTest
2022-09-26 20:14:17 +03:00
"Simple mutual inference"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
$(mkRelFile "Mutual.juvix"),
2023-01-17 11:41:07 +03:00
posTest
"open import a builtin multiple times"
2022-12-20 15:05:40 +03:00
$(mkRelDir "BuiltinsMultiOpenImport")
$(mkRelFile "Input.juvix"),
2023-01-17 11:41:07 +03:00
posTest
2022-10-27 13:17:03 +03:00
"As Patterns"
2022-12-20 15:05:40 +03:00
$(mkRelDir "Internal")
2023-01-09 20:56:28 +03:00
$(mkRelFile "AsPattern.juvix"),
2023-01-17 11:41:07 +03:00
posTest
2023-01-09 20:56:28 +03:00
"Issue 1693 (Inference and higher order functions)"
$(mkRelDir "issue1693")
2023-01-10 19:31:15 +03:00
$(mkRelFile "M.juvix"),
2023-01-17 11:41:07 +03:00
posTest
2023-01-10 19:31:15 +03:00
"Issue 1704 (Type synonyms)"
$(mkRelDir "Internal")
$(mkRelFile "Synonyms.juvix"),
posTest
"Issue 1731 Trace builtin for debugging"
$(mkRelDir "issue1731")
$(mkRelFile "builtinTrace.juvix"),
posTest
"Issue 1731 Fail builtin for debugging"
$(mkRelDir "issue1731")
$(mkRelFile "builtinFail.juvix"),
posTest
"Case expressions"
$(mkRelDir "Internal")
$(mkRelFile "Case.juvix"),
posTest
"Let shadowing"
$(mkRelDir ".")
$(mkRelFile "LetShadow.juvix"),
posTest
"Type synonym inside let"
$(mkRelDir "issue1879")
$(mkRelFile "LetSynonym.juvix"),
posTest
"Mutually recursive of lambda calculus with synonyms"
$(mkRelDir ".")
$(mkRelFile "LambdaCalculus.juvix"),
posTest
"Mutually recursive type synonym and inductive type"
$(mkRelDir ".")
$(mkRelFile "MutualType.juvix"),
posTest
"Type synonym inside local module"
$(mkRelDir ".")
$(mkRelFile "LocalSynonym.juvix"),
posTest
"Mutual inference inside let"
$(mkRelDir ".")
$(mkRelFile "MutualLet.juvix"),
posTest
"import inside local module"
$(mkRelDir "issue2163")
$(mkRelFile "Main.juvix"),
posTest
"id application in type"
$(mkRelDir ".")
$(mkRelFile "IdInType.juvix"),
posTest
"Nested pattern match with type variables"
$(mkRelDir ".")
$(mkRelFile "NestedPatterns.juvix"),
posTest
"issue2248: Import type alias"
$(mkRelDir "issue2248")
$(mkRelFile "Main.juvix"),
posTest
"Named arguments"
$(mkRelDir ".")
$(mkRelFile "NamedArguments.juvix"),
posTest
"Record declaration"
$(mkRelDir ".")
$(mkRelFile "Records.juvix"),
posTest
"Record update"
$(mkRelDir ".")
$(mkRelFile "Records2.juvix"),
posTest
"Record projections"
$(mkRelDir ".")
$(mkRelFile "Projections.juvix"),
posTest
"Record patterns"
$(mkRelDir ".")
$(mkRelFile "RecordPattern.juvix"),
posTest
"Wildcard arguments"
$(mkRelDir ".")
$(mkRelFile "WildcardArguments.juvix"),
posTest
"Omit Type annotation"
$(mkRelDir ".")
$(mkRelFile "OmitType.juvix"),
posTest
"Issue 2296 (Pi types with lhs arity other than unit)"
$(mkRelDir "issue2296")
$(mkRelFile "M.juvix"),
posTest
"Alias"
$(mkRelDir ".")
Traits (#2320) * Closes #1646 Implements a basic trait framework. A simple instance search mechanism is included which fails if there is more than one matching instance at any step. Example usage: ``` import Stdlib.Prelude open hiding {Show; mkShow; show}; trait type Show A := mkShow { show : A → String }; instance showStringI : Show String := mkShow (show := id); instance showBoolI : Show Bool := mkShow (show := λ{x := if x "true" "false"}); instance showNatI : Show Nat := mkShow (show := natToString); showList {A} : {{Show A}} → List A → String | nil := "nil" | (h :: t) := Show.show h ++str " :: " ++str showList t; instance showListI {A} {{Show A}} : Show (List A) := mkShow (show := showList); showMaybe {A} {{Show A}} : Maybe A → String | (just x) := "just (" ++str Show.show x ++str ")" | nothing := "nothing"; instance showMaybeI {A} {{Show A}} : Show (Maybe A) := mkShow (show := showMaybe); main : IO := printStringLn (Show.show true) >> printStringLn (Show.show false) >> printStringLn (Show.show 3) >> printStringLn (Show.show [true; false]) >> printStringLn (Show.show [1; 2; 3]) >> printStringLn (Show.show [1; 2]) >> printStringLn (Show.show [true; false]) >> printStringLn (Show.show [just true; nothing; just false]) >> printStringLn (Show.show [just [1]; nothing; just [2; 3]]) >> printStringLn (Show.show "abba") >> printStringLn (Show.show ["a"; "b"; "c"; "d"]); ``` It is possible to manually provide an instance and to match on implicit instances: ``` f {A} : {{Show A}} -> A -> String | {{mkShow s}} x -> s x; f' {A} : {{Show A}} → A → String | {{M}} x := Show.show {{M}} x; ``` The trait parameters in instance types are checked to be structurally decreasing to avoid looping in the instance search. So the following is rejected: ``` type Box A := box A; trait type T A := mkT { pp : A → A }; instance boxT {A} : {{T (Box A)}} → T (Box A) := mkT (λ{x := x}); ``` We check whether each parameter is a strict subterm of some trait parameter in the target. This ordering is included in the finite multiset extension of the subterm ordering, hence terminating.
2023-09-08 13:16:43 +03:00
$(mkRelFile "Alias.juvix"),
posTest
"Traits"
$(mkRelDir ".")
$(mkRelFile "Traits.juvix"),
posTest
"Instance import"
$(mkRelDir "InstanceImport")
$(mkRelFile "Main.juvix"),
posTest
"Hole as numeric type"
$(mkRelDir "issue2373")
$(mkRelFile "Main.juvix"),
posTest
"Hole in type parameter"
$(mkRelDir ".")
$(mkRelFile "HoleTypeParameter.juvix"),
posTest
"Instance axiom"
$(mkRelDir ".")
$(mkRelFile "InstanceAxiom.juvix"),
posTest
"Markdown"
$(mkRelDir "Markdown")
$(mkRelFile "Test.juvix.md"),
posTest
"Import a .juvix.md module in a .juvix file"
$(mkRelDir "MarkdownImport")
$(mkRelFile "A.juvix"),
posTest
"Import a .juvix.md module in a .juvix.md file"
$(mkRelDir "MarkdownImport")
$(mkRelFile "C.juvix.md"),
posTestAbsDir
"Typecheck orphan file"
(relToProject $(mkRelDir "tests/WithoutPackageFile"))
$(mkRelFile "Good.juvix")
]
<> [ compilationTest t | t <- Compilation.tests
2023-01-17 11:41:07 +03:00
]