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