Add missing type representations

Previously we were missing `Typeable` representations for several
wired-in types (and their promoted constructors). These include,

 * `Nat`
 * `Symbol`
 * `':`
 * `'[]`

Moreover, some constructors were incorrectly identified as being defined
in `GHC.Types` whereas they were in fact defined in `GHC.Prim`.

Ultimately this is just a temporary band-aid as there is general
agreement that we should eliminate the manual definition of these
representations entirely.

Test Plan: Validate

Reviewers: austin, hvr

Subscribers: thomie

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

GHC Trac Issues: #11120

5 files changed, 82 insertions, 33 deletions

diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index 876c9c008d..0015e01278 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -18,8 +18,7 @@ module BuildTyCl (
 
 import IfaceEnv
 import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
-import TysWiredIn( isCTupleTyConName )
-import PrelNames( tyConRepModOcc )
+import TysWiredIn( isCTupleTyConName, tyConRepModOcc )
 import DataCon
 import PatSyn
 import Var
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 030f10a0b0..cc5c854260 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -823,29 +823,6 @@ mkSpecialTyConRepName fs tc_name
                    (mkVarOccFS fs)
                    wiredInSrcSpan
 
--- | Make a 'Name' for the 'Typeable' representation of the given wired-in type
-mkPrelTyConRepName :: Name -> Name
--- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
-mkPrelTyConRepName tc_name  -- Prelude tc_name is always External,
-                            -- so nameModule will work
-  = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)
-  where
-    name_occ  = nameOccName tc_name
-    name_mod  = nameModule  tc_name
-    name_uniq = nameUnique  tc_name
-    rep_uniq | isTcOcc name_occ = tyConRepNameUnique   name_uniq
-             | otherwise        = dataConRepNameUnique name_uniq
-    (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ
-
--- | TODO
--- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
-tyConRepModOcc :: Module -> OccName -> (Module, OccName)
-tyConRepModOcc tc_module tc_occ
-  | tc_module == gHC_TYPES
-  = (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ)
-  | otherwise
-  = (tc_module,         mkTyConRepSysOcc tc_occ)
-
 wildCardName :: Name
 wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
 
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 02e693d5a0..49655b46fe 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -49,6 +49,7 @@ module TysWiredIn (
         listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
         nilDataCon, nilDataConName, nilDataConKey,
         consDataCon_RDR, consDataCon, consDataConName,
+        promotedNilDataCon, promotedConsDataCon,
 
         mkListTy,
 
@@ -96,7 +97,10 @@ module TysWiredIn (
         levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
         liftedPromDataCon, unliftedPromDataCon,
         liftedDataConTy, unliftedDataConTy,
-        liftedDataConName, unliftedDataConName
+        liftedDataConName, unliftedDataConName,
+
+        -- * Helpers for building type representations
+        tyConRepModOcc
     ) where
 
 #include "HsVersions.h"
@@ -138,6 +142,48 @@ alpha_tyvar = [alphaTyVar]
 alpha_ty :: [Type]
 alpha_ty = [alphaTy]
 
+-- * Some helpers for generating type representations
+
+-- | Make a 'Name' for the 'Typeable' representation of the given wired-in type
+mkPrelTyConRepName :: Name -> Name
+-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
+-- This doesn't really belong here but a refactoring of this code eliminating
+-- these manually-defined representations is imminent
+mkPrelTyConRepName tc_name  -- Prelude tc_name is always External,
+                            -- so nameModule will work
+  = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)
+  where
+    name_occ  = nameOccName tc_name
+    name_mod  = nameModule  tc_name
+    name_uniq = nameUnique  tc_name
+    rep_uniq | isTcOcc name_occ = tyConRepNameUnique   name_uniq
+             | otherwise        = dataConRepNameUnique name_uniq
+    (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ
+
+-- | The name (and defining module) for the Typeable representation (TyCon) of a
+-- type constructor.
+--
+-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
+tyConRepModOcc :: Module -> OccName -> (Module, OccName)
+tyConRepModOcc tc_module tc_occ
+  -- The list type is defined in GHC.Types and therefore must have its
+  -- representations defined manually in Data.Typeable.Internal.
+  -- However, $tc': isn't a valid Haskell identifier, so we override the derived
+  -- name here.
+  | is_wired_in promotedConsDataCon
+  = (tYPEABLE_INTERNAL, mkOccName varName "tc'Cons")
+  | is_wired_in promotedNilDataCon
+  = (tYPEABLE_INTERNAL, mkOccName varName "tc'Nil")
+
+  | tc_module == gHC_TYPES
+  = (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ)
+  | otherwise
+  = (tc_module,         mkTyConRepSysOcc tc_occ)
+  where
+    is_wired_in :: TyCon -> Bool
+    is_wired_in tc =
+      tc_module == gHC_TYPES && tc_occ == nameOccName (tyConName tc)
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1063,6 +1109,11 @@ promotedLTDataCon     = promoteDataCon ltDataCon
 promotedEQDataCon     = promoteDataCon eqDataCon
 promotedGTDataCon     = promoteDataCon gtDataCon
 
+-- Promoted List
+promotedConsDataCon, promotedNilDataCon :: TyCon
+promotedConsDataCon   = promoteDataCon consDataCon
+promotedNilDataCon    = promoteDataCon nilDataCon
+
 {-
 Note [The Implicit Parameter class]
 
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index 86ced96b12..548df304c0 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -41,11 +41,13 @@ module Data.Typeable.Internal (
     mkTyCon3, mkTyCon3#,
     rnfTyCon,
 
+    -- ** Representations for wired-in types
     tcBool, tc'True, tc'False,
     tcOrdering, tc'LT, tc'EQ, tc'GT,
     tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
     tcIO, tcSPEC, tcTyCon, tcModule, tcTrName,
-    tcCoercible, tcList, tcHEq,
+    tcCoercible, tcHEq, tcSymbol, tcNat,
+    tcList, tc'Nil, tc'Cons,
     tcConstraint,
     tcTYPE, tcLevity, tc'Lifted, tc'Unlifted,
 
@@ -401,11 +403,15 @@ mkGhcTypesTyCon :: Addr# -> TyCon
 {-# INLINE mkGhcTypesTyCon #-}
 mkGhcTypesTyCon name = mkTyCon3# "ghc-prim"# "GHC.Types"# name
 
+mkGhcPrimTyCon :: Addr# -> TyCon
+{-# INLINE mkGhcPrimTyCon #-}
+mkGhcPrimTyCon name = mkTyCon3# "ghc-prim"# "GHC.Prim"# name
+
 tcBool, tc'True, tc'False,
   tcOrdering, tc'GT, tc'EQ, tc'LT,
   tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
   tcIO, tcSPEC, tcTyCon, tcModule, tcTrName,
-  tcCoercible, tcHEq, tcList :: TyCon
+  tcCoercible, tcHEq, tcNat, tcSymbol :: TyCon
 
 tcBool      = mkGhcTypesTyCon "Bool"#      -- Bool is promotable
 tc'True     = mkGhcTypesTyCon "'True"#
@@ -415,26 +421,34 @@ tc'GT       = mkGhcTypesTyCon "'GT"#
 tc'EQ       = mkGhcTypesTyCon "'EQ"#
 tc'LT       = mkGhcTypesTyCon "'LT"#
 
--- None of the rest are promotable (see TysWiredIn)
+-- Most of the rest are promotable (see TysWiredIn)
 tcChar       = mkGhcTypesTyCon "Char"#
 tcInt        = mkGhcTypesTyCon "Int"#
 tcWord       = mkGhcTypesTyCon "Word"#
 tcFloat      = mkGhcTypesTyCon "Float"#
 tcDouble     = mkGhcTypesTyCon "Double"#
+tcNat        = mkGhcTypesTyCon "Nat"#
+tcSymbol     = mkGhcTypesTyCon "Symbol"#
 tcSPEC       = mkGhcTypesTyCon "SPEC"#
 tcIO         = mkGhcTypesTyCon "IO"#
+tcCoercible  = mkGhcTypesTyCon "Coercible"#
 tcTyCon      = mkGhcTypesTyCon "TyCon"#
 tcModule     = mkGhcTypesTyCon "Module"#
 tcTrName     = mkGhcTypesTyCon "TrName"#
-tcCoercible  = mkGhcTypesTyCon "Coercible"#
 
-tcFun       = mkGhcTypesTyCon "->"#
-tcList      = mkGhcTypesTyCon "[]"#   -- Type rep for the list type constructor
+tcFun       = mkGhcPrimTyCon "->"#
 tcHEq       = mkGhcTypesTyCon "~~"#   -- Type rep for the (~~) type constructor
 
+tcList, tc'Nil, tc'Cons :: TyCon
+tcList      = mkGhcTypesTyCon "[]"#   -- Type rep for the list type constructor
+-- note that, because tc': isn't a valid identifier, we override the names of
+-- these representations in TysWiredIn.tyConRepModOcc.
+tc'Nil      = mkGhcTypesTyCon "'[]"#
+tc'Cons     = mkGhcTypesTyCon "':"#
+
 tcConstraint, tcTYPE, tcLevity, tc'Lifted, tc'Unlifted :: TyCon
 tcConstraint   = mkGhcTypesTyCon "Constraint"#
-tcTYPE         = mkGhcTypesTyCon "TYPE"#
+tcTYPE         = mkGhcPrimTyCon "TYPE"#
 tcLevity       = mkGhcTypesTyCon "Levity"#
 tc'Lifted      = mkGhcTypesTyCon "'Lifted"#
 tc'Unlifted    = mkGhcTypesTyCon "'Unlifted"#
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index b30db97400..2ce4c7ee7e 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -43,6 +43,10 @@ import GHC.Prim
 
 infixr 5 :
 
+-- Take note: All types defined here must have associated type representations
+-- defined in Data.Typeable.Internal.
+-- See Note [Representation of types defined in GHC.Types] below.
+
 {- *********************************************************************
 *                                                                      *
                   Kinds
@@ -367,6 +371,10 @@ Note [Representations of types defined in GHC.Types]
 The representations for the types defined in GHC.Types are
 defined in GHC.Typeable.Internal.
 
+Any types defined here must also have a corresponding TyCon representation
+defined in Data.Typeable.Internal. Also, if the type is promotable it must also
+have a TyCon for each promoted data constructor.
+
 -}
 
 #include "MachDeps.h"