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