[commit: ghc] master: Fix #13343 by not defaulting SigTvs (02cc8f0)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/02cc8f0c423e85033bdfd26f1492301b724930d8/ghc

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

commit 02cc8f0c423e85033bdfd26f1492301b724930d8
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Thu Mar 16 11:59:45 2017 -0400

    Fix #13343 by not defaulting SigTvs
    
    test case: typecheck/should_compile/T13343


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

02cc8f0c423e85033bdfd26f1492301b724930d8
 compiler/typecheck/TcMType.hs                      | 23 ++++++++++++++--------
 testsuite/tests/typecheck/should_compile/T13343.hs |  7 +++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 3 files changed, 23 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 2abc800..decb6cb 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -998,31 +998,38 @@ zonkQuantifiedTyVar :: Bool     -- True  <=> this is a kind var and -XNoPolyKind
 
 zonkQuantifiedTyVar default_kind tv
   = case tcTyVarDetails tv of
-      SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv)
-                        ; return $ Just (setTyVarKind tv kind) }
+      SkolemTv {} -> zonk_kind_and_return
         -- It might be a skolem type variable,
         -- for example from a user type signature
 
-      MetaTv { mtv_ref = ref }
+      MetaTv { mtv_ref = ref, mtv_info = info }
         -> do { when debugIsOn (check_empty ref)
-              ; zonk_meta_tv tv }
+              ; zonk_meta_tv info tv }
 
       _other -> pprPanic "zonkQuantifiedTyVar" (ppr tv) -- FlatSkol, RuntimeUnk
 
   where
-    zonk_meta_tv :: TcTyVar -> TcM (Maybe TcTyVar)
-    zonk_meta_tv tv
-      | isRuntimeRepVar tv   -- Never quantify over a RuntimeRep var
+    zonk_kind_and_return = do { kind <- zonkTcType (tyVarKind tv)
+                              ; return $ Just (setTyVarKind tv kind) }
+
+    zonk_meta_tv :: MetaInfo -> TcTyVar -> TcM (Maybe TcTyVar)
+    zonk_meta_tv info tv
+      | isRuntimeRepVar tv && not_sig_tv  -- Never quantify over a RuntimeRep var
       = do { writeMetaTyVar tv liftedRepTy
            ; return Nothing }
 
-      | default_kind         -- -XNoPolyKinds and this is a kind var
+      | default_kind && not_sig_tv        -- -XNoPolyKinds and this is a kind var
       = do { _ <- default_kind_var tv
            ; return Nothing }
 
       | otherwise
       = do { tv' <- skolemiseUnboundMetaTyVar tv
            ; return (Just tv') }
+      where
+        -- do not default SigTvs. This would violate the invariants on SigTvs
+        not_sig_tv = case info of SigTv -> False
+                                  _     -> True
+
 
     default_kind_var :: TyVar -> TcM Type
        -- defaultKindVar is used exclusively with -XNoPolyKinds
diff --git a/testsuite/tests/typecheck/should_compile/T13343.hs b/testsuite/tests/typecheck/should_compile/T13343.hs
new file mode 100644
index 0000000..ab259e3
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13343.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeInType #-}
+module Bug where
+
+import GHC.Exts
+
+type Bad = forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index d2dd684..9caaf25 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -545,3 +545,4 @@ test('T12924', normal, compile, [''])
 test('T12926', normal, compile, [''])
 test('T13381', normal, compile_fail, [''])
 test('T13337', normal, compile, [''])
+test('T13343', normal, compile, [''])