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