) where
-#include "HsVersions.h"
-
import TypeRep
import TyCon
+import Id
import Var
import TysWiredIn
import Name
type IfaceTvBndr = (FastString, IfaceKind)
-------------------------------
-type IfaceKind = IfaceType -- Re-use the Kind type, but no KindVars in it
-
+type IfaceKind = IfaceType
type IfaceCoercion = IfaceType
data IfaceType
type IfaceContext = [IfacePredType]
--- NB: If you add a data constructor, remember to add a case to
--- IfaceSyn.eqIfTc!
data IfaceTyCon -- Abbreviations for common tycons with known names
= IfaceTc Name -- The common case
| IfaceIntTc | IfaceBoolTc | IfaceCharTc
| IfaceListTc | IfacePArrTc
| IfaceTupTc Boxity Arity
+ | IfaceAnyTc IfaceKind -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
| IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
| IfaceUbxTupleKindTc | IfaceArgTypeKindTc
- deriving( Eq )
ifaceTyConName :: IfaceTyCon -> Name
-ifaceTyConName IfaceIntTc = intTyConName
-ifaceTyConName IfaceBoolTc = boolTyConName
-ifaceTyConName IfaceCharTc = charTyConName
-ifaceTyConName IfaceListTc = listTyConName
-ifaceTyConName IfacePArrTc = parrTyConName
-ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
+ifaceTyConName IfaceIntTc = intTyConName
+ifaceTyConName IfaceBoolTc = boolTyConName
+ifaceTyConName IfaceCharTc = charTyConName
+ifaceTyConName IfaceListTc = listTyConName
+ifaceTyConName IfacePArrTc = parrTyConName
+ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName
ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName
ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName
ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName
-ifaceTyConName (IfaceTc ext) = ext
+ifaceTyConName (IfaceTc ext) = ext
+ifaceTyConName (IfaceAnyTc kind) = pprPanic "ifaceTyConName" (ppr (IfaceAnyTc kind))
+ -- Note [The Name of an IfaceAnyTc]
\end{code}
+Note [The Name of an IfaceAnyTc]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It isn't easy to get the Name of an IfaceAnyTc in a pure way. What you
+really need to do is to transform it to a TyCon, and get the Name of that.
+But doing so needs the monad.
+
+In fact, ifaceTyConName is only used for instances and rules, and we don't
+expect to instantiate those at these (internal-ish) Any types, so rather
+than solve this potential problem now, I'm going to defer it until it happens!
%************************************************************************
%* *
\end{description}
\begin{code}
-tOP_PREC = (0 :: Int) -- type in ParseIface.y
-fUN_PREC = (1 :: Int) -- btype in ParseIface.y
-tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
+tOP_PREC, fUN_PREC, tYCON_PREC :: Int
+tOP_PREC = 0 -- type in ParseIface.y
+fUN_PREC = 1 -- btype in ParseIface.y
+tYCON_PREC = 2 -- atype in ParseIface.y
noParens :: SDoc -> SDoc
noParens pp = pp
+maybeParen :: Int -> Int -> SDoc -> SDoc
maybeParen ctxt_prec inner_prec pretty
| ctxt_prec < inner_prec = pretty
| otherwise = parens pretty
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs bs = sep (map ppr bs)
+pprIfaceIdBndr :: (FastString, IfaceType) -> SDoc
pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
pprIfaceTvBndr :: IfaceTvBndr -> SDoc
\begin{code}
---------------------------------
instance Outputable IfaceType where
- ppr ty = pprIfaceTypeForUser ty
-
-pprIfaceTypeForUser ::IfaceType -> SDoc
--- Drop top-level for-alls; if that's not what you want, use pprIfaceType dire
-pprIfaceTypeForUser ty
- = pprIfaceForAllPart [] theta (pprIfaceType tau)
- where
- (_tvs, theta, tau) = splitIfaceSigmaTy ty
+ ppr ty = pprIfaceType ty
pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
pprIfaceType = ppr_ty tOP_PREC
ppr_ty :: Int -> IfaceType -> SDoc
-ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
+ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
-ppr_ty ctxt_prec (IfacePredTy st) = ppr st
+ppr_ty _ (IfacePredTy st) = ppr st
-- Function types
ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
= sep [ppr_tvs, pprIfaceContext ctxt, doc]
where
ppr_tvs | null tvs = empty
- | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
+ | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
-------------------
-ppr_tc_app ctxt_prec tc [] = ppr_tc tc
-ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty)
-ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
-ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
+ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
+ppr_tc_app _ tc [] = ppr_tc tc
+ppr_tc_app _ IfaceListTc [ty] = brackets (pprIfaceType ty)
+ppr_tc_app _ IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
+ppr_tc_app _ (IfaceTupTc bx arity) tys
| arity == length tys
= tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
ppr_tc_app ctxt_prec tc tys
-------------------
instance Outputable IfacePredType where
-- Print without parens
- ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext SLIT(":=:"), ppr ty2]
+ ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit "~"), ppr ty2]
ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
<+> sep (map pprParendIfaceType ts)
pprIfaceContext :: IfaceContext -> SDoc
-- Prints "(C a, D b) =>", including the arrow
pprIfaceContext [] = empty
-pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
+pprIfaceContext theta = ppr_preds theta <+> ptext (sLit "=>")
+ppr_preds :: [IfacePredType] -> SDoc
ppr_preds [pred] = ppr pred -- No parens
ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
-------------------
-pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
+pabrackets :: SDoc -> SDoc
+pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
\end{code}
%************************************************************************
\begin{code}
----------------
+toIfaceTvBndr :: TyVar -> (FastString, IfaceType)
toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
+toIfaceIdBndr :: Id -> (FastString, IfaceType)
toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
+toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)]
toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
+toIfaceBndr :: Var -> IfaceBndr
toIfaceBndr var
| isId var = IfaceIdBndr (toIfaceIdBndr var)
| otherwise = IfaceTvBndr (toIfaceTvBndr var)
+toIfaceKind :: Type -> IfaceType
toIfaceKind = toIfaceType
---------------------
IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
toIfaceType (PredTy st) =
IfacePredTy (toIfacePred st)
-toIfaceType (NoteTy other_note ty) =
- toIfaceType ty
----------------
-- A little bit of (perhaps optional) trickiness here. When
toIfaceTyCon :: TyCon -> IfaceTyCon
toIfaceTyCon tc
| isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+ | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc))
| otherwise = toIfaceTyCon_name (tyConName tc)
toIfaceTyCon_name :: Name -> IfaceTyCon
toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
toIfaceWiredInTyCon tc nm
- | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+ | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+ | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc))
| nm == intTyConName = IfaceIntTc
| nm == boolTyConName = IfaceBoolTc
| nm == charTyConName = IfaceCharTc
| otherwise = IfaceTc nm
----------------
+toIfaceTypes :: [Type] -> [IfaceType]
toIfaceTypes ts = map toIfaceType ts
----------------
+toIfacePred :: PredType -> IfacePredType
toIfacePred (ClassP cls ts) =
IfaceClassP (getName cls) (toIfaceTypes ts)
toIfacePred (IParam ip t) =
projects / ghc-hetmet.git / blobdiff