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 data IfaceTyCon         -- Abbreviations for common tycons with known names
  72   = IfaceTc Name        -- The common case
  73   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
  74   | IfaceListTc | IfacePArrTc
  75   | IfaceTupTc Boxity Arity
  76   | IfaceAnyTc IfaceKind    -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
  77   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
  78   | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
  79
  80 ifaceTyConName :: IfaceTyCon -> Name
  81 ifaceTyConName IfaceIntTc              = intTyConName
  82 ifaceTyConName IfaceBoolTc             = boolTyConName
  83 ifaceTyConName IfaceCharTc             = charTyConName
  84 ifaceTyConName IfaceListTc             = listTyConName
  85 ifaceTyConName IfacePArrTc             = parrTyConName
  86 ifaceTyConName (IfaceTupTc bx ar)      = getName (tupleTyCon bx ar)
  87 ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
  88 ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
  89 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
  90 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
  91 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
  92 ifaceTyConName (IfaceTc ext)           = ext
  93 ifaceTyConName (IfaceAnyTc kind)       = pprPanic "ifaceTyConName" (ppr (IfaceAnyTc kind))
  94                                          -- Note [The Name of an IfaceAnyTc]
  95 \end{code}
  96
  97 Note [The Name of an IfaceAnyTc]
  98 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  99 It isn't easy to get the Name of an IfaceAnyTc in a pure way.  What you
 100 really need to do is to transform it to a TyCon, and get the Name of that.
 101 But doing so needs the monad.
 102
 103 In fact, ifaceTyConName is only used for instances and rules, and we don't
 104 expect to instantiate those at these (internal-ish) Any types, so rather
 105 than solve this potential problem now, I'm going to defer it until it happens!
 106
 107 %************************************************************************
 108 %*                                                                      *
 109                 Functions over IFaceTypes
 110 %*                                                                      *
 111 %************************************************************************
 112
 113
 114 \begin{code}
 115 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
 116 -- Mainly for printing purposes
 117 splitIfaceSigmaTy ty
 118   = (tvs,theta,tau)
 119   where
 120     (tvs, rho)   = split_foralls ty
 121     (theta, tau) = split_rho rho
 122
 123     split_foralls (IfaceForAllTy tv ty)
 124         = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
 125     split_foralls rho = ([], rho)
 126
 127     split_rho (IfaceFunTy (IfacePredTy st) ty)
 128         = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
 129     split_rho tau = ([], tau)
 130 \end{code}
 131
 132 %************************************************************************
 133 %*                                                                      *
 134                 Pretty-printing
 135 %*                                                                      *
 136 %************************************************************************
 137
 138 Precedence
 139 ~~~~~~~~~~
 140 @ppr_ty@ takes an @Int@ that is the precedence of the context.
 141 The precedence levels are:
 142 \begin{description}
 143 \item[tOP_PREC]   No parens required.
 144 \item[fUN_PREC]   Left hand argument of a function arrow.
 145 \item[tYCON_PREC] Argument of a type constructor.
 146 \end{description}
 147
 148 \begin{code}
 149 tOP_PREC, fUN_PREC, tYCON_PREC :: Int
 150 tOP_PREC    = 0 -- type   in ParseIface.y
 151 fUN_PREC    = 1 -- btype  in ParseIface.y
 152 tYCON_PREC  = 2 -- atype  in ParseIface.y
 153
 154 noParens :: SDoc -> SDoc
 155 noParens pp = pp
 156
 157 maybeParen :: Int -> Int -> SDoc -> SDoc
 158 maybeParen ctxt_prec inner_prec pretty
 159   | ctxt_prec < inner_prec = pretty
 160   | otherwise              = parens pretty
 161 \end{code}
 162
 163
 164 ----------------------------- Printing binders ------------------------------------
 165
 166 \begin{code}
 167 instance Outputable IfaceBndr where
 168     ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
 169     ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
 170
 171 pprIfaceBndrs :: [IfaceBndr] -> SDoc
 172 pprIfaceBndrs bs = sep (map ppr bs)
 173
 174 pprIfaceIdBndr :: (FastString, IfaceType) -> SDoc
 175 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 176
 177 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
 178 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
 179   = ppr tv
 180 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
 181 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 182 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
 183 \end{code}
 184
 185 ----------------------------- Printing IfaceType ------------------------------------
 186
 187 \begin{code}
 188 ---------------------------------
 189 instance Outputable IfaceType where
 190   ppr ty = pprIfaceType ty
 191
 192 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
 193 pprIfaceType       = ppr_ty tOP_PREC
 194 pprParendIfaceType = ppr_ty tYCON_PREC
 195
 196
 197 ppr_ty :: Int -> IfaceType -> SDoc
 198 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
 199 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
 200 ppr_ty _         (IfacePredTy st)       = ppr st
 201
 202         -- Function types
 203 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
 204   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
 205     maybeParen ctxt_prec fUN_PREC $
 206     sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
 207   where
 208     ppr_fun_tail (IfaceFunTy ty1 ty2)
 209       = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
 210     ppr_fun_tail other_ty
 211       = [arrow <+> pprIfaceType other_ty]
 212
 213 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
 214   = maybeParen ctxt_prec tYCON_PREC $
 215     ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
 216
 217 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
 218   = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
 219  where
 220     (tvs, theta, tau) = splitIfaceSigmaTy ty
 221
 222 -------------------
 223 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
 224 pprIfaceForAllPart tvs ctxt doc
 225   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
 226   where
 227     ppr_tvs | null tvs  = empty
 228             | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
 229
 230 -------------------
 231 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
 232 ppr_tc_app _         tc          []   = ppr_tc tc
 233 ppr_tc_app _         IfaceListTc [ty] = brackets   (pprIfaceType ty)
 234 ppr_tc_app _         IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
 235 ppr_tc_app _         (IfaceTupTc bx arity) tys
 236   | arity == length tys
 237   = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
 238 ppr_tc_app ctxt_prec tc tys
 239   = maybeParen ctxt_prec tYCON_PREC
 240                (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
 241
 242 ppr_tc :: IfaceTyCon -> SDoc
 243 -- Wrap infix type constructors in parens
 244 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
 245 ppr_tc tc                  = ppr tc
 246
 247 -------------------
 248 instance Outputable IfacePredType where
 249         -- Print without parens
 250   ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit "~"), ppr ty2]
 251   ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
 252   ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
 253                              <+> sep (map pprParendIfaceType ts)
 254
 255 instance Outputable IfaceTyCon where
 256   ppr (IfaceTc ext) = ppr ext
 257   ppr other_tc      = ppr (ifaceTyConName other_tc)
 258
 259 -------------------
 260 pprIfaceContext :: IfaceContext -> SDoc
 261 -- Prints "(C a, D b) =>", including the arrow
 262 pprIfaceContext []     = empty
 263 pprIfaceContext theta = ppr_preds theta <+> ptext (sLit "=>")
 264
 265 ppr_preds :: [IfacePredType] -> SDoc
 266 ppr_preds [pred] = ppr pred     -- No parens
 267 ppr_preds preds  = parens (sep (punctuate comma (map ppr preds)))
 268
 269 -------------------
 270 pabrackets :: SDoc -> SDoc
 271 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
 272 \end{code}
 273
 274 %************************************************************************
 275 %*                                                                      *
 276         Conversion from Type to IfaceType
 277 %*                                                                      *
 278 %************************************************************************
 279
 280 \begin{code}
 281 ----------------
 282 toIfaceTvBndr :: TyVar -> (FastString, IfaceType)
 283 toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
 284 toIfaceIdBndr :: Id -> (FastString, IfaceType)
 285 toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
 286 toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)]
 287 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 288
 289 toIfaceBndr :: Var -> IfaceBndr
 290 toIfaceBndr var
 291   | isId var  = IfaceIdBndr (toIfaceIdBndr var)
 292   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 293
 294 toIfaceKind :: Type -> IfaceType
 295 toIfaceKind = toIfaceType
 296
 297 ---------------------
 298 toIfaceType :: Type -> IfaceType
 299 -- Synonyms are retained in the interface type
 300 toIfaceType (TyVarTy tv) =
 301   IfaceTyVar (occNameFS (getOccName tv))
 302 toIfaceType (AppTy t1 t2) =
 303   IfaceAppTy (toIfaceType t1) (toIfaceType t2)
 304 toIfaceType (FunTy t1 t2) =
 305   IfaceFunTy (toIfaceType t1) (toIfaceType t2)
 306 toIfaceType (TyConApp tc tys) =
 307   IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
 308 toIfaceType (ForAllTy tv t) =
 309   IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 310 toIfaceType (PredTy st) =
 311   IfacePredTy (toIfacePred st)
 312
 313 ----------------
 314 -- A little bit of (perhaps optional) trickiness here.  When
 315 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
 316 -- they have a wired-in name.  But we'd like to dump them into the Iface
 317 -- as a tuple tycon, to save lookups when reading the interface
 318 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
 319 -- toIfaceTyCon_name will still catch it.
 320
 321 toIfaceTyCon :: TyCon -> IfaceTyCon
 322 toIfaceTyCon tc
 323   | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
 324   | isAnyTyCon tc   = IfaceAnyTc (toIfaceKind (tyConKind tc))
 325   | otherwise       = toIfaceTyCon_name (tyConName tc)
 326
 327 toIfaceTyCon_name :: Name -> IfaceTyCon
 328 toIfaceTyCon_name nm
 329   | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
 330   = toIfaceWiredInTyCon tc nm
 331   | otherwise
 332   = IfaceTc nm
 333
 334 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 335 toIfaceWiredInTyCon tc nm
 336   | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConBoxity tc) (tyConArity tc)
 337   | isAnyTyCon tc                   = IfaceAnyTc (toIfaceKind (tyConKind tc))
 338   | nm == intTyConName              = IfaceIntTc
 339   | nm == boolTyConName             = IfaceBoolTc
 340   | nm == charTyConName             = IfaceCharTc
 341   | nm == listTyConName             = IfaceListTc
 342   | nm == parrTyConName             = IfacePArrTc
 343   | nm == liftedTypeKindTyConName   = IfaceLiftedTypeKindTc
 344   | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
 345   | nm == openTypeKindTyConName     = IfaceOpenTypeKindTc
 346   | nm == argTypeKindTyConName      = IfaceArgTypeKindTc
 347   | nm == ubxTupleKindTyConName     = IfaceUbxTupleKindTc
 348   | otherwise                       = IfaceTc nm
 349
 350 ----------------
 351 toIfaceTypes :: [Type] -> [IfaceType]
 352 toIfaceTypes ts = map toIfaceType ts
 353
 354 ----------------
 355 toIfacePred :: PredType -> IfacePredType
 356 toIfacePred (ClassP cls ts) =
 357   IfaceClassP (getName cls) (toIfaceTypes ts)
 358 toIfacePred (IParam ip t) =
 359   IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
 360 toIfacePred (EqPred ty1 ty2) =
 361   IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
 362
 363 ----------------
 364 toIfaceContext :: ThetaType -> IfaceContext
 365 toIfaceContext cs = map toIfacePred cs
 366 \end{code}
 367