Commit c948b786 authored by Ryan Scott's avatar Ryan Scott

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 ad7b9452.

Test Plan: ./validate

Reviewers: goldfire, austin, bgamari

Reviewed By: goldfire

Subscribers: rwbarton, thomie

GHC Trac Issues: #11785

Differential Revision: https://phabricator.haskell.org/D3854
parent 039fa1b9
......@@ -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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment