[commit: ghc] wip/rae: Constrained types have kind * in validity check. (1040abc)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/1040abc55541c0b7bd4c4da150ec240adffa301a/ghc

>---------------------------------------------------------------

commit 1040abc55541c0b7bd4c4da150ec240adffa301a
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Jan 11 15:28:48 2016 -0500

    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.


>---------------------------------------------------------------

1040abc55541c0b7bd4c4da150ec240adffa301a
 compiler/typecheck/TcValidity.hs                   | 7 ++++++-
 testsuite/tests/dependent/should_compile/T11405.hs | 9 +++++++++
 testsuite/tests/dependent/should_compile/all.T     | 1 +
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index 63118d0..a89b783 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 0000000..f80d994
--- /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 1063b6e..ea671d0 100644
--- a/testsuite/tests/dependent/should_compile/all.T
+++ b/testsuite/tests/dependent/should_compile/all.T
@@ -11,3 +11,4 @@ test('mkGADTVars', normal, compile, [''])
 test('TypeLevelVec',normal,compile, [''])
 test('T9632', normal, compile, [''])
 test('dynamic-paper', normal, compile, [''])
+test('T11405', normal, compile, [''])