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