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