-- Conversion from Type -> IfaceType
toIfaceType, toIfacePred, toIfaceContext,
toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
+ toIfaceTyCon, toIfaceTyCon_name,
-- Printing
pprIfaceType, pprParendIfaceType, pprIfaceContext,
#include "HsVersions.h"
import Kind ( Kind(..) )
-import TypeRep ( Type(..), TyNote(..), PredType(..), ThetaType )
-import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
+import TypeRep ( TyThing(..), Type(..), PredType(..), ThetaType )
+import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
import Var ( isId, tyVarKind, idType )
import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
import OccName ( OccName, parenSymOcc )
-import Name ( Name, getName, getOccName, nameModule, nameOccName )
+import Name ( Name, getName, getOccName, nameModule, nameOccName,
+ wiredInNameTyThing_maybe )
import Module ( Module )
import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
import Outputable
-------------------
pprIfaceContext :: IfaceContext -> SDoc
-- Prints "(C a, D b) =>", including the arrow
-pprIfaceContext [] = empty
-pprIfaceContext theta = parens (sep (punctuate comma (map ppr theta)))
- <+> ptext SLIT("=>")
-
+pprIfaceContext [] = empty
+pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
+
+ppr_preds [pred] = ppr pred -- No parens
+ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
+
+-------------------
pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
\end{code}
---------------------
toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
+-- Synonyms are retained in the interface type
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 (TyConApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
+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 (SynNote tc_app) ty) = toIfaceType ext tc_app -- Retain synonyms
toIfaceType ext (NoteTy other_note ty) = toIfaceType ext ty
----------------
-mkIfaceTc :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
-mkIfaceTc ext tc
+-- A little bit of (perhaps optional) trickiness here. When
+-- compiling Data.Tuple, the tycons are not TupleTyCons, although
+-- they have a wired-in name. But we'd like to dump them into the Iface
+-- as a tuple tycon, to save lookups when reading the interface
+-- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
+-- toIfaceTyCon_name will still catch it.
+
+toIfaceTyCon :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
+toIfaceTyCon ext tc
+ | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+ | otherwise = toIfaceTyCon_name ext (tyConName tc)
+
+toIfaceTyCon_name :: (Name -> IfaceExtName) -> Name -> IfaceTyCon
+toIfaceTyCon_name ext nm
+ | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
+ = toIfaceWiredInTyCon ext tc nm
+ | otherwise
+ = IfaceTc (ext nm)
+
+toIfaceWiredInTyCon :: (Name -> IfaceExtName) -> TyCon -> Name -> IfaceTyCon
+toIfaceWiredInTyCon ext tc nm
| isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
| nm == intTyConName = IfaceIntTc
| nm == boolTyConName = IfaceBoolTc
| nm == listTyConName = IfaceListTc
| nm == parrTyConName = IfacePArrTc
| otherwise = IfaceTc (ext nm)
- where
- nm = getName tc
----------------
toIfaceTypes ext ts = map (toIfaceType ext) ts