compiler/iface/IfaceType.lhs

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