compiler/iface/IfaceType.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   4 %
   5
   6 This module defines interface types and binders
   7
   8 \begin{code}
   9 module IfaceType (
  10         IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
  11         IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
  12         ifaceTyConName,
  13
  14         -- Conversion from Type -> IfaceType
  15         toIfaceType, toIfacePred, toIfaceContext,
  16         toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
  17         toIfaceTyCon, toIfaceTyCon_name,
  18
  19         -- Printing
  20         pprIfaceType, pprParendIfaceType, pprIfaceContext,
  21         pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
  22         tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
  23
  24     ) where
  25
  26 import TypeRep
  27 import TyCon
  28 import Id
  29 import Var
  30 import TysWiredIn
  31 import Name
  32 import BasicTypes
  33 import Outputable
  34 import FastString
  35 \end{code}
  36
  37 %************************************************************************
  38 %*                                                                      *
  39                 Local (nested) binders
  40 %*                                                                      *
  41 %************************************************************************
  42
  43 \begin{code}
  44 data IfaceBndr          -- Local (non-top-level) binders
  45   = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  46   | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
  47
  48 type IfaceIdBndr  = (FastString, IfaceType)
  49 type IfaceTvBndr  = (FastString, IfaceKind)
  50
  51 -------------------------------
  52 type IfaceKind     = IfaceType
  53 type IfaceCoercion = IfaceType
  54
  55 data IfaceType
  56   = IfaceTyVar    FastString                    -- Type variable only, not tycon
  57   | IfaceAppTy    IfaceType IfaceType
  58   | IfaceForAllTy IfaceTvBndr IfaceType
  59   | IfacePredTy   IfacePredType
  60   | IfaceTyConApp IfaceTyCon [IfaceType]        -- Not necessarily saturated
  61                                                 -- Includes newtypes, synonyms, tuples
  62   | IfaceFunTy  IfaceType IfaceType
  63
  64 data IfacePredType      -- NewTypes are handled as ordinary TyConApps
  65   = IfaceClassP Name [IfaceType]
  66   | IfaceIParam (IPName OccName) IfaceType
  67   | IfaceEqPred IfaceType IfaceType
  68
  69 type IfaceContext = [IfacePredType]
  70
  71 -- NB: If you add a data constructor, remember to add a case to
  72 --     IfaceSyn.eqIfTc!
  73 data IfaceTyCon         -- Abbreviations for common tycons with known names
  74   = IfaceTc Name        -- The common case
  75   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
  76   | IfaceListTc | IfacePArrTc
  77   | IfaceTupTc Boxity Arity
  78   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
  79   | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
  80   deriving( Eq )
  81
  82 ifaceTyConName :: IfaceTyCon -> Name
  83 ifaceTyConName IfaceIntTc         = intTyConName
  84 ifaceTyConName IfaceBoolTc        = boolTyConName
  85 ifaceTyConName IfaceCharTc        = charTyConName
  86 ifaceTyConName IfaceListTc        = listTyConName
  87 ifaceTyConName IfacePArrTc        = parrTyConName
  88 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
  89 ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
  90 ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
  91 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
  92 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
  93 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
  94 ifaceTyConName (IfaceTc ext)      = ext
  95 \end{code}
  96
  97
  98 %************************************************************************
  99 %*                                                                      *
 100                 Functions over IFaceTypes
 101 %*                                                                      *
 102 %************************************************************************
 103
 104
 105 \begin{code}
 106 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
 107 -- Mainly for printing purposes
 108 splitIfaceSigmaTy ty
 109   = (tvs,theta,tau)
 110   where
 111     (tvs, rho)   = split_foralls ty
 112     (theta, tau) = split_rho rho
 113
 114     split_foralls (IfaceForAllTy tv ty)
 115         = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
 116     split_foralls rho = ([], rho)
 117
 118     split_rho (IfaceFunTy (IfacePredTy st) ty)
 119         = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
 120     split_rho tau = ([], tau)
 121 \end{code}
 122
 123 %************************************************************************
 124 %*                                                                      *
 125                 Pretty-printing
 126 %*                                                                      *
 127 %************************************************************************
 128
 129 Precedence
 130 ~~~~~~~~~~
 131 @ppr_ty@ takes an @Int@ that is the precedence of the context.
 132 The precedence levels are:
 133 \begin{description}
 134 \item[tOP_PREC]   No parens required.
 135 \item[fUN_PREC]   Left hand argument of a function arrow.
 136 \item[tYCON_PREC] Argument of a type constructor.
 137 \end{description}
 138
 139 \begin{code}
 140 tOP_PREC, fUN_PREC, tYCON_PREC :: Int
 141 tOP_PREC    = 0 -- type   in ParseIface.y
 142 fUN_PREC    = 1 -- btype  in ParseIface.y
 143 tYCON_PREC  = 2 -- atype  in ParseIface.y
 144
 145 noParens :: SDoc -> SDoc
 146 noParens pp = pp
 147
 148 maybeParen :: Int -> Int -> SDoc -> SDoc
 149 maybeParen ctxt_prec inner_prec pretty
 150   | ctxt_prec < inner_prec = pretty
 151   | otherwise              = parens pretty
 152 \end{code}
 153
 154
 155 ----------------------------- Printing binders ------------------------------------
 156
 157 \begin{code}
 158 instance Outputable IfaceBndr where
 159     ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
 160     ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
 161
 162 pprIfaceBndrs :: [IfaceBndr] -> SDoc
 163 pprIfaceBndrs bs = sep (map ppr bs)
 164
 165 pprIfaceIdBndr :: (FastString, IfaceType) -> SDoc
 166 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 167
 168 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
 169 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
 170   = ppr tv
 171 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
 172 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 173 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
 174 \end{code}
 175
 176 ----------------------------- Printing IfaceType ------------------------------------
 177
 178 \begin{code}
 179 ---------------------------------
 180 instance Outputable IfaceType where
 181   ppr ty = pprIfaceType ty
 182
 183 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
 184 pprIfaceType       = ppr_ty tOP_PREC
 185 pprParendIfaceType = ppr_ty tYCON_PREC
 186
 187
 188 ppr_ty :: Int -> IfaceType -> SDoc
 189 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
 190 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
 191 ppr_ty _         (IfacePredTy st)       = ppr st
 192
 193         -- Function types
 194 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
 195   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
 196     maybeParen ctxt_prec fUN_PREC $
 197     sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
 198   where
 199     ppr_fun_tail (IfaceFunTy ty1 ty2)
 200       = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
 201     ppr_fun_tail other_ty
 202       = [arrow <+> pprIfaceType other_ty]
 203
 204 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
 205   = maybeParen ctxt_prec tYCON_PREC $
 206     ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
 207
 208 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
 209   = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
 210  where
 211     (tvs, theta, tau) = splitIfaceSigmaTy ty
 212
 213 -------------------
 214 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
 215 pprIfaceForAllPart tvs ctxt doc
 216   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
 217   where
 218     ppr_tvs | null tvs  = empty
 219             | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
 220
 221 -------------------
 222 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
 223 ppr_tc_app _         tc          []   = ppr_tc tc
 224 ppr_tc_app _         IfaceListTc [ty] = brackets   (pprIfaceType ty)
 225 ppr_tc_app _         IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
 226 ppr_tc_app _         (IfaceTupTc bx arity) tys
 227   | arity == length tys
 228   = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
 229 ppr_tc_app ctxt_prec tc tys
 230   = maybeParen ctxt_prec tYCON_PREC
 231                (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
 232
 233 ppr_tc :: IfaceTyCon -> SDoc
 234 -- Wrap infix type constructors in parens
 235 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
 236 ppr_tc tc                  = ppr tc
 237
 238 -------------------
 239 instance Outputable IfacePredType where
 240         -- Print without parens
 241   ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit "~"), ppr ty2]
 242   ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
 243   ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
 244                              <+> sep (map pprParendIfaceType ts)
 245
 246 instance Outputable IfaceTyCon where
 247   ppr (IfaceTc ext) = ppr ext
 248   ppr other_tc      = ppr (ifaceTyConName other_tc)
 249
 250 -------------------
 251 pprIfaceContext :: IfaceContext -> SDoc
 252 -- Prints "(C a, D b) =>", including the arrow
 253 pprIfaceContext []     = empty
 254 pprIfaceContext theta = ppr_preds theta <+> ptext (sLit "=>")
 255
 256 ppr_preds :: [IfacePredType] -> SDoc
 257 ppr_preds [pred] = ppr pred     -- No parens
 258 ppr_preds preds  = parens (sep (punctuate comma (map ppr preds)))
 259
 260 -------------------
 261 pabrackets :: SDoc -> SDoc
 262 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
 263 \end{code}
 264
 265 %************************************************************************
 266 %*                                                                      *
 267         Conversion from Type to IfaceType
 268 %*                                                                      *
 269 %************************************************************************
 270
 271 \begin{code}
 272 ----------------
 273 toIfaceTvBndr :: TyVar -> (FastString, IfaceType)
 274 toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
 275 toIfaceIdBndr :: Id -> (FastString, IfaceType)
 276 toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
 277 toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)]
 278 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 279
 280 toIfaceBndr :: Var -> IfaceBndr
 281 toIfaceBndr var
 282   | isId var  = IfaceIdBndr (toIfaceIdBndr var)
 283   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 284
 285 toIfaceKind :: Type -> IfaceType
 286 toIfaceKind = toIfaceType
 287
 288 ---------------------
 289 toIfaceType :: Type -> IfaceType
 290 -- Synonyms are retained in the interface type
 291 toIfaceType (TyVarTy tv) =
 292   IfaceTyVar (occNameFS (getOccName tv))
 293 toIfaceType (AppTy t1 t2) =
 294   IfaceAppTy (toIfaceType t1) (toIfaceType t2)
 295 toIfaceType (FunTy t1 t2) =
 296   IfaceFunTy (toIfaceType t1) (toIfaceType t2)
 297 toIfaceType (TyConApp tc tys) =
 298   IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
 299 toIfaceType (ForAllTy tv t) =
 300   IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 301 toIfaceType (PredTy st) =
 302   IfacePredTy (toIfacePred st)
 303
 304 ----------------
 305 -- A little bit of (perhaps optional) trickiness here.  When
 306 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
 307 -- they have a wired-in name.  But we'd like to dump them into the Iface
 308 -- as a tuple tycon, to save lookups when reading the interface
 309 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
 310 -- toIfaceTyCon_name will still catch it.
 311
 312 toIfaceTyCon :: TyCon -> IfaceTyCon
 313 toIfaceTyCon tc
 314   | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
 315   | otherwise       = toIfaceTyCon_name (tyConName tc)
 316
 317 toIfaceTyCon_name :: Name -> IfaceTyCon
 318 toIfaceTyCon_name nm
 319   | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
 320   = toIfaceWiredInTyCon tc nm
 321   | otherwise
 322   = IfaceTc nm
 323
 324 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 325 toIfaceWiredInTyCon tc nm
 326   | isTupleTyCon tc                 =  IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
 327   | nm == intTyConName              = IfaceIntTc
 328   | nm == boolTyConName             = IfaceBoolTc
 329   | nm == charTyConName             = IfaceCharTc
 330   | nm == listTyConName             = IfaceListTc
 331   | nm == parrTyConName             = IfacePArrTc
 332   | nm == liftedTypeKindTyConName   = IfaceLiftedTypeKindTc
 333   | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
 334   | nm == openTypeKindTyConName     = IfaceOpenTypeKindTc
 335   | nm == argTypeKindTyConName      = IfaceArgTypeKindTc
 336   | nm == ubxTupleKindTyConName     = IfaceUbxTupleKindTc
 337   | otherwise                       = IfaceTc nm
 338
 339 ----------------
 340 toIfaceTypes :: [Type] -> [IfaceType]
 341 toIfaceTypes ts = map toIfaceType ts
 342
 343 ----------------
 344 toIfacePred :: PredType -> IfacePredType
 345 toIfacePred (ClassP cls ts) =
 346   IfaceClassP (getName cls) (toIfaceTypes ts)
 347 toIfacePred (IParam ip t) =
 348   IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
 349 toIfacePred (EqPred ty1 ty2) =
 350   IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
 351
 352 ----------------
 353 toIfaceContext :: ThetaType -> IfaceContext
 354 toIfaceContext cs = map toIfacePred cs
 355 \end{code}
 356