TcInteract: Ensure that tycons have representations before solving for Typeable

Summary: This fixes #15067.

Test Plan: Validate

Subscribers: thomie, carter, RyanGlScott

GHC Trac Issues: #15067

Differential Revision: https://phabricator.haskell.org/D4623

6 files changed, 13 insertions, 6 deletions

diff --git a/compiler/basicTypes/DataCon.hs-boot b/compiler/basicTypes/DataCon.hs-boot
index 841f8c9d1c..61fb3ce15d 100644
--- a/compiler/basicTypes/DataCon.hs-boot
+++ b/compiler/basicTypes/DataCon.hs-boot
@@ -25,6 +25,7 @@ dataConInstOrigArgTys  :: DataCon -> [Type] -> [Type]
 dataConStupidTheta :: DataCon -> ThetaType
 dataConFullSig :: DataCon
                -> ([TyVar], [TyVar], [EqSpec], ThetaType, [Type], Type)
+isUnboxedSumCon :: DataCon -> Bool
 
 instance Eq DataCon
 instance Uniquable DataCon
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 377b2d6c32..41afe3fdd7 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -2698,9 +2698,12 @@ doFunTy clas ty arg_ty ret_ty
 -- of monomorphic kind (e.g. all kind variables have been instantiated).
 doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcS LookupInstResult
 doTyConApp clas ty tc kind_args
+  | Just _ <- tyConRepName_maybe tc
   = return $ GenInst (map (mk_typeable_pred clas) kind_args)
                      (\kinds -> evTypeable ty $ EvTypeableTyCon tc (map EvExpr kinds))
                      True
+  | otherwise
+  = return NoInstance
 
 -- | Representation for TyCon applications of a concrete kind. We just use the
 -- kind itself, but first we must make sure that we've instantiated all kind-
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 67c7b1b6a7..5717aef9b8 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -155,6 +155,7 @@ import Util
 import Unique( tyConRepNameUnique, dataConRepNameUnique )
 import UniqSet
 import Module
+import {-# SOURCE #-} DataCon
 
 import qualified Data.Data as Data
 
@@ -1190,7 +1191,10 @@ tyConRepName_maybe (AlgTyCon { algTcParent = parent })
   | UnboxedAlgTyCon rep_nm <- parent = rep_nm
 tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm })
   = Just rep_nm
-tyConRepName_maybe (PromotedDataCon { tcRepName = rep_nm })
+tyConRepName_maybe (PromotedDataCon { dataCon = dc, tcRepName = rep_nm })
+  | isUnboxedSumCon dc   -- see #13276
+  = Nothing
+  | otherwise
   = Just rep_nm
 tyConRepName_maybe _ = Nothing
 
diff --git a/testsuite/tests/typecheck/should_fail/T15067.hs b/testsuite/tests/typecheck/should_fail/T15067.hs
index ff093db114..397655f60c 100644
--- a/testsuite/tests/typecheck/should_fail/T15067.hs
+++ b/testsuite/tests/typecheck/should_fail/T15067.hs
@@ -1,10 +1,9 @@
 {-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE DataKinds #-}
+
 module T15067 where
 
 import Type.Reflection
 
 floopadoop :: TypeRep (# Bool | Int #)
 floopadoop = typeRep
-
-rubadub :: (# True | 4 #)
-rubadub = typeRep
diff --git a/testsuite/tests/typecheck/should_fail/T15067.stderr b/testsuite/tests/typecheck/should_fail/T15067.stderr
index a16d799cdc..73056113ad 100644
--- a/testsuite/tests/typecheck/should_fail/T15067.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15067.stderr
@@ -1,5 +1,5 @@
 
-T15067.hs:7:14:
+T15067.hs:9:14:
      No instance for (Typeable (# 'GHC.Types.LiftedRep #))
         arising from a use of ‘typeRep’
         GHC can't yet do polykinded
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 9dd00f838d..e4aa682404 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -473,4 +473,4 @@ test('T14761b', normal, compile_fail, [''])
 test('T14884', normal, compile_fail, [''])
 test('T14904a', normal, compile_fail, [''])
 test('T14904b', normal, compile_fail, [''])
-test('T15067', expect_broken(15067), compile_fail, [''])
+test('T15067', normal, compile_fail, [''])