diff options
-rw-r--r-- | compiler/typecheck/TcEnv.hs | 11 | ||||
-rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 3 | ||||
-rw-r--r-- | compiler/typecheck/TcTypeable.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/perf/compiler/all.T | 3 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T13915a.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T13915a_Foo.hs | 5 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T13915b.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 2 |
8 files changed, 40 insertions, 10 deletions
diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 935ad3dcb7..12f8a1df4f 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -625,15 +625,18 @@ Consider data S = MkS (Proxy 'MkT) Is it ok to use the promoted data family instance constructor 'MkT' in -the data declaration for S? No, we don't allow this. It *might* make -sense, but at least it would mean that we'd have to interleave -typechecking instances and data types, whereas at present we do data -types *then* instances. +the data declaration for S (where both declarations live in the same module)? +No, we don't allow this. It *might* make sense, but at least it would mean that +we'd have to interleave typechecking instances and data types, whereas at +present we do data types *then* instances. So to check for this we put in the TcLclEnv a binding for all the family constructors, bound to AFamDataCon, so that if we trip over 'MkT' when type checking 'S' we'll produce a decent error message. +Trac #12088 describes this limitation. Of course, when MkT and S live in +different modules then all is well. + Note [Don't promote pattern synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We never promote pattern synonyms. diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 3992a7e662..6383b57c28 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1077,7 +1077,8 @@ data PromotionErr | ClassPE -- Ditto Class | FamDataConPE -- Data constructor for a data family - -- See Note [AFamDataCon: not promoting data family constructors] in TcRnDriver + -- See Note [AFamDataCon: not promoting data family constructors] + -- in TcEnv. | PatSynPE -- Pattern synonyms -- See Note [Don't promote pattern synonyms] in TcEnv diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index e7a427f6e1..2fcca7ffc2 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -170,7 +170,7 @@ mkTypeableBinds | tc `elem` [runtimeRepTyCon, vecCountTyCon, vecElemTyCon] = False | otherwise = - (not (isFamInstTyCon tc) && isAlgTyCon tc) + isAlgTyCon tc || isDataFamilyTyCon tc || isClassTyCon tc @@ -243,12 +243,12 @@ todoForTyCons mod mod_id tycons = do } | tc <- tycons , tc' <- tc : tyConATs tc - -- If the tycon itself isn't typeable then we needn't look - -- at its promoted datacons as their kinds aren't Typeable - , Just _ <- pure $ tyConRepName_maybe tc' -- We need type representations for any associated types , let promoted = map promoteDataCon (tyConDataCons tc') , tc'' <- tc' : promoted + -- Don't make bindings for data-family instance tycons. + -- Do, however, make them for their promoted datacon (see #13915). + , not $ isFamInstTyCon tc'' , Just rep_name <- pure $ tyConRepName_maybe tc'' , typeIsTypeable $ dropForAlls $ tyConKind tc'' ] diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index a2728cafe7..ce378bf643 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -1061,13 +1061,14 @@ test('T12545', test('T13035', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 93249744, 5), + [(wordsize(64), 118665640, 5), # 2017-01-05 90595208 initial # 2017-01-19 95269000 Allow top-level string literals in Core # 2017-02-05 88806416 Probably OccAnal fixes # 2017-02-17 103890200 Type-indexed Typeable # 2017-02-25 98390488 Early inline patch # 2017-03-21 93249744 It's unclear + # 2017-07-19 118665640 Generate Typeable bindings for data instances ]), ], compile, diff --git a/testsuite/tests/typecheck/should_compile/T13915a.hs b/testsuite/tests/typecheck/should_compile/T13915a.hs new file mode 100644 index 0000000000..484c9dedc0 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13915a.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeInType #-} +module Bug where + +import T13915a_Foo + +data Proxy (a :: k) +data S = MkS (Proxy 'MkT) diff --git a/testsuite/tests/typecheck/should_compile/T13915a_Foo.hs b/testsuite/tests/typecheck/should_compile/T13915a_Foo.hs new file mode 100644 index 0000000000..1b5fd818ab --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13915a_Foo.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T13915a_Foo where + +data family T a +data instance T Int = MkT diff --git a/testsuite/tests/typecheck/should_compile/T13915b.hs b/testsuite/tests/typecheck/should_compile/T13915b.hs new file mode 100644 index 0000000000..dd64b13d4f --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13915b.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module Foo where + +import Data.Typeable (Proxy(..), typeRep) + +data family T a +data instance T Int = MkT + +main :: IO () +main = print $ typeRep (Proxy :: Proxy MkT) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 8f7996c6dd..ee37b9ac7a 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -568,3 +568,5 @@ test('T13822', normal, compile, ['']) test('T13871', normal, compile, ['']) test('T13879', normal, compile, ['']) test('T13881', normal, compile, ['']) +test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) +test('T13915b', normal, compile, ['']) |