Fix #13343 by not defaulting SigTvs
authorRichard Eisenberg <rae@cs.brynmawr.edu>
Thu, 16 Mar 2017 15:59:45 +0000 (11:59 -0400)
committerRichard Eisenberg <rae@cs.brynmawr.edu>
Fri, 17 Mar 2017 15:23:14 +0000 (11:23 -0400)
test case: typecheck/should_compile/T13343

compiler/typecheck/TcMType.hs
testsuite/tests/typecheck/should_compile/T13343.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index 2abc800..decb6cb 100644 (file)
@@ -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 (file)
index 0000000..ab259e3
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeInType #-}
+module Bug where
+
+import GHC.Exts
+
+type Bad = forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1
index d2dd684..9caaf25 100644 (file)
@@ -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, [''])