1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-13 19:49:20 +03:00
juvix/test/Typecheck/Negative.hs
Łukasz Czajka cbd8253afd
Instance coercions (#2444)
* Closes #2426 

A coercion from trait `T` to `T'` can be declared with the syntax
```
coercion instance
coeName {A} {{T A}} : T' A := ...
```
Coercions can be seen as instances with special resolution rules.

Coercion resolution rules
-------------------------
* If a non-coercion instance can be applied in a single instance
resolution step, no coercions are considered. No ambiguity results if
there exists some coercion which could be applied, but a non-coercion
instance exists - the non-coercion instances have priority.
* If no non-coercion instance can be applied in a single resolution
step, all minimal coercion paths which lead to an applicable
non-coercion instance are considered. If there is more than one,
ambiguity is reported.

Examples
----------

The following type-checks because:
1. There is no non-coercion instance found for `U String`.
2. There are two minimal coercion paths `U` <- `U1` and `U` <- `U2`, but
only one of them (`U` <- `U2`) ends in an applicable non-coercion
instance (`instU2` for `U2 String`).

```
trait
type U A := mkU {pp : A -> A};

trait
type U1 A := mkU1 {pp : A -> A};

trait
type U2 A := mkU2 {pp : A -> A};

coercion instance
fromU1toU {A} {{U1 A}} : U A :=
  mkU@{
    pp := U1.pp
  };

coercion instance
fromU2toU {A} {{U2 A}} : U A :=
  mkU@{
    pp := U2.pp
  };

instance
instU2 : U2 String := mkU2 id;

main : IO := printStringLn (U.pp "X")
```

The following results in an ambiguity error because:
1. There is no non-coercion instance found for `T Unit`.
2. There are two minimal coercion paths `T` <- `T1` and `T` <- `T2`,
both of which end in applicable non-coercion instances.

```
trait
type T A := mkT { pp : A → A };

trait
type T1 A := mkT1 { pp : A → A };

trait
type T2 A := mkT2 { pp : A → A };

instance
unitT1 : T1 Unit := mkT1 (pp := λ{_ := unit});

instance
unitT2 : T2 Unit := mkT2 (pp := λ{_ := unit});

coercion instance
fromT1toT {A} {{T1 A}} : T A := mkT@{
  pp := T1.pp
};

coercion instance
fromT2toT {A} {{T2 A}} : T A := mkT@{
  pp := T2.pp
};

main : Unit := T.pp unit;
```

The following type-checks, because there exists a non-coercion instance
for `T2 String`, so the coercion `fromT1toT2` is ignored during instance
resolution.

```
trait
type T1 A := mkT1 {pp : A -> A};

trait
type T2 A := mkT2 {pp : A -> A};

instance
instT1 {A} : T1 A :=
  mkT1@{
    pp := id
  };

coercion instance
fromT1toT2 {A} {{M : T1 A}} : T2 A :=
  mkT2@{
    pp := T1.pp {{M}}
  };

instance
instT2 : T2 String :=
  mkT2@{
    pp (s : String) : String := s ++str "!"
  };

main : String := T2.pp "a";
```
2023-10-19 16:00:31 +02:00

288 lines
8.3 KiB
Haskell

module Typecheck.Negative where
import Base
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error
type FailMsg = String
data NegTest = NegTest
{ _name :: String,
_relDir :: Path Rel Dir,
_file :: Path Rel File,
_checkErr :: TypeCheckerError -> Maybe FailMsg
}
testDescr :: NegTest -> TestDescr
testDescr NegTest {..} =
let tRoot = root <//> _relDir
file' = tRoot <//> _file
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Single $ do
entryPoint <- defaultEntryPointCwdIO file'
result <- runIOEither entryPoint upToInternalTyped
case mapLeft fromJuvixError result of
Left (Just tyError) -> whenJust (_checkErr tyError) assertFailure
Left Nothing -> assertFailure "An error ocurred but it was not in the type checker."
Right _ -> assertFailure "The type checker did not find an error."
}
allTests :: TestTree
allTests =
testGroup
"Typecheck negative tests"
[ testGroup
"General typechecking errors"
(map (mkTest . testDescr) tests),
testGroup
"Non-strictly positive data types"
(map (mkTest . testDescr) negPositivityTests)
]
root :: Path Abs Dir
root = relToProject $(mkRelDir "tests/negative")
wrongError :: Maybe FailMsg
wrongError = Just "Incorrect error"
tests :: [NegTest]
tests =
[ NegTest
"Constructor in pattern type error"
$(mkRelDir "Internal")
$(mkRelFile "PatternConstructor.juvix")
$ \case
ErrWrongConstructorType {} -> Nothing
_ -> wrongError,
NegTest
"Check pattern with hole type"
$(mkRelDir "265")
$(mkRelFile "M.juvix")
$ \case
ErrWrongConstructorType {} -> Nothing
_ -> wrongError,
NegTest
"Type vs inferred type mismatch"
$(mkRelDir "Internal")
$(mkRelFile "WrongType.juvix")
$ \case
ErrWrongType {} -> Nothing
_ -> wrongError,
NegTest
"Function application with non-function type"
$(mkRelDir "Internal")
$(mkRelFile "ExpectedFunctionType.juvix")
$ \case
ErrExpectedFunctionType {} -> Nothing
_ -> wrongError,
NegTest
"Unsolved hole"
$(mkRelDir "Internal")
$(mkRelFile "UnsolvedMeta.juvix")
$ \case
ErrUnsolvedMeta {} -> Nothing
_ -> wrongError,
NegTest
"Multiple type errors are captured"
$(mkRelDir "Internal")
$(mkRelFile "MultiWrongType.juvix")
$ \case
ErrWrongType {} -> Nothing
_ -> wrongError,
NegTest
"Unexpected braces in pattern"
$(mkRelDir "issue1337")
$(mkRelFile "Braces.juvix")
$ \case
ErrArity (ErrWrongPatternIsImplicit {}) -> Nothing
_ -> wrongError,
NegTest
"Unexpected double braces in pattern"
$(mkRelDir "issue1337")
$(mkRelFile "DoubleBraces.juvix")
$ \case
ErrArity (ErrWrongPatternIsImplicit {}) -> Nothing
_ -> wrongError,
NegTest
"Wrong return type name for a constructor of a simple data type"
$(mkRelDir "Internal")
$(mkRelFile "WrongReturnType.juvix")
$ \case
ErrWrongReturnType {} -> Nothing
_ -> wrongError,
NegTest
"Too few arguments for the return type of a constructor"
$(mkRelDir "Internal")
$(mkRelFile "WrongReturnTypeTooFewArguments.juvix")
$ \case
ErrWrongType {} -> Nothing
_ -> wrongError,
NegTest
"Ambiguous hole"
$(mkRelDir "Internal")
$(mkRelFile "IdenFunctionArgsNoExplicit.juvix")
$ \case
ErrUnsolvedMeta {} -> Nothing
_ -> wrongError,
NegTest
"Cycle in hole"
$(mkRelDir "issue1700")
$(mkRelFile "SelfApplication.juvix")
$ \case
ErrUnsolvedMeta {} -> Nothing
_ -> wrongError,
NegTest
"Negative integer literal cannot be used as a Nat"
$(mkRelDir "Internal")
$(mkRelFile "LiteralInteger.juvix")
$ \case
ErrWrongType {} -> Nothing
_ -> wrongError,
NegTest
"Integer literal cannot be used as a String"
$(mkRelDir "Internal")
$(mkRelFile "LiteralIntegerString.juvix")
$ \case
ErrWrongType {} -> Nothing
_ -> wrongError,
NegTest
"Unsupported type function"
$(mkRelDir "Internal")
$(mkRelFile "UnsupportedTypeFunction.juvix")
$ \case
ErrUnsupportedTypeFunction {} -> Nothing
_ -> wrongError,
NegTest
"Instance target not a trait"
$(mkRelDir "Internal")
$(mkRelFile "TargetNotATrait.juvix")
$ \case
ErrTargetNotATrait {} -> Nothing
_ -> wrongError,
NegTest
"Not a trait"
$(mkRelDir "Internal")
$(mkRelFile "NotATrait.juvix")
$ \case
ErrNotATrait {} -> Nothing
_ -> wrongError,
NegTest
"No instance"
$(mkRelDir "Internal")
$(mkRelFile "NoInstance.juvix")
$ \case
ErrNoInstance {} -> Nothing
_ -> wrongError,
NegTest
"Ambiguous instances"
$(mkRelDir "Internal")
$(mkRelFile "AmbiguousInstances.juvix")
$ \case
ErrAmbiguousInstances {} -> Nothing
_ -> wrongError,
NegTest
"Subsumed instance"
$(mkRelDir "Internal")
$(mkRelFile "SubsumedInstance.juvix")
$ \case
ErrSubsumedInstance {} -> Nothing
_ -> wrongError,
NegTest
"Explicit instance argument"
$(mkRelDir "Internal")
$(mkRelFile "ExplicitInstanceArgument.juvix")
$ \case
ErrExplicitInstanceArgument {} -> Nothing
_ -> wrongError,
NegTest
"Instance termination"
$(mkRelDir "Internal")
$(mkRelFile "InstanceTermination.juvix")
$ \case
ErrTraitNotTerminating {} -> Nothing
_ -> wrongError,
NegTest
"Default value wrong type"
$(mkRelDir "Internal")
$(mkRelFile "DefaultTypeError.juvix")
$ \case
ErrWrongType {} -> Nothing
_ -> wrongError,
NegTest
"Coercion target not a trait"
$(mkRelDir "Internal")
$(mkRelFile "CoercionTargetNotATrait.juvix")
$ \case
ErrTargetNotATrait {} -> Nothing
_ -> wrongError,
NegTest
"Invalid coercion type"
$(mkRelDir "Internal")
$(mkRelFile "InvalidCoercionType.juvix")
$ \case
ErrInvalidCoercionType {} -> Nothing
_ -> wrongError,
NegTest
"Wrong coercion argument"
$(mkRelDir "Internal")
$(mkRelFile "WrongCoercionArgument.juvix")
$ \case
ErrWrongCoercionArgument {} -> Nothing
_ -> wrongError,
NegTest
"Ambiguous coercions"
$(mkRelDir "Internal")
$(mkRelFile "AmbiguousCoercions.juvix")
$ \case
ErrAmbiguousInstances {} -> Nothing
_ -> wrongError,
NegTest
"Coercion cycles"
$(mkRelDir "Internal")
$(mkRelFile "LoopingCoercion.juvix")
$ \case
ErrCoercionCycles {} -> Nothing
_ -> wrongError
]
negPositivityTests :: [NegTest]
negPositivityTests =
[ NegTest "E1" $(mkRelDir "Internal/Positivity") $(mkRelFile "E1.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E2" $(mkRelDir "Internal/Positivity") $(mkRelFile "E2.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E3" $(mkRelDir "Internal/Positivity") $(mkRelFile "E3.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E4" $(mkRelDir "Internal/Positivity") $(mkRelFile "E4.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E5" $(mkRelDir "Internal/Positivity") $(mkRelFile "E5.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E6" $(mkRelDir "Internal/Positivity") $(mkRelFile "E6.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E7" $(mkRelDir "Internal/Positivity") $(mkRelFile "E7.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E8" $(mkRelDir "Internal/Positivity") $(mkRelFile "E8.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError,
NegTest "E9" $(mkRelDir "Internal/Positivity") $(mkRelFile "E9.juvix") $
\case
ErrNoPositivity {} -> Nothing
_ -> wrongError
]