[commit: ghc] wip/ttypeable: Rip out manual TypeReps (979b758)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/979b758ca8072c430596aa54d8b9ae38ca68c482/ghc

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

commit 979b758ca8072c430596aa54d8b9ae38ca68c482
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Nov 30 13:35:46 2016 -0500

    Rip out manual TypeReps


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

979b758ca8072c430596aa54d8b9ae38ca68c482
 compiler/prelude/PrelNames.hs            | 16 ---------
 compiler/prelude/TysPrim.hs              |  5 +--
 compiler/typecheck/TcInteract.hs         |  6 +---
 libraries/base/Data/Typeable/Internal.hs | 60 ++------------------------------
 4 files changed, 4 insertions(+), 83 deletions(-)

diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 323fc1c..2cb465a 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -238,11 +238,6 @@ basicKnownKeyNames
         mkTrFunName,
         typeSymbolTypeRepName, typeNatTypeRepName,
         trGhcPrimModuleName,
-        -- Representations
-        trTYPEName,
-        trTYPE'PtrRepLiftedName,
-        trRuntimeRepName,
-        tr'PtrRepLiftedName,
 
         -- Dynamic
         toDynName,
@@ -1227,17 +1222,6 @@ typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") ty
 -- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)
 -- See Note [Grand plan for Typeable] in TcTypeable.
 trGhcPrimModuleName   = varQual gHC_TYPES         (fsLit "tr$ModuleGHCPrim")  trGhcPrimModuleKey
--- Representations for primitive types
--- These are of type `TypeRep a`
-trTYPEName
-  , trTYPE'PtrRepLiftedName
-  , trRuntimeRepName
-  , tr'PtrRepLiftedName
-  :: Name
-trTYPEName              = varQual tYPEABLE_INTERNAL (fsLit "trTYPE")              trTYPEKey
-trTYPE'PtrRepLiftedName = varQual tYPEABLE_INTERNAL (fsLit "trTYPE'PtrRepLifted") trTYPE'PtrRepLiftedKey
-trRuntimeRepName        = varQual tYPEABLE_INTERNAL (fsLit "trRuntimeRep")        trRuntimeRepKey
-tr'PtrRepLiftedName     = varQual tYPEABLE_INTERNAL (fsLit "tr'PtrRepLifted")     tr'PtrRepLiftedKey
 
 -- Custom type errors
 errorMessageTypeErrorFamName
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index 1ac4ad7..0f9e252 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -166,10 +166,7 @@ primTyCons
 -- See Note [Mutually recursive representations of primitive types] in
 -- "Data.Typeable.Internal" and Note [Grand plan for Typeable] in "TcTypeable".
 primTypeableTyCons :: NameEnv TyConRepName
-primTypeableTyCons = mkNameEnv
-    [ (tYPETyConName, trTYPEName)
-    , (tyConName runtimeRepTyCon, trRuntimeRepName)
-    ]
+primTypeableTyCons = mkNameEnv [] -- TODO: Remove me
 
 mkPrimTc :: FastString -> Unique -> TyCon -> Name
 mkPrimTc fs unique tycon
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index f1a0bc7..ff49d1a 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -25,8 +25,7 @@ import TcType
 import Name
 import PrelNames ( knownNatClassName, knownSymbolClassName,
                    typeableClassName, coercibleTyConKey,
-                   heqTyConKey, ipClassKey,
-                   trTYPEName, trTYPE'PtrRepLiftedName, trRuntimeRepName )
+                   heqTyConKey, ipClassKey )
 import TysWiredIn ( typeNatKind, typeSymbolKind, heqDataCon,
                     coercibleDataCon, runtimeRepTy )
 import TysPrim    ( eqPrimTyCon, eqReprPrimTyCon, tYPETyCon )
@@ -2163,9 +2162,6 @@ matchTypeable clas [k,t]  -- clas = Typeable
   -- Now cases that do work
   | k `eqType` typeNatKind                 = doTyLit knownNatClassName         t
   | k `eqType` typeSymbolKind              = doTyLit knownSymbolClassName      t
-  | t `eqType` liftedTypeKind              = doPrimRep trTYPE'PtrRepLiftedName t
-  | t `eqType` mkTyConTy tYPETyCon         = doPrimRep trTYPEName              t
-  | t `eqType` runtimeRepTy                = doPrimRep trRuntimeRepName        t
   | Just (arg,ret) <- splitFunTy_maybe t   = doFunTy    clas t arg ret
   | t `eqType` mkTyConTy funTyCon          = return NoInstance --doPrimRep trArrowName             t
   | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index cb1c807..db1ccb8 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -69,12 +69,6 @@ module Data.Typeable.Internal (
     -- | These are for internal use only
     mkTrCon, mkTrApp, mkTyCon, mkTyCon#,
     typeSymbolTypeRep, typeNatTypeRep,
-
-    -- * Representations for primitive types
-    trTYPE,
-    trTYPE'PtrRepLifted,
-    trRuntimeRep,
-    tr'PtrRepLifted,
   ) where
 
 import GHC.Base
@@ -477,58 +471,8 @@ typeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p)) tcSymbol
 typeLitTypeRep :: forall (a :: k). (Typeable k) => String -> TyCon -> TypeRep a
 typeLitTypeRep nm kind_tycon = mkTrCon (mkTypeLitTyCon nm kind_tycon) []
 
-{- *********************************************************
-*                                                          *
-*       TyCon/TypeRep definitions for primitive types      *
-*       (TYPE, RuntimeRep, (->) and promoted constructors) *
-*                                                          *
-********************************************************* -}
-
-{-
-Note [Mutually recursive representations of primitive types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-These primitive types exhibit mutual recursion through their kinds.
-
-    TYPE          :: RuntimeRep -> TYPE 'PtrRepLifted
-    RuntimeRep    :: TYPE 'PtrRepLifted
-    'PtrRepLifted :: RuntimeRep
-    (->)          :: TYPE 'PtrRepLifted -> TYPE 'PtrRepLifted -> Type 'PtrRepLifted
-    TYPE 'PtrRepLifted :: TYPE 'PtrRepLifted
-
-For this reason we are forced to define their representations
-manually.
--}
-
--- | We can't use 'mkTrCon' here as it requires the fingerprint of the kind
--- which is knot-tied.
-mkPrimTrCon :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
-mkPrimTrCon tc kind_vars = TrTyCon fpr tc kind_vars
-  where
-    fpr_tc  = tyConFingerprint tc
-    fpr_tag = fingerprintString "prim"
-    fpr     = fingerprintFingerprints [fpr_tag, fpr_tc]
-
-mkPrimTyCon :: String -> TyCon
-mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim"
-
+-- | For compiler use.
 mkTrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2).
            TypeRep a -> TypeRep b -> TypeRep ((a -> b) :: Type)
 mkTrFun arg res = TrFun fpr arg res
-  where fpr = undefined
-
-trTYPE :: TypeRep TYPE
-trTYPE = mkPrimTrCon (mkPrimTyCon "TYPE") []
-
-trRuntimeRep :: TypeRep RuntimeRep
-trRuntimeRep = mkPrimTrCon (mkPrimTyCon "RuntimeRep") []
-
-tr'PtrRepLifted :: TypeRep 'PtrRepLifted
-tr'PtrRepLifted = mkPrimTrCon (mkPrimTyCon "'PtrRepLifted") []
-
-trTYPE'PtrRepLifted :: TypeRep (TYPE 'PtrRepLifted)
-trTYPE'PtrRepLifted = mkTrApp trTYPE tr'PtrRepLifted
-
--- Some useful aliases
-star :: TypeRep (TYPE 'PtrRepLifted)
-star = trTYPE'PtrRepLifted
+  where fpr = fingerprintFingerprints [typeRepFingerprint arg, typeRepFingerprint res]