IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
- IfaceExtName(..), mkIfaceExtName, ifaceTyConName,
+ IfaceExtName(..), mkIfaceExtName, isLocalIfaceExtName,
+ ifaceTyConName, interactiveExtNameFun,
-- Conversion from Type -> IfaceType
toIfaceType, toIfacePred, toIfaceContext,
#include "HsVersions.h"
import Kind ( Kind(..) )
-import TypeRep ( Type(..), TyNote(..), PredType(..), Kind, ThetaType )
+import TypeRep ( Type(..), TyNote(..), PredType(..), ThetaType )
import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
import Var ( isId, tyVarKind, idType )
import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
-import OccName ( OccName )
-import Name ( Name, getName, getOccName, nameModuleName, nameOccName )
-import Module ( ModuleName )
+import OccName ( OccName, parenSymOcc )
+import Name ( Name, getName, getOccName, nameModule, nameOccName )
+import Module ( Module )
import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
import Outputable
import FastString
\begin{code}
data IfaceExtName
- = ExtPkg ModuleName OccName -- From an external package; no version #
+ = 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 #
+ | HomePkg Module OccName Version -- From another module in home package;
+ -- has version #; in all other respects,
+ -- HomePkg and ExtPkg are the same
| LocalTop OccName -- Top-level from the same module as
-- the enclosing IfaceDecl
-- LocalTopSub is written into iface files as LocalTop; the parent
-- info is only used when computing version information in MkIface
-mkIfaceExtName name = ExtPkg (nameModuleName name) (nameOccName name)
+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
+
+interactiveExtNameFun :: PrintUnqualified -> Name-> IfaceExtName
+interactiveExtNameFun print_unqual name
+ | print_unqual mod occ = LocalTop occ
+ | otherwise = ExtPkg mod occ
+ where
+ mod = nameModule name
+ occ = nameOccName name
\end{code}
ppr (LocalTop occ) = ppr occ -- Do we want to distinguish these
ppr (LocalTopSub occ _) = ppr occ -- from an ordinary occurrence?
-pprExt :: ModuleName -> OccName -> SDoc
-pprExt mod occ
- = getPprStyle $ \ sty ->
- if unqualStyle sty mod occ then
- ppr occ
- else
- ppr mod <> dot <> ppr occ
+pprExt :: Module -> OccName -> SDoc
+-- No need to worry about printing unqualified becuase that was handled
+-- in the transiation to IfaceSyn
+pprExt mod occ = ppr mod <> dot <> ppr occ
instance Outputable IfaceBndr where
ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
| otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
-------------------
-ppr_tc_app ctxt_prec tc [] = ppr tc
+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
= tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
ppr_tc_app ctxt_prec tc tys
= maybeParen ctxt_prec tYCON_PREC
- (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
+ (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType 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 = ppr tc
-------------------
instance Outputable IfacePredType where
-- Print without parens
ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
- ppr (IfaceClassP cls ts) = ppr cls <+> sep (map pprParendIfaceType ts)
+ ppr (IfaceClassP cls ts) = parenSymOcc (ifaceExtOcc cls) (ppr cls)
+ <+> sep (map pprParendIfaceType ts)
instance Outputable IfaceTyCon where
ppr (IfaceTc ext) = ppr ext
toIfaceType ext (TyVarTy tv) = IfaceTyVar (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 (NewTcApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
toIfaceType ext (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
toIfaceType ext (PredTy st) = IfacePredTy (toIfacePred ext st)