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