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