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