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