[commit: ghc] master: TcInteract: Ensure that tycons have representations before solving for Typeable (f0212a9)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f0212a93a2f3d4fb564c1025cca0dfd3050487e4/ghc

>---------------------------------------------------------------

commit f0212a93a2f3d4fb564c1025cca0dfd3050487e4
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Sun May 13 11:41:16 2018 -0400

    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


>---------------------------------------------------------------

f0212a93a2f3d4fb564c1025cca0dfd3050487e4
 compiler/basicTypes/DataCon.hs-boot                 | 1 +
 compiler/typecheck/TcInteract.hs                    | 3 +++
 compiler/types/TyCon.hs                             | 6 +++++-
 testsuite/tests/typecheck/should_fail/T15067.hs     | 5 ++---
 testsuite/tests/typecheck/should_fail/T15067.stderr | 2 +-
 testsuite/tests/typecheck/should_fail/all.T         | 2 +-
 6 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/compiler/basicTypes/DataCon.hs-boot b/compiler/basicTypes/DataCon.hs-boot
index 841f8c9..61fb3ce 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 377b2d6..41afe3f 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 67c7b1b..5717aef 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 ff093db..397655f 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 a16d799..7305611 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 9dd00f8..e4aa682 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, [''])