%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
- This module defines interface types and binders
+This module defines interface types and binders
\begin{code}
module IfaceType (
IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
-
- IfaceExtName(..), mkIfaceExtName, isLocalIfaceExtName,
- ifaceTyConName, ifaceTyConOccName,
+ ifaceTyConName,
-- Conversion from Type -> IfaceType
toIfaceType, toIfacePred, toIfaceContext,
) where
-#include "HsVersions.h"
-
-import TypeRep ( TyThing(..), Type(..), PredType(..), ThetaType,
- unliftedTypeKindTyConName, openTypeKindTyConName,
- ubxTupleKindTyConName, argTypeKindTyConName,
- liftedTypeKindTyConName )
-import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
-import Var ( isId, tyVarKind, idType )
-import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
-import OccName ( OccName, parenSymOcc, occNameFS )
-import Name ( Name, getName, getOccName, nameModule, nameOccName,
- wiredInNameTyThing_maybe )
-import Module ( Module, ModuleName )
-import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
+import TypeRep
+import TyCon
+import Id
+import Var
+import TysWiredIn
+import Name
+import BasicTypes
import Outputable
import FastString
\end{code}
-
-%************************************************************************
-%* *
- IfaceExtName
-%* *
-%************************************************************************
-
-\begin{code}
-data IfaceExtName
- = ExtPkg Module OccName
- -- From an external package; no version # Also used for
- -- wired-in things regardless of whether they are home-pkg or
- -- not
-
- | HomePkg ModuleName OccName Version
- -- From another module in home package; has version #; in all
- -- other respects, HomePkg and ExtPkg are the same. Since this
- -- is a home package name, we use ModuleName rather than Module
-
- | LocalTop OccName -- Top-level from the same module as
- -- the enclosing IfaceDecl
-
- | LocalTopSub -- Same as LocalTop, but for a class method or constr
- OccName -- Class-meth/constr name
- OccName -- Parent class/datatype name
- -- LocalTopSub is written into iface files as LocalTop; the parent
- -- info is only used when computing version information in MkIface
-
-isLocalIfaceExtName :: IfaceExtName -> Bool
-isLocalIfaceExtName (LocalTop _) = True
-isLocalIfaceExtName (LocalTopSub _ _) = True
-isLocalIfaceExtName other = False
-
-mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name)
- -- Local helper for wired-in names
-
-ifaceExtOcc :: IfaceExtName -> OccName
-ifaceExtOcc (ExtPkg _ occ) = occ
-ifaceExtOcc (HomePkg _ occ _) = occ
-ifaceExtOcc (LocalTop occ) = occ
-ifaceExtOcc (LocalTopSub occ _) = occ
-\end{code}
-
-
%************************************************************************
%* *
Local (nested) binders
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
| IfaceFunTy IfaceType IfaceType
data IfacePredType -- NewTypes are handled as ordinary TyConApps
- = IfaceClassP IfaceExtName [IfaceType]
+ = IfaceClassP Name [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 IfaceExtName -- The common case
+ = IfaceTc Name -- 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
| IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
| IfaceUbxTupleKindTc | IfaceArgTypeKindTc
-ifaceTyConName :: IfaceTyCon -> Name -- Works for all except IfaceTc
-ifaceTyConName IfaceIntTc = intTyConName
-ifaceTyConName IfaceBoolTc = boolTyConName
-ifaceTyConName IfaceCharTc = charTyConName
-ifaceTyConName IfaceListTc = listTyConName
-ifaceTyConName IfacePArrTc = parrTyConName
-ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
+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 IfaceLiftedTypeKindTc = liftedTypeKindTyConName
ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName
ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName
ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName
-ifaceTyConName (IfaceTc ext) = pprPanic "ifaceTyConName" (ppr ext)
-
-ifaceTyConOccName :: IfaceTyCon -> OccName -- Works for all!
-ifaceTyConOccName (IfaceTc ext) = ifaceExtOcc ext
-ifaceTyConOccName tycon = nameOccName . ifaceTyConName $ tycon
+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
----------------------------- Printing binders ------------------------------------
\begin{code}
--- These instances are used only when printing for the user, either when
--- debugging, or in GHCi when printing the results of a :info command
-instance Outputable IfaceExtName where
- ppr (ExtPkg mod occ) = ppr mod <> dot <> ppr occ
- ppr (HomePkg mod occ vers) = ppr mod <> dot <> ppr occ <> braces (ppr vers)
- ppr (LocalTop occ) = ppr occ -- Do we want to distinguish these
- ppr (LocalTopSub occ _) = ppr occ -- from an ordinary occurrence?
--- No need to worry about printing unqualified becuase that was handled
--- in the transiation to IfaceSyn
-
instance Outputable IfaceBndr where
ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
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
ppr_tc :: IfaceTyCon -> SDoc
-- Wrap infix type constructors in parens
-ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (ifaceExtOcc ext_nm) (ppr tc)
+ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
ppr_tc tc = ppr tc
-------------------
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 (ifaceExtOcc cls) (ppr cls)
+ 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)
-------------------
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 ext id = (occNameFS (getOccName id), toIfaceType ext (idType id))
+toIfaceIdBndr :: Id -> (FastString, IfaceType)
+toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
+toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)]
toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
-toIfaceBndr ext var
- | isId var = IfaceIdBndr (toIfaceIdBndr ext var)
+toIfaceBndr :: Var -> IfaceBndr
+toIfaceBndr var
+ | isId var = IfaceIdBndr (toIfaceIdBndr var)
| otherwise = IfaceTvBndr (toIfaceTvBndr var)
--- we had better not have to use ext for kinds
-toIfaceKind = toIfaceType (\name -> pprPanic "toIfaceKind ext used on:" (ppr name))
+toIfaceKind :: Type -> IfaceType
+toIfaceKind = toIfaceType
---------------------
-toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
+toIfaceType :: Type -> IfaceType
-- Synonyms are retained in the interface type
-toIfaceType ext (TyVarTy tv) = IfaceTyVar (occNameFS (getOccName tv))
-toIfaceType ext (AppTy t1 t2) = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
-toIfaceType ext (FunTy t1 t2) = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
-toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon ext tc) (toIfaceTypes ext tys)
-toIfaceType ext (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
-toIfaceType ext (PredTy st) = IfacePredTy (toIfacePred ext st)
-toIfaceType ext (NoteTy other_note ty) = toIfaceType ext ty
+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)
----------------
-- A little bit of (perhaps optional) trickiness here. When
-- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
-- toIfaceTyCon_name will still catch it.
-toIfaceTyCon :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
-toIfaceTyCon ext tc
+toIfaceTyCon :: TyCon -> IfaceTyCon
+toIfaceTyCon tc
| isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
- | otherwise = toIfaceTyCon_name ext (tyConName tc)
+ | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc))
+ | otherwise = toIfaceTyCon_name (tyConName tc)
-toIfaceTyCon_name :: (Name -> IfaceExtName) -> Name -> IfaceTyCon
-toIfaceTyCon_name ext nm
+toIfaceTyCon_name :: Name -> IfaceTyCon
+toIfaceTyCon_name nm
| Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
- = toIfaceWiredInTyCon ext tc nm
+ = toIfaceWiredInTyCon tc nm
| otherwise
- = IfaceTc (ext nm)
+ = IfaceTc nm
-toIfaceWiredInTyCon :: (Name -> IfaceExtName) -> TyCon -> Name -> IfaceTyCon
-toIfaceWiredInTyCon ext tc nm
- | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
+toIfaceWiredInTyCon tc nm
+ | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+ | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc))
| nm == intTyConName = IfaceIntTc
| nm == boolTyConName = IfaceBoolTc
| nm == charTyConName = IfaceCharTc
| nm == openTypeKindTyConName = IfaceOpenTypeKindTc
| nm == argTypeKindTyConName = IfaceArgTypeKindTc
| nm == ubxTupleKindTyConName = IfaceUbxTupleKindTc
- | otherwise = IfaceTc (ext nm)
+ | otherwise = IfaceTc nm
----------------
-toIfaceTypes ext ts = map (toIfaceType ext) ts
+toIfaceTypes :: [Type] -> [IfaceType]
+toIfaceTypes ts = map toIfaceType ts
----------------
-toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
-toIfacePred ext (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
-toIfacePred ext (EqPred ty1 ty2) = IfaceEqPred (toIfaceType ext ty1) (toIfaceType ext ty2)
+toIfacePred :: PredType -> IfacePredType
+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)
----------------
-toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
-toIfaceContext ext cs = map (toIfacePred ext) cs
+toIfaceContext :: ThetaType -> IfaceContext
+toIfaceContext cs = map toIfacePred cs
\end{code}