\begin{code}
module IfaceType (
- IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
+ IfExtName, IfLclName,
+
+ IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), IfaceCoCon(..),
IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
ifaceTyConName,
-- Conversion from Type -> IfaceType
- toIfaceType, toIfacePred, toIfaceContext,
+ toIfaceType, toIfaceContext,
toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
toIfaceTyCon, toIfaceTyCon_name,
+ -- Conversion from Coercion -> IfaceType
+ coToIfaceType,
+
-- Printing
pprIfaceType, pprParendIfaceType, pprIfaceContext,
pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
) where
-#include "HsVersions.h"
-
-import TypeRep
+import Coercion
+import TypeRep hiding( maybeParen )
import TyCon
+import Id
import Var
import TysWiredIn
+import TysPrim
import Name
import BasicTypes
import Outputable
%************************************************************************
\begin{code}
+type IfLclName = FastString -- A local name in iface syntax
+
+type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn
+ -- (However Internal or System Names never should)
+
data IfaceBndr -- Local (non-top-level) binders
= IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
| IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
-type IfaceIdBndr = (FastString, IfaceType)
-type IfaceTvBndr = (FastString, IfaceKind)
+type IfaceIdBndr = (IfLclName, IfaceType)
+type IfaceTvBndr = (IfLclName, IfaceKind)
-------------------------------
-type IfaceKind = IfaceType -- Re-use the Kind type, but no KindVars in it
-
+type IfaceKind = IfaceType
type IfaceCoercion = IfaceType
-data IfaceType
- = IfaceTyVar FastString -- Type variable only, not tycon
+data IfaceType -- A kind of universal type, used for types, kinds, and coercions
+ = IfaceTyVar IfLclName -- Type/coercion variable only, not tycon
| IfaceAppTy IfaceType IfaceType
+ | IfaceFunTy IfaceType IfaceType
| IfaceForAllTy IfaceTvBndr IfaceType
| IfacePredTy IfacePredType
- | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
- -- Includes newtypes, synonyms, tuples
- | IfaceFunTy IfaceType IfaceType
+ | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
+ -- Includes newtypes, synonyms, tuples
+ | IfaceCoConApp IfaceCoCon [IfaceType] -- Always saturated
data IfacePredType -- NewTypes are handled as ordinary TyConApps
- = IfaceClassP Name [IfaceType]
+ = IfaceClassP IfExtName [IfaceType]
| IfaceIParam (IPName OccName) IfaceType
| IfaceEqPred IfaceType 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
+data IfaceTyCon -- Encodes type consructors, kind constructors
+ -- coercion constructors, the lot
+ = IfaceTc IfExtName -- The common case
| IfaceIntTc | IfaceBoolTc | IfaceCharTc
| IfaceListTc | IfacePArrTc
| IfaceTupTc Boxity Arity
+ | IfaceAnyTc IfaceKind -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
+ -- other than 'Any :: *' itself
+
+ -- Kind constructors
| IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
| IfaceUbxTupleKindTc | IfaceArgTypeKindTc
- deriving( Eq )
+
+ -- Coercion constructors
+data IfaceCoCon
+ = IfaceCoAx IfExtName
+ | IfaceReflCo | IfaceUnsafeCo | IfaceSymCo
+ | IfaceTransCo | IfaceInstCo
+ | IfaceNthCo Int
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 k) = pprPanic "ifaceTyConName" (ppr k)
+ -- 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 because there's an IfaceKind inside, and we
+need a Kind.
+
+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 :: (IfLclName, 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
+
+ppr_ty ctxt_prec (IfaceCoConApp tc tys)
+ = maybeParen ctxt_prec tYCON_PREC
+ (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
-- 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)
instance Outputable IfaceTyCon where
- ppr (IfaceTc ext) = ppr ext
- ppr other_tc = ppr (ifaceTyConName other_tc)
+ ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k
+ -- We can't easily get the Name of an IfaceAnyTc
+ -- (see Note [The Name of an IfaceAnyTc])
+ -- so we fake it. It's only for debug printing!
+ ppr other_tc = ppr (ifaceTyConName other_tc)
+
+instance Outputable IfaceCoCon where
+ ppr (IfaceCoAx n) = ppr n
+ ppr IfaceReflCo = ptext (sLit "Refl")
+ ppr IfaceUnsafeCo = ptext (sLit "Unsafe")
+ ppr IfaceSymCo = ptext (sLit "Sym")
+ ppr IfaceTransCo = ptext (sLit "Trans")
+ ppr IfaceInstCo = ptext (sLit "Inst")
+ ppr (IfaceNthCo d) = ptext (sLit "Nth:") <> int d
-------------------
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 <+> darrow
+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 -> (IfLclName, IfaceType)
toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
+toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
+toIfaceTvBndrs :: [TyVar] -> [(IfLclName, 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
---------------------
toIfaceType :: Type -> IfaceType
-- Synonyms are retained in the interface type
-toIfaceType (TyVarTy tv) =
- IfaceTyVar (occNameFS (getOccName tv))
-toIfaceType (AppTy t1 t2) =
- IfaceAppTy (toIfaceType t1) (toIfaceType t2)
-toIfaceType (FunTy t1 t2) =
- IfaceFunTy (toIfaceType t1) (toIfaceType t2)
-toIfaceType (TyConApp tc tys) =
- IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
-toIfaceType (ForAllTy tv t) =
- IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
-toIfaceType (PredTy st) =
- IfacePredTy (toIfacePred st)
-toIfaceType (NoteTy other_note ty) =
- toIfaceType ty
+toIfaceType (TyVarTy tv) = IfaceTyVar (toIfaceTyCoVar tv)
+toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
+toIfaceType (FunTy t1 t2) = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
+toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
+toIfaceType (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
+toIfaceType (PredTy st) = IfacePredTy (toIfacePred toIfaceType st)
+
+toIfaceTyCoVar :: TyCoVar -> FastString
+toIfaceTyCoVar = occNameFS . getOccName
----------------
-- 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 (ClassP cls ts) =
- IfaceClassP (getName cls) (toIfaceTypes ts)
-toIfacePred (IParam ip t) =
- IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
-toIfacePred (EqPred ty1 ty2) =
- IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
+toIfacePred :: (a -> IfaceType) -> Pred a -> IfacePredType
+toIfacePred to (ClassP cls ts) = IfaceClassP (getName cls) (map to ts)
+toIfacePred to (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (to t)
+toIfacePred to (EqPred ty1 ty2) = IfaceEqPred (to ty1) (to ty2)
----------------
toIfaceContext :: ThetaType -> IfaceContext
-toIfaceContext cs = map toIfacePred cs
+toIfaceContext cs = map (toIfacePred toIfaceType) cs
+
+----------------
+coToIfaceType :: Coercion -> IfaceType
+coToIfaceType (Refl ty) = IfaceCoConApp IfaceReflCo [toIfaceType ty]
+coToIfaceType (TyConAppCo tc cos) = IfaceTyConApp (toIfaceTyCon tc)
+ (map coToIfaceType cos)
+coToIfaceType (AppCo co1 co2) = IfaceAppTy (coToIfaceType co1)
+ (coToIfaceType co2)
+coToIfaceType (ForAllCo v co) = IfaceForAllTy (toIfaceTvBndr v)
+ (coToIfaceType co)
+coToIfaceType (CoVarCo cv) = IfaceTyVar (toIfaceTyCoVar cv)
+coToIfaceType (AxiomInstCo con cos) = IfaceCoConApp (IfaceCoAx (coAxiomName con))
+ (map coToIfaceType cos)
+coToIfaceType (UnsafeCo ty1 ty2) = IfaceCoConApp IfaceUnsafeCo
+ [ toIfaceType ty1
+ , toIfaceType ty2 ]
+coToIfaceType (SymCo co) = IfaceCoConApp IfaceSymCo
+ [ coToIfaceType co ]
+coToIfaceType (TransCo co1 co2) = IfaceCoConApp IfaceTransCo
+ [ coToIfaceType co1
+ , coToIfaceType co2 ]
+coToIfaceType (NthCo d co) = IfaceCoConApp (IfaceNthCo d)
+ [ coToIfaceType co ]
+coToIfaceType (InstCo co ty) = IfaceCoConApp IfaceInstCo
+ [ coToIfaceType co
+ , toIfaceType ty ]
\end{code}
projects / ghc-hetmet.git / blobdiff