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