summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/typecheck/TcEnv.hs11
-rw-r--r--compiler/typecheck/TcRnTypes.hs3
-rw-r--r--compiler/typecheck/TcTypeable.hs8
-rw-r--r--testsuite/tests/perf/compiler/all.T3
-rw-r--r--testsuite/tests/typecheck/should_compile/T13915a.hs7
-rw-r--r--testsuite/tests/typecheck/should_compile/T13915a_Foo.hs5
-rw-r--r--testsuite/tests/typecheck/should_compile/T13915b.hs11
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T2
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, [''])