diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-17 10:07:32 -0400 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-17 10:07:32 -0400 |
| commit | c948b7865ace38d3d6912db0fc271aa7e9f70d2b (patch) | |
| tree | 01f206d5d41ccaf6128e88420a286ae0708083dd | |
| parent | 039fa1b994a8b0d6be25eb1bc711904db9661db2 (diff) | |
| download | haskell-c948b7865ace38d3d6912db0fc271aa7e9f70d2b.tar.gz | |
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
| -rw-r--r-- | compiler/typecheck/TcSplice.hs | 30 |
1 files changed, 3 insertions, 27 deletions
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 6df78f8a85..8b5ed7d5f0 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 |