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