[commit: ghc] wip/ttypeable: Begin reintroducing typeRepKind (d86c376)

[git at git.haskell.org]

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

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

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

commit d86c376d0419e90719354a3ab26944182ad4cc78
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Nov 29 19:39:28 2016 -0500

    Begin reintroducing typeRepKind
    
    It's necessary.


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

d86c376d0419e90719354a3ab26944182ad4cc78
 libraries/base/Data/Dynamic.hs           |  1 +
 libraries/base/Data/Typeable/Internal.hs | 15 +++++++++++----
 libraries/base/Type/Reflection.hs        |  1 +
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs
index 6dd5fe2..446ad36 100644
--- a/libraries/base/Data/Dynamic.hs
+++ b/libraries/base/Data/Dynamic.hs
@@ -137,6 +137,7 @@ fromDynamic (Dynamic t v)
 dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
 dynApply (Dynamic (TRFun ta tr) f) (Dynamic ta' x)
   | Just HRefl <- ta `eqTypeRep` ta'
+  , Just HRefl <- typeRep @Type `eqTypeRep` typeRepKind tr
   = Just (Dynamic tr (f x))
 dynApply _ _
   = Nothing
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index e97437e..a0cc89d 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -56,6 +56,7 @@ module Data.Typeable.Internal (
     splitApp,
     rnfTypeRep,
     eqTypeRep,
+    typeRepKind,
 
     -- * SomeTypeRep
     SomeTypeRep(..),
@@ -155,7 +156,7 @@ data TypeRep (a :: k) where
             -> TypeRep (a :: k1 -> k2)
             -> TypeRep (b :: k1)
             -> TypeRep (a b)
-    TrFun   :: forall a b.
+    TrFun   :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2).
                {-# UNPACK #-} !Fingerprint
             -> TypeRep a
             -> TypeRep b
@@ -194,7 +195,7 @@ instance Ord SomeTypeRep where
     typeRepFingerprint a `compare` typeRepFingerprint b
 
 pattern TRFun :: forall fun. ()
-              => forall arg res. (fun ~ (arg -> res))
+              => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (arg :: TYPE r1) (res :: TYPE r2). (fun ~ (arg -> res))
               => TypeRep arg
               -> TypeRep res
               -> TypeRep fun
@@ -291,6 +292,10 @@ eqTypeRep a b
   | typeRepFingerprint a == typeRepFingerprint b = Just (unsafeCoerce# HRefl)
   | otherwise                                    = Nothing
 
+-- | Observe the kind of a type.
+typeRepKind :: TypeRep (a :: k) -> TypeRep k
+typeRepKind a = undefined
+
 -------------------------------------------------------------
 --
 --      The Typeable class and friends
@@ -361,12 +366,14 @@ instance Show SomeTypeRep where
   showsPrec p (SomeTypeRep ty) = showsPrec p ty
 
 splitApps :: TypeRep a -> (TyCon, [SomeTypeRep])
-splitApps = go []
+splitApps = undefined --go []
+    {-
   where
     go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])
     go xs (TrTyCon _ tc _) = (tc, xs)
     go xs (TrApp _ f x)    = go (SomeTypeRep x : xs) f
     go _  (TrFun _ _ _)    = error "splitApps: FunTy" -- TODO
+-}
 
 isListTyCon :: TyCon -> Bool
 isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int])
@@ -483,7 +490,7 @@ mkPrimTrCon tc kind_vars = TrTyCon fpr tc kind_vars
 mkPrimTyCon :: String -> TyCon
 mkPrimTyCon = mkTyCon "ghc-prim" "GHC.Prim"
 
-mkTrFun :: forall a b.
+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
diff --git a/libraries/base/Type/Reflection.hs b/libraries/base/Type/Reflection.hs
index 2c9605a..13b28d2 100644
--- a/libraries/base/Type/Reflection.hs
+++ b/libraries/base/Type/Reflection.hs
@@ -22,6 +22,7 @@ module Type.Reflection
     , I.splitApp
     , I.rnfTypeRep
     , I.eqTypeRep
+    , I.typeRepKind
 
       -- ** Quantified
     , I.SomeTypeRep(..)