[commit: ghc] master: Fix #11785 by making reifyKind = reifyType (c948b78)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c948b7865ace38d3d6912db0fc271aa7e9f70d2b/ghc

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

commit c948b7865ace38d3d6912db0fc271aa7e9f70d2b
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Aug 17 10:07:32 2017 -0400

    Fix #11785 by making reifyKind = reifyType
    
    Summary:
    This ties up the last loose end in Template Haskell's separate
    code paths for types and kinds. By making `reifyKind = reifyType` in
    `TcSplice`, types and kinds are now treated on equal terms in TH.
    
    This is itself a small patch, but most of the heavy lifting to make this
    possible was done in ad7b945257ea262e3f6f46daa4ff3e451aeeae0b.
    
    Test Plan: ./validate
    
    Reviewers: goldfire, austin, bgamari
    
    Reviewed By: goldfire
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #11785
    
    Differential Revision: https://phabricator.haskell.org/D3854


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

c948b7865ace38d3d6912db0fc271aa7e9f70d2b
 compiler/typecheck/TcSplice.hs | 30 +++---------------------------
 1 file changed, 3 insertions(+), 27 deletions(-)

diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 6df78f8..8b5ed7d 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1675,6 +1675,8 @@ reifyFamilyInstance is_poly_tvs inst@(FamInst { fi_flavor = flavor
 ------------------------------
 reifyType :: TyCoRep.Type -> TcM TH.Type
 -- Monadic only because of failure
+reifyType ty                | isLiftedTypeKind ty = return TH.StarT
+                            | isConstraintKind ty = return TH.ConstraintT
 reifyType ty@(ForAllTy {})  = reify_for_all ty
 reifyType (LitTy t)         = do { r <- reifyTyLit t; return (TH.LitT r) }
 reifyType (TyVarTy tv)      = return (TH.VarT (reifyName tv))
@@ -1717,33 +1719,7 @@ reifyPatSynType (univTyVars, req, exTyVars, prov, argTys, resTy)
                 $ TH.ForallT exTyVars' prov' tau' }
 
 reifyKind :: Kind -> TcM TH.Kind
-reifyKind  ki
-  = do { let (kis, ki') = splitFunTys ki
-       ; ki'_rep <- reifyNonArrowKind ki'
-       ; kis_rep <- mapM reifyKind kis
-       ; return (foldr (TH.AppT . TH.AppT TH.ArrowT) ki'_rep kis_rep) }
-  where
-    reifyNonArrowKind k | isLiftedTypeKind k = return TH.StarT
-                        | isConstraintKind k = return TH.ConstraintT
-    reifyNonArrowKind (TyVarTy v)            = return (TH.VarT (reifyName v))
-    reifyNonArrowKind (FunTy _ k)            = reifyKind k
-    reifyNonArrowKind (ForAllTy _ k)         = reifyKind k
-    reifyNonArrowKind (TyConApp kc kis)      = reify_kc_app kc kis
-    reifyNonArrowKind (AppTy k1 k2)          = do { k1' <- reifyKind k1
-                                                  ; k2' <- reifyKind k2
-                                                  ; return (TH.AppT k1' k2')
-                                                  }
-    reifyNonArrowKind k                      = noTH (sLit "this kind") (ppr k)
-
-reify_kc_app :: TyCon -> [TyCoRep.Kind] -> TcM TH.Kind
-reify_kc_app kc kis
-  = fmap (mkThAppTs r_kc) (mapM reifyKind vis_kis)
-  where
-    r_kc | isTupleTyCon kc          = TH.TupleT (tyConArity kc)
-         | kc `hasKey` listTyConKey = TH.ListT
-         | otherwise                = TH.ConT (reifyName kc)
-
-    vis_kis = filterOutInvisibleTypes kc kis
+reifyKind = reifyType
 
 reifyCxt :: [PredType] -> TcM [TH.Pred]
 reifyCxt   = mapM reifyPred