[commit: ghc] wip/tc/typeable-with-kinds: Use the kind itself in the evidence for `Typeable` (65dc366)

[git at git.haskell.org]

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

On branch  : wip/tc/typeable-with-kinds
Link       : http://ghc.haskell.org/trac/ghc/changeset/65dc366b0d0d6c6cf0e03c89aed6682349d0727c/ghc

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

commit 65dc366b0d0d6c6cf0e03c89aed6682349d0727c
Author: Iavor S. Diatchki <diatchki at galois.com>
Date:   Tue Feb 10 10:10:59 2015 -0800

    Use the kind itself in the evidence for `Typeable`


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

65dc366b0d0d6c6cf0e03c89aed6682349d0727c
 compiler/deSugar/DsBinds.hs      |  4 +---
 compiler/typecheck/TcEvidence.hs | 15 ++-------------
 compiler/typecheck/TcInteract.hs |  8 +++++---
 3 files changed, 8 insertions(+), 19 deletions(-)

diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 3c50d1e..3fb42bf 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -889,7 +889,7 @@ dsEvTypeable ev =
      (rep,ty) <-
         case ev of
           EvTypeableTyCon tc ks ts ->
-            do let ty = mkTyConApp tc (map toKind ks ++ map snd ts)
+            do let ty = mkTyConApp tc (ks ++ map snd ts)
                kReps <- mapM kindRep ks
                tReps <- mapM (getRep tyCl) ts
                return (tyConRep tc kReps tReps, ty)
@@ -928,8 +928,6 @@ dsEvTypeable ev =
                             (getTypeableCo tc ty)
     where proxyT = mkProxyPrimTy (typeKind ty) ty
 
-  toKind (EvTypeableKind kc ks) = mkTyConApp kc (map toKind ks)
-
   kindRep k               = undefined
   tyConRep tc kReps tReps = undefined
   tyAppRep t1 t2          = undefined
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index fdd90da..3eb5a31 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -17,7 +17,7 @@ module TcEvidence (
   EvTerm(..), mkEvCast, evVarsOfTerm,
   EvLit(..), evTermCoercion,
   EvCallStack(..),
-  EvTypeable(..), EvTypeableKind(..),
+  EvTypeable(..),
 
   -- TcCoercion
   TcCoercion(..), LeftOrRight(..), pickLR,
@@ -735,7 +735,7 @@ data EvTerm
 
 -- | Instructions on how to make a 'Typeable' dictionary.
 data EvTypeable
-  = EvTypeableTyCon TyCon [EvTypeableKind] [(EvTerm, Type)]
+  = EvTypeableTyCon TyCon [Kind] [(EvTerm, Type)]
     -- ^ Dicitionary for concrete type constructors.
 
   | EvTypeableTyApp (EvTerm,Type) (EvTerm,Type)
@@ -747,11 +747,6 @@ data EvTypeable
 
   deriving ( Data.Data, Data.Typeable )
 
--- | Instructions on how to make evidence for the typeable representation
--- of a kind.
-data EvTypeableKind = EvTypeableKind TyCon [EvTypeableKind]
-  deriving ( Data.Data, Data.Typeable )
-
 data EvLit
   = EvNum Integer
   | EvStr FastString
@@ -1112,12 +1107,6 @@ instance Outputable EvTypeable where
       EvTypeableTyApp t1 t2    -> parens (ppr (fst t1) <+> ppr (fst t2))
       EvTypeableTyLit x        -> ppr x
 
-instance Outputable EvTypeableKind where
-  ppr (EvTypeableKind kc ks) =
-    case ks of
-      [] -> ppr kc
-      _  -> parens (ppr kc <+> sep (map ppr ks))
-
 
 ----------------------------------------------------------------------
 -- Helper functions for dealing with IP newtype-dictionaries
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 7ba92a8..3e6424b 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -1876,10 +1876,12 @@ matchTypeableClass clas k t loc
          mkEv [ct1,ct2] (EvTypeableTyApp (ctEvTerm ct1,f) (ctEvTerm ct2,tk))
 
 
-  -- Representation for concrete kinds.
+  -- Representation for concrete kinds.  We just use the kind itself,
+  -- but first check to make sure that it is "simple" (i.e., made entirely
+  -- out of kind constructors).
   kindRep ki = do (kc,ks) <- splitTyConApp_maybe ki
-                  kReps   <- mapM kindRep ks
-                  return (EvTypeableKind kc kReps)
+                  mapM_ kindRep ks
+                  return ki
 
 
   -- Emit a `Typeable` constraint for the given type.