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