ghc/compiler/iface/IfaceType.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5         This module defines intereace 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,
  13
  14         -- Conversion from Type -> IfaceType
  15         toIfaceType, toIfaceKind, toIfacePred, toIfaceContext,
  16         toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
  17
  18         -- Printing
  19         pprIfaceKind, pprParendIfaceKind,
  20         pprIfaceType, pprParendIfaceType, pprIfaceContext,
  21         pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
  22         getIfaceExt,
  23         tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
  24
  25     ) where
  26
  27 #include "HsVersions.h"
  28
  29 import Type             ( openTypeKind, liftedTypeKind, unliftedTypeKind,
  30                           splitFunTy_maybe, eqKind, pprType )
  31 import TypeRep          ( Type(..), TyNote(..), PredType(..), Kind, ThetaType )
  32 import TyCon            ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
  33 import Var              ( isId, tyVarKind, idType )
  34 import TysWiredIn       ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
  35 import OccName          ( OccName )
  36 import Name             ( Name, getName, getOccName, nameModuleName, nameOccName, isInternalName )
  37 import 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 ModuleName OccName           -- From an external package; no version #
  53                                         -- Also used for wired-in things regardless
  54                                         -- of whether they are home-pkg or not
  55
  56   | HomePkg ModuleName OccName Version  -- From another module in home package;
  57                                         -- has version #
  58
  59   | LocalTop OccName                    -- Top-level from the same module as
  60                                         -- the enclosing IfaceDecl
  61
  62   | LocalTopSub         -- Same as LocalTop, but for a class method or constr
  63         OccName         -- Class-meth/constr name
  64         OccName         -- Parent class/datatype name
  65         -- LocalTopSub is written into iface files as LocalTop; the parent
  66         -- info is only used when computing version information in MkIface
  67
  68 mkIfaceExtName name = ExtPkg (nameModuleName name) (nameOccName name)
  69         -- Local helper for wired-in names
  70 \end{code}
  71
  72
  73 %************************************************************************
  74 %*                                                                      *
  75                 Local (nested) binders
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 \begin{code}
  80 data IfaceBndr          -- Local (non-top-level) binders
  81   = IfaceIdBndr IfaceIdBndr
  82   | IfaceTvBndr IfaceTvBndr
  83
  84 type IfaceIdBndr  = (OccName, IfaceType)        -- OccName, because always local
  85 type IfaceTvBndr  = (OccName, IfaceKind)
  86
  87 -------------------------------
  88 data IfaceKind
  89   = IfaceLiftedTypeKind
  90   | IfaceOpenTypeKind
  91   | IfaceUnliftedTypeKind
  92   | IfaceFunKind IfaceKind IfaceKind
  93   deriving( Eq )
  94
  95 -------------------------------
  96 data IfaceType
  97   = IfaceTyVar    OccName               -- Type variable only, not tycon
  98   | IfaceAppTy    IfaceType IfaceType
  99   | IfaceForAllTy IfaceTvBndr IfaceType
 100   | IfacePredTy IfacePredType
 101   | IfaceTyConApp IfaceTyCon [IfaceType]        -- Not necessarily saturated
 102                                                 -- Includes newtypes, synonyms, tuples
 103   | IfaceFunTy  IfaceType IfaceType
 104
 105 data IfacePredType      -- NewTypes are handled as ordinary TyConApps
 106   = IfaceClassP IfaceExtName [IfaceType]
 107   | IfaceIParam (IPName OccName) IfaceType
 108
 109 type IfaceContext = [IfacePredType]
 110
 111 data IfaceTyCon         -- Abbreviations for common tycons with known names
 112   = IfaceTc IfaceExtName        -- The common case
 113   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
 114   | IfaceListTc | IfacePArrTc
 115   | IfaceTupTc Boxity Arity
 116
 117 ifaceTyConName :: IfaceTyCon -> Name    -- Works for all except IfaceTc
 118 ifaceTyConName IfaceIntTc         = intTyConName
 119 ifaceTyConName IfaceBoolTc        = boolTyConName
 120 ifaceTyConName IfaceCharTc        = charTyConName
 121 ifaceTyConName IfaceListTc        = listTyConName
 122 ifaceTyConName IfacePArrTc        = parrTyConName
 123 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
 124 ifaceTyConName (IfaceTc ext)      = pprPanic "ifaceTyConName" (ppr ext)
 125 \end{code}
 126
 127
 128 %************************************************************************
 129 %*                                                                      *
 130                 Functions over IFaceTypes
 131 %*                                                                      *
 132 %************************************************************************
 133
 134
 135 \begin{code}
 136 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
 137 -- Mainly for printing purposes
 138 splitIfaceSigmaTy ty
 139   = (tvs,theta,tau)
 140   where
 141     (tvs, rho)   = split_foralls ty
 142     (theta, tau) = split_rho rho
 143
 144     split_foralls (IfaceForAllTy tv ty)
 145         = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
 146     split_foralls rho = ([], rho)
 147
 148     split_rho (IfaceFunTy (IfacePredTy st) ty)
 149         = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
 150     split_rho tau = ([], tau)
 151 \end{code}
 152
 153 %************************************************************************
 154 %*                                                                      *
 155                 Pretty-printing
 156 %*                                                                      *
 157 %************************************************************************
 158
 159 Precedence
 160 ~~~~~~~~~~
 161 @ppr_ty@ takes an @Int@ that is the precedence of the context.
 162 The precedence levels are:
 163 \begin{description}
 164 \item[tOP_PREC]   No parens required.
 165 \item[fUN_PREC]   Left hand argument of a function arrow.
 166 \item[tYCON_PREC] Argument of a type constructor.
 167 \end{description}
 168
 169 \begin{code}
 170 tOP_PREC    = (0 :: Int)  -- type   in ParseIface.y
 171 fUN_PREC    = (1 :: Int)  -- btype  in ParseIface.y
 172 tYCON_PREC  = (2 :: Int)  -- atype  in ParseIface.y
 173
 174 noParens :: SDoc -> SDoc
 175 noParens pp = pp
 176
 177 maybeParen ctxt_prec inner_prec pretty
 178   | ctxt_prec < inner_prec = pretty
 179   | otherwise              = parens pretty
 180 \end{code}
 181
 182
 183 ----------------------------- Printing binders ------------------------------------
 184
 185 \begin{code}
 186 instance Outputable IfaceExtName where
 187     ppr (ExtPkg mod occ)       = ppr mod <> dot <> ppr occ
 188     ppr (HomePkg mod occ vers) = ppr mod <> dot <> ppr occ <> braces (ppr vers)
 189     ppr (LocalTop occ)         = ppr occ        -- Do we want to distinguish these
 190     ppr (LocalTopSub occ _)    = ppr occ        -- from an ordinary occurrence?
 191
 192 getIfaceExt :: ((Name -> IfaceExtName) -> SDoc) -> SDoc
 193 -- Uses the print-unqual info from the SDoc to make an 'ext'
 194 -- which in turn tells toIfaceType when to make a qualified name
 195 -- This is only used when making Iface stuff to print out for the user;
 196 -- e.g. we use this in pprType
 197 getIfaceExt thing_inside
 198   = getPprStyle         $ \ sty ->
 199     let
 200         ext nm | unqualStyle sty nm = LocalTop (nameOccName nm)
 201                | isInternalName nm  = LocalTop (nameOccName nm)
 202                         -- This only happens for Kind constructors, which
 203                         -- don't come from any particular module and are unqualified
 204                         -- This hack will go away when kinds are separated from types
 205                | otherwise          = ExtPkg (nameModuleName nm) (nameOccName nm)
 206     in
 207     thing_inside ext
 208
 209 instance Outputable IfaceBndr where
 210     ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
 211     ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
 212
 213 pprIfaceBndrs :: [IfaceBndr] -> SDoc
 214 pprIfaceBndrs bs = sep (map ppr bs)
 215
 216 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 217
 218 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
 219 pprIfaceTvBndr (tv, IfaceLiftedTypeKind) = ppr tv
 220 pprIfaceTvBndr (tv, kind)                = parens (ppr tv <> dcolon <> ppr kind)
 221
 222 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 223 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
 224 \end{code}
 225
 226 ----------------------------- Printing IfaceType ------------------------------------
 227
 228 \begin{code}
 229 ---------------------------------
 230 instance Outputable IfaceKind where
 231   ppr k = pprIfaceKind tOP_PREC k
 232
 233 pprParendIfaceKind :: IfaceKind -> SDoc
 234 pprParendIfaceKind k = pprIfaceKind tYCON_PREC k
 235
 236 pprIfaceKind prec IfaceLiftedTypeKind   = ptext SLIT("*")
 237 pprIfaceKind prec IfaceUnliftedTypeKind = ptext SLIT("#")
 238 pprIfaceKind prec IfaceOpenTypeKind     = ptext SLIT("?")
 239 pprIfaceKind prec (IfaceFunKind k1 k2)  = maybeParen prec fUN_PREC $
 240                                           sep [ pprIfaceKind fUN_PREC k1, arrow <+> ppr k2]
 241
 242 ---------------------------------
 243 instance Outputable IfaceType where
 244   ppr ty = ppr_ty ty
 245
 246 ppr_ty             = pprIfaceType tOP_PREC
 247 pprParendIfaceType = pprIfaceType tYCON_PREC
 248
 249 pprIfaceType :: Int -> IfaceType -> SDoc
 250
 251
 252         -- Simple cases
 253 pprIfaceType ctxt_prec (IfaceTyVar tyvar)     = ppr tyvar
 254 pprIfaceType ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
 255 pprIfaceType ctxt_prec (IfacePredTy st)       = braces (ppr st)
 256
 257         -- Function types
 258 pprIfaceType ctxt_prec (IfaceFunTy ty1 ty2)
 259   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
 260     maybeParen ctxt_prec fUN_PREC $
 261     sep (pprIfaceType fUN_PREC ty1 : ppr_fun_tail ty2)
 262   where
 263     ppr_fun_tail (IfaceFunTy ty1 ty2)
 264       = (arrow <+> pprIfaceType fUN_PREC ty1) : ppr_fun_tail ty2
 265     ppr_fun_tail other_ty
 266       = [arrow <+> ppr_ty other_ty]
 267
 268 pprIfaceType ctxt_prec (IfaceAppTy ty1 ty2)
 269   = maybeParen ctxt_prec tYCON_PREC $
 270     pprIfaceType fUN_PREC ty1 <+> pprParendIfaceType ty2
 271
 272 pprIfaceType ctxt_prec ty@(IfaceForAllTy _ _)
 273   = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (ppr_ty tau))
 274  where
 275     (tvs, theta, tau) = splitIfaceSigmaTy ty
 276
 277 -------------------
 278 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
 279 pprIfaceForAllPart tvs ctxt doc
 280   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
 281   where
 282     ppr_tvs | null tvs  = empty
 283             | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
 284
 285 -------------------
 286 ppr_tc_app ctxt_prec tc          []   = ppr tc
 287 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets   (ppr_ty ty)
 288 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (ppr_ty ty)
 289 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
 290   | arity == length tys
 291   = tupleParens bx (sep (punctuate comma (map ppr_ty tys)))
 292 ppr_tc_app ctxt_prec tc tys
 293   = maybeParen ctxt_prec tYCON_PREC
 294                (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
 295
 296 -------------------
 297 instance Outputable IfacePredType where
 298         -- Print without parens
 299   ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
 300   ppr (IfaceClassP cls ts) = ppr cls <+> sep (map pprParendIfaceType ts)
 301
 302 instance Outputable IfaceTyCon where
 303   ppr (IfaceTc ext) = ppr ext
 304   ppr other_tc      = ppr (ifaceTyConName other_tc)
 305
 306 -------------------
 307 pprIfaceContext :: IfaceContext -> SDoc
 308 -- Prints "(C a, D b) =>", including the arrow
 309 pprIfaceContext []    = empty
 310 pprIfaceContext theta = parens (sep (punctuate comma (map ppr theta)))
 311                         <+> ptext SLIT("=>")
 312
 313 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 314 \end{code}
 315
 316 %************************************************************************
 317 %*                                                                      *
 318         Conversion from Type to IfaceType
 319 %*                                                                      *
 320 %************************************************************************
 321
 322 \begin{code}
 323 ----------------
 324 toIfaceTvBndr tyvar   = (getOccName tyvar, toIfaceKind (tyVarKind tyvar))
 325 toIfaceIdBndr ext id  = (getOccName id,    toIfaceType ext (idType id))
 326 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 327
 328 toIfaceBndr ext var
 329   | isId var  = IfaceIdBndr (toIfaceIdBndr ext var)
 330   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 331
 332 ---------------------
 333 toIfaceKind :: Kind -> IfaceKind
 334 toIfaceKind k
 335   | k `eqKind` openTypeKind     = IfaceOpenTypeKind
 336   | k `eqKind` liftedTypeKind   = IfaceLiftedTypeKind
 337   | k `eqKind` unliftedTypeKind = IfaceUnliftedTypeKind
 338   | Just (arg,res) <- splitFunTy_maybe k
 339   = IfaceFunKind (toIfaceKind arg) (toIfaceKind res)
 340 #ifdef DEBUG
 341   | otherwise = pprTrace "toIfaceKind" (pprType k) IfaceOpenTypeKind
 342 #endif
 343
 344 ---------------------
 345 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
 346 toIfaceType ext (TyVarTy tv)                 = IfaceTyVar (getOccName tv)
 347 toIfaceType ext (AppTy t1 t2)                = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
 348 toIfaceType ext (FunTy t1 t2)                = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
 349 toIfaceType ext (NewTcApp tc tys)            = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
 350 toIfaceType ext (TyConApp tc tys)            = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
 351 toIfaceType ext (ForAllTy tv t)              = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
 352 toIfaceType ext (PredTy st)                  = IfacePredTy (toIfacePred ext st)
 353 toIfaceType ext (NoteTy (SynNote tc_app) ty) = toIfaceType ext tc_app
 354 toIfaceType ext (NoteTy other_note ty)       = toIfaceType ext ty
 355
 356 ----------------
 357 mkIfaceTc :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
 358 mkIfaceTc ext tc
 359   | isTupleTyCon tc     = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
 360   | nm == intTyConName  = IfaceIntTc
 361   | nm == boolTyConName = IfaceBoolTc
 362   | nm == charTyConName = IfaceCharTc
 363   | nm == listTyConName = IfaceListTc
 364   | nm == parrTyConName = IfacePArrTc
 365   | otherwise           = IfaceTc (ext nm)
 366   where
 367     nm = getName tc
 368
 369 ----------------
 370 toIfaceTypes ext ts = map (toIfaceType ext) ts
 371
 372 ----------------
 373 toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
 374 toIfacePred ext (IParam ip t)   = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
 375
 376 ----------------
 377 toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
 378 toIfaceContext ext cs = map (toIfacePred ext) cs
 379 \end{code}
 380