summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Eisenberg <rae@cs.brynmawr.edu>2017-03-16 11:59:45 -0400
committerRichard Eisenberg <rae@cs.brynmawr.edu>2017-03-17 11:23:14 -0400
commit02cc8f0c423e85033bdfd26f1492301b724930d8 (patch)
tree8122b4999bf2fe4e01ef5b9d6b86f78845f3a4a1
parentfa13c136e6e666b9a1393c1c0041020ad842c069 (diff)
downloadhaskell-02cc8f0c423e85033bdfd26f1492301b724930d8.tar.gz
Fix #13343 by not defaulting SigTvs
test case: typecheck/should_compile/T13343
-rw-r--r--compiler/typecheck/TcMType.hs23
-rw-r--r--testsuite/tests/typecheck/should_compile/T13343.hs7
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T1
3 files changed, 23 insertions, 8 deletions
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 2abc800a37..decb6cb18a 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 0000000000..ab259e3c45
--- /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 d2dd684388..9caaf2567a 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, [''])