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