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