compiler/iface/IfaceType.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   4 %
   5
   6 This module defines interface types and binders
   7
   8 \begin{code}
   9 module IfaceType (
  10         IfExtName, IfLclName,
  11
  12         IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
  13         IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
  14         ifaceTyConName,
  15
  16         -- Conversion from Type -> IfaceType
  17         toIfaceType, toIfacePred, toIfaceContext,
  18         toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
  19         toIfaceTyCon, toIfaceTyCon_name,
  20
  21         -- Printing
  22         pprIfaceType, pprParendIfaceType, pprIfaceContext,
  23         pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
  24         tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
  25
  26     ) where
  27
  28 import TypeRep
  29 import TyCon
  30 import Id
  31 import Var
  32 import TysWiredIn
  33 import Name
  34 import BasicTypes
  35 import Outputable
  36 import FastString
  37 \end{code}
  38
  39 %************************************************************************
  40 %*                                                                      *
  41                 Local (nested) binders
  42 %*                                                                      *
  43 %************************************************************************
  44
  45 \begin{code}
  46 type IfLclName = FastString     -- A local name in iface syntax
  47
  48 type IfExtName = Name   -- An External or WiredIn Name can appear in IfaceSyn
  49                         -- (However Internal or System Names never should)
  50
  51 data IfaceBndr          -- Local (non-top-level) binders
  52   = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  53   | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
  54
  55 type IfaceIdBndr  = (IfLclName, IfaceType)
  56 type IfaceTvBndr  = (IfLclName, IfaceKind)
  57
  58 -------------------------------
  59 type IfaceKind     = IfaceType
  60 type IfaceCoercion = IfaceType
  61
  62 data IfaceType
  63   = IfaceTyVar    IfLclName                     -- Type variable only, not tycon
  64   | IfaceAppTy    IfaceType IfaceType
  65   | IfaceForAllTy IfaceTvBndr IfaceType
  66   | IfacePredTy   IfacePredType
  67   | IfaceTyConApp IfaceTyCon [IfaceType]        -- Not necessarily saturated
  68                                                 -- Includes newtypes, synonyms, tuples
  69   | IfaceFunTy  IfaceType IfaceType
  70
  71 data IfacePredType      -- NewTypes are handled as ordinary TyConApps
  72   = IfaceClassP IfExtName [IfaceType]
  73   | IfaceIParam (IPName OccName) IfaceType
  74   | IfaceEqPred IfaceType IfaceType
  75
  76 type IfaceContext = [IfacePredType]
  77
  78 data IfaceTyCon         -- Abbreviations for common tycons with known names
  79   = IfaceTc IfExtName   -- The common case
  80   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
  81   | IfaceListTc | IfacePArrTc
  82   | IfaceTupTc Boxity Arity
  83   | IfaceAnyTc IfaceKind     -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
  84                              -- other than 'Any :: *' itself
  85   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
  86   | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
  87
  88 ifaceTyConName :: IfaceTyCon -> IfExtName
  89 ifaceTyConName IfaceIntTc              = intTyConName
  90 ifaceTyConName IfaceBoolTc             = boolTyConName
  91 ifaceTyConName IfaceCharTc             = charTyConName
  92 ifaceTyConName IfaceListTc             = listTyConName
  93 ifaceTyConName IfacePArrTc             = parrTyConName
  94 ifaceTyConName (IfaceTupTc bx ar)      = getName (tupleTyCon bx ar)
  95 ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
  96 ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
  97 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
  98 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
  99 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
 100 ifaceTyConName (IfaceTc ext)           = ext
 101 ifaceTyConName (IfaceAnyTc k)          = pprPanic "ifaceTyConName" (ppr k)
 102                                          -- Note [The Name of an IfaceAnyTc]
 103 \end{code}
 104
 105 Note [The Name of an IfaceAnyTc]
 106 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 107 It isn't easy to get the Name of an IfaceAnyTc in a pure way.  What you
 108 really need to do is to transform it to a TyCon, and get the Name of that.
 109 But doing so needs the monad because there's an IfaceKind inside, and we
 110 need a Kind.
 111
 112 In fact, ifaceTyConName is only used for instances and rules, and we don't
 113 expect to instantiate those at these (internal-ish) Any types, so rather
 114 than solve this potential problem now, I'm going to defer it until it happens!
 115
 116 %************************************************************************
 117 %*                                                                      *
 118                 Functions over IFaceTypes
 119 %*                                                                      *
 120 %************************************************************************
 121
 122
 123 \begin{code}
 124 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
 125 -- Mainly for printing purposes
 126 splitIfaceSigmaTy ty
 127   = (tvs,theta,tau)
 128   where
 129     (tvs, rho)   = split_foralls ty
 130     (theta, tau) = split_rho rho
 131
 132     split_foralls (IfaceForAllTy tv ty)
 133         = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
 134     split_foralls rho = ([], rho)
 135
 136     split_rho (IfaceFunTy (IfacePredTy st) ty)
 137         = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
 138     split_rho tau = ([], tau)
 139 \end{code}
 140
 141 %************************************************************************
 142 %*                                                                      *
 143                 Pretty-printing
 144 %*                                                                      *
 145 %************************************************************************
 146
 147 Precedence
 148 ~~~~~~~~~~
 149 @ppr_ty@ takes an @Int@ that is the precedence of the context.
 150 The precedence levels are:
 151 \begin{description}
 152 \item[tOP_PREC]   No parens required.
 153 \item[fUN_PREC]   Left hand argument of a function arrow.
 154 \item[tYCON_PREC] Argument of a type constructor.
 155 \end{description}
 156
 157 \begin{code}
 158 tOP_PREC, fUN_PREC, tYCON_PREC :: Int
 159 tOP_PREC    = 0 -- type   in ParseIface.y
 160 fUN_PREC    = 1 -- btype  in ParseIface.y
 161 tYCON_PREC  = 2 -- atype  in ParseIface.y
 162
 163 noParens :: SDoc -> SDoc
 164 noParens pp = pp
 165
 166 maybeParen :: Int -> Int -> SDoc -> SDoc
 167 maybeParen ctxt_prec inner_prec pretty
 168   | ctxt_prec < inner_prec = pretty
 169   | otherwise              = parens pretty
 170 \end{code}
 171
 172
 173 ----------------------------- Printing binders ------------------------------------
 174
 175 \begin{code}
 176 instance Outputable IfaceBndr where
 177     ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
 178     ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
 179
 180 pprIfaceBndrs :: [IfaceBndr] -> SDoc
 181 pprIfaceBndrs bs = sep (map ppr bs)
 182
 183 pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
 184 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 185
 186 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
 187 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
 188   = ppr tv
 189 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
 190 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 191 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
 192 \end{code}
 193
 194 ----------------------------- Printing IfaceType ------------------------------------
 195
 196 \begin{code}
 197 ---------------------------------
 198 instance Outputable IfaceType where
 199   ppr ty = pprIfaceType ty
 200
 201 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
 202 pprIfaceType       = ppr_ty tOP_PREC
 203 pprParendIfaceType = ppr_ty tYCON_PREC
 204
 205
 206 ppr_ty :: Int -> IfaceType -> SDoc
 207 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
 208 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
 209 ppr_ty _         (IfacePredTy st)       = ppr st
 210
 211         -- Function types
 212 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
 213   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
 214     maybeParen ctxt_prec fUN_PREC $
 215     sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
 216   where
 217     ppr_fun_tail (IfaceFunTy ty1 ty2)
 218       = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
 219     ppr_fun_tail other_ty
 220       = [arrow <+> pprIfaceType other_ty]
 221
 222 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
 223   = maybeParen ctxt_prec tYCON_PREC $
 224     ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
 225
 226 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
 227   = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
 228  where
 229     (tvs, theta, tau) = splitIfaceSigmaTy ty
 230
 231 -------------------
 232 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
 233 pprIfaceForAllPart tvs ctxt doc
 234   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
 235   where
 236     ppr_tvs | null tvs  = empty
 237             | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
 238
 239 -------------------
 240 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
 241 ppr_tc_app _         tc          []   = ppr_tc tc
 242 ppr_tc_app _         IfaceListTc [ty] = brackets   (pprIfaceType ty)
 243 ppr_tc_app _         IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
 244 ppr_tc_app _         (IfaceTupTc bx arity) tys
 245   | arity == length tys
 246   = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
 247 ppr_tc_app ctxt_prec tc tys
 248   = maybeParen ctxt_prec tYCON_PREC
 249                (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
 250
 251 ppr_tc :: IfaceTyCon -> SDoc
 252 -- Wrap infix type constructors in parens
 253 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
 254 ppr_tc tc                  = ppr tc
 255
 256 -------------------
 257 instance Outputable IfacePredType where
 258         -- Print without parens
 259   ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit "~"), ppr ty2]
 260   ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
 261   ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
 262                              <+> sep (map pprParendIfaceType ts)
 263
 264 instance Outputable IfaceTyCon where
 265   ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k
 266                              -- We can't easily get the Name of an IfaceAnyTc
 267                              -- (see Note [The Name of an IfaceAnyTc])
 268                              -- so we fake it.  It's only for debug printing!
 269   ppr other_tc       = ppr (ifaceTyConName other_tc)
 270
 271 -------------------
 272 pprIfaceContext :: IfaceContext -> SDoc
 273 -- Prints "(C a, D b) =>", including the arrow
 274 pprIfaceContext []     = empty
 275 pprIfaceContext theta = ppr_preds theta <+> darrow
 276
 277 ppr_preds :: [IfacePredType] -> SDoc
 278 ppr_preds [pred] = ppr pred     -- No parens
 279 ppr_preds preds  = parens (sep (punctuate comma (map ppr preds)))
 280
 281 -------------------
 282 pabrackets :: SDoc -> SDoc
 283 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
 284 \end{code}
 285
 286 %************************************************************************
 287 %*                                                                      *
 288         Conversion from Type to IfaceType
 289 %*                                                                      *
 290 %************************************************************************
 291
 292 \begin{code}
 293 ----------------
 294 toIfaceTvBndr :: TyVar -> (IfLclName, IfaceType)
 295 toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
 296 toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
 297 toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
 298 toIfaceTvBndrs :: [TyVar] -> [(IfLclName, IfaceType)]
 299 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 300
 301 toIfaceBndr :: Var -> IfaceBndr
 302 toIfaceBndr var
 303   | isId var  = IfaceIdBndr (toIfaceIdBndr var)
 304   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 305
 306 toIfaceKind :: Type -> IfaceType
 307 toIfaceKind = toIfaceType
 308
 309 ---------------------
 310 toIfaceType :: Type -> IfaceType
 311 -- Synonyms are retained in the interface type
 312 toIfaceType (TyVarTy tv) =
 313   IfaceTyVar (occNameFS (getOccName tv))
 314 toIfaceType (AppTy t1 t2) =
 315   IfaceAppTy (toIfaceType t1) (toIfaceType t2)
 316 toIfaceType (FunTy t1 t2) =
 317   IfaceFunTy (toIfaceType t1) (toIfaceType t2)
 318 toIfaceType (TyConApp tc tys) =
 319   IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
 320 toIfaceType (ForAllTy tv t) =
 321   IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 322 toIfaceType (PredTy st) =
 323   IfacePredTy (toIfacePred st)
 324
 325 ----------------
 326 -- A little bit of (perhaps optional) trickiness here.  When
 327 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
 328 -- they have a wired-in name.  But we'd like to dump them into the Iface
 329 -- as a tuple tycon, to save lookups when reading the interface
 330 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
 331 -- toIfaceTyCon_name will still catch it.
 332
 333 toIfaceTyCon :: TyCon -> IfaceTyCon
 334 toIfaceTyCon tc
 335   | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
 336   | isAnyTyCon tc   = IfaceAnyTc (toIfaceKind (tyConKind tc))
 337   | otherwise       = toIfaceTyCon_name (tyConName tc)
 338
 339 toIfaceTyCon_name :: Name -> IfaceTyCon
 340 toIfaceTyCon_name nm
 341   | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
 342   = toIfaceWiredInTyCon tc nm
 343   | otherwise
 344   = IfaceTc nm
 345
 346 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 347 toIfaceWiredInTyCon tc nm
 348   | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConBoxity tc) (tyConArity tc)
 349   | isAnyTyCon tc                   = IfaceAnyTc (toIfaceKind (tyConKind tc))
 350   | nm == intTyConName              = IfaceIntTc
 351   | nm == boolTyConName             = IfaceBoolTc
 352   | nm == charTyConName             = IfaceCharTc
 353   | nm == listTyConName             = IfaceListTc
 354   | nm == parrTyConName             = IfacePArrTc
 355   | nm == liftedTypeKindTyConName   = IfaceLiftedTypeKindTc
 356   | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
 357   | nm == openTypeKindTyConName     = IfaceOpenTypeKindTc
 358   | nm == argTypeKindTyConName      = IfaceArgTypeKindTc
 359   | nm == ubxTupleKindTyConName     = IfaceUbxTupleKindTc
 360   | otherwise                       = IfaceTc nm
 361
 362 ----------------
 363 toIfaceTypes :: [Type] -> [IfaceType]
 364 toIfaceTypes ts = map toIfaceType ts
 365
 366 ----------------
 367 toIfacePred :: PredType -> IfacePredType
 368 toIfacePred (ClassP cls ts) =
 369   IfaceClassP (getName cls) (toIfaceTypes ts)
 370 toIfacePred (IParam ip t) =
 371   IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
 372 toIfacePred (EqPred ty1 ty2) =
 373   IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
 374
 375 ----------------
 376 toIfaceContext :: ThetaType -> IfaceContext
 377 toIfaceContext cs = map toIfacePred cs
 378 \end{code}
 379