diff options
author | Richard Eisenberg <rae@cs.brynmawr.edu> | 2017-03-16 11:59:45 -0400 |
---|---|---|
committer | Richard Eisenberg <rae@cs.brynmawr.edu> | 2017-03-17 11:23:14 -0400 |
commit | 02cc8f0c423e85033bdfd26f1492301b724930d8 (patch) | |
tree | 8122b4999bf2fe4e01ef5b9d6b86f78845f3a4a1 | |
parent | fa13c136e6e666b9a1393c1c0041020ad842c069 (diff) | |
download | haskell-02cc8f0c423e85033bdfd26f1492301b724930d8.tar.gz |
Fix #13343 by not defaulting SigTvs
test case: typecheck/should_compile/T13343
-rw-r--r-- | compiler/typecheck/TcMType.hs | 23 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T13343.hs | 7 | ||||
-rw-r--r-- | 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 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, ['']) |