[commit: ghc] typeable-with-kinds: All reps, except the ones for type/kind constructors. (abfc297)

[git at git.haskell.org]

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

On branch  : typeable-with-kinds
Link       : http://ghc.haskell.org/trac/ghc/changeset/abfc297fd29c76a41f0d3ae6938bc4a4315ac7c7/ghc

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

commit abfc297fd29c76a41f0d3ae6938bc4a4315ac7c7
Author: Iavor S. Diatchki <diatchki at galois.com>
Date:   Tue Feb 10 11:13:47 2015 -0800

    All reps, except the ones for type/kind constructors.


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

abfc297fd29c76a41f0d3ae6938bc4a4315ac7c7
 compiler/deSugar/DsBinds.hs | 43 +++++++++++++++++++++++++++++--------------
 1 file changed, 29 insertions(+), 14 deletions(-)

diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 92d2e7f..11bd4b8 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -889,25 +889,41 @@ dsEvTypeable ev =
      (ty, rep) <-
         case ev of
           EvTypeableTyCon tc ks ts ->
-            do let ty = mkTyConApp tc (ks ++ map snd ts)
-               tcRep     <- undefined
-               kReps     <- mapM kindRep ks
-               tReps     <- mapM (getRep tyCl) ts
-               ctr       <- dsLookupGlobalId mkPolyTyConAppName
+            do ctr       <- dsLookupGlobalId mkPolyTyConAppName
                typeRepTc <- dsLookupTyCon typeRepTyConName
                let tyRepType = mkTyConApp typeRepTc []
-               return (ty, mkApps (Var ctr)
-                              [ tcRep
-                              , mkListExpr tyRepType kReps
-                              , mkListExpr tyRepType tReps
-                              ])
+                   mkRep cRep kReps tReps = mkApps (Var ctr)
+                                                   [ cRep
+                                                   , mkListExpr tyRepType kReps
+                                                   , mkListExpr tyRepType tReps
+                                                   ]
+
+
+               let kindRep k =
+                     case splitTyConApp_maybe k of
+                       Nothing -> panic "dsEvTypeable: not a kind constructor"
+                       Just (kc,ks) ->
+                         do kcRep <- undefined kc
+                            reps  <- mapM kindRep ks
+                            return (mkRep kcRep [] reps)
+
+               tcRep     <- undefined tc
+
+               kReps     <- mapM kindRep ks
+               tReps     <- mapM (getRep tyCl) ts
+
+               return ( mkTyConApp tc (ks ++ map snd ts)
+                      , mkRep tcRep kReps tReps
+                      )
 
           EvTypeableTyApp t1 t2 ->
-            do let ty = mkAppTy (snd t1) (snd t2)
-               e1  <- getRep tyCl t1
+            do e1  <- getRep tyCl t1
                e2  <- getRep tyCl t2
                ctr <- dsLookupGlobalId mkAppTyName
-               return (ty, mkApps (Var ctr) [ e1, e2 ])
+
+               return ( mkAppTy (snd t1) (snd t2)
+                      , mkApps (Var ctr) [ e1, e2 ]
+                      )
 
           EvTypeableTyLit ty ->
             do str <- case (isNumLitTy ty, isStrLitTy ty) of
@@ -941,7 +957,6 @@ dsEvTypeable ev =
                             (getTypeableCo tc ty)
     where proxyT = mkProxyPrimTy (typeKind ty) ty
 
-  kindRep k               = undefined