diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2016-01-11 15:28:48 -0500 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2016-01-15 15:43:44 -0500 |
| commit | bafbde7e239dd7353fb32cb2ff1b1c9139e4f45c (patch) | |
| tree | 386b9f4ebc1ee89028c2e0f6d65b8cec99a20dc2 | |
| parent | 39ea4b4b19ea65d05f0d946084b316d5f5d2e675 (diff) | |
| download | haskell-bafbde7e239dd7353fb32cb2ff1b1c9139e4f45c.tar.gz | |
Constrained types have kind * in validity check.
This addresses #11405, but a deeper problem lurks.
Try test dependent/should_compile/T11405 and see comment:3
on the ticket.
| -rw-r--r-- | compiler/typecheck/TcValidity.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/dependent/should_compile/T11405.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/dependent/should_compile/all.T | 2 |
3 files changed, 17 insertions, 1 deletions
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 63118d0078..a89b78320b 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -452,12 +452,17 @@ check_type env ctxt rank ty -- but not type T = ?x::Int ; check_type env' ctxt rank tau -- Allow foralls to right of arrow - ; checkTcM (not (any (`elemVarSet` tyCoVarsOfType tau_kind) tvs)) + ; checkTcM (not (any (`elemVarSet` tyCoVarsOfType phi_kind) tvs)) (forAllEscapeErr env' ty tau_kind) } where (tvs, theta, tau) = tcSplitSigmaTy ty tau_kind = typeKind tau + + phi_kind | null theta = tau_kind + | otherwise = liftedTypeKind + -- If there are any constraints, the kind is *. (#11405) + (env', _) = tidyTyCoVarBndrs env tvs check_type _ _ _ (TyVarTy _) = return () diff --git a/testsuite/tests/dependent/should_compile/T11405.hs b/testsuite/tests/dependent/should_compile/T11405.hs new file mode 100644 index 0000000000..f80d994dc7 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T11405.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ImplicitParams, TypeInType, ExplicitForAll #-} + +module T11405 where + +import GHC.Exts +import GHC.Stack + +x :: forall (v :: Levity) (a :: TYPE v). (?callStack :: CallStack) => a +x = undefined diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index ef6dde9fbe..c11f9ca52b 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -12,3 +12,5 @@ test('TypeLevelVec',normal,compile, ['']) test('T9632', normal, compile, ['']) test('dynamic-paper', normal, compile, ['']) test('T11311', normal, compile, ['']) +test('T11405', expect_broken(11405), compile, ['']) + |