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(..), IfaceCoCon(..),
  13         IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
  14         ifaceTyConName,
  15
  16         -- Conversion from Type -> IfaceType
  17         toIfaceType, toIfaceContext,
  18         toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
  19         toIfaceTyCon, toIfaceTyCon_name,
  20
  21         -- Conversion from Coercion -> IfaceType
  22         coToIfaceType,
  23
  24         -- Printing
  25         pprIfaceType, pprParendIfaceType, pprIfaceContext,
  26         pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
  27         tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
  28
  29     ) where
  30
  31 import Coercion
  32 import TypeRep hiding( maybeParen )
  33 import TyCon
  34 import Id
  35 import Var
  36 import TysWiredIn
  37 import TysPrim
  38 import Name
  39 import BasicTypes
  40 import Outputable
  41 import FastString
  42 \end{code}
  43
  44 %************************************************************************
  45 %*                                                                      *
  46                 Local (nested) binders
  47 %*                                                                      *
  48 %************************************************************************
  49
  50 \begin{code}
  51 type IfLclName = FastString     -- A local name in iface syntax
  52
  53 type IfExtName = Name   -- An External or WiredIn Name can appear in IfaceSyn
  54                         -- (However Internal or System Names never should)
  55
  56 data IfaceBndr          -- Local (non-top-level) binders
  57   = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  58   | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
  59
  60 type IfaceIdBndr  = (IfLclName, IfaceType)
  61 type IfaceTvBndr  = (IfLclName, IfaceKind)
  62
  63 -------------------------------
  64 type IfaceKind     = IfaceType
  65 type IfaceCoercion = IfaceType
  66
  67 data IfaceType     -- A kind of universal type, used for types, kinds, and coercions
  68   = IfaceTyVar    IfLclName                     -- Type/coercion variable only, not tycon
  69   | IfaceAppTy    IfaceType IfaceType
  70   | IfaceFunTy    IfaceType IfaceType
  71   | IfaceForAllTy IfaceTvBndr IfaceType
  72   | IfacePredTy   IfacePredType
  73   | IfaceTyConApp IfaceTyCon [IfaceType]  -- Not necessarily saturated
  74                                           -- Includes newtypes, synonyms, tuples
  75   | IfaceCoConApp IfaceCoCon [IfaceType]  -- Always saturated
  76
  77 data IfacePredType      -- NewTypes are handled as ordinary TyConApps
  78   = IfaceClassP IfExtName [IfaceType]
  79   | IfaceIParam (IPName OccName) IfaceType
  80   | IfaceEqPred IfaceType IfaceType
  81
  82 type IfaceContext = [IfacePredType]
  83
  84 data IfaceTyCon         -- Encodes type consructors, kind constructors
  85                         -- coercion constructors, the lot
  86   = IfaceTc IfExtName   -- The common case
  87   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
  88   | IfaceListTc | IfacePArrTc
  89   | IfaceTupTc Boxity Arity
  90   | IfaceAnyTc IfaceKind     -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
  91                              -- other than 'Any :: *' itself
  92
  93   -- Kind constructors
  94   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
  95   | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
  96
  97   -- Coercion constructors
  98 data IfaceCoCon
  99   = IfaceCoAx IfExtName
 100   | IfaceReflCo    | IfaceUnsafeCo  | IfaceSymCo
 101   | IfaceTransCo   | IfaceInstCo
 102   | IfaceNthCo Int
 103
 104 ifaceTyConName :: IfaceTyCon -> Name
 105 ifaceTyConName IfaceIntTc              = intTyConName
 106 ifaceTyConName IfaceBoolTc             = boolTyConName
 107 ifaceTyConName IfaceCharTc             = charTyConName
 108 ifaceTyConName IfaceListTc             = listTyConName
 109 ifaceTyConName IfacePArrTc             = parrTyConName
 110 ifaceTyConName (IfaceTupTc bx ar)      = getName (tupleTyCon bx ar)
 111 ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
 112 ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
 113 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
 114 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
 115 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
 116 ifaceTyConName (IfaceTc ext)           = ext
 117 ifaceTyConName (IfaceAnyTc k)          = pprPanic "ifaceTyConName" (ppr k)
 118                                          -- Note [The Name of an IfaceAnyTc]
 119 \end{code}
 120
 121 Note [The Name of an IfaceAnyTc]
 122 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 123 It isn't easy to get the Name of an IfaceAnyTc in a pure way.  What you
 124 really need to do is to transform it to a TyCon, and get the Name of that.
 125 But doing so needs the monad because there's an IfaceKind inside, and we
 126 need a Kind.
 127
 128 In fact, ifaceTyConName is only used for instances and rules, and we don't
 129 expect to instantiate those at these (internal-ish) Any types, so rather
 130 than solve this potential problem now, I'm going to defer it until it happens!
 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, fUN_PREC, tYCON_PREC :: Int
 175 tOP_PREC    = 0 -- type   in ParseIface.y
 176 fUN_PREC    = 1 -- btype  in ParseIface.y
 177 tYCON_PREC  = 2 -- atype  in ParseIface.y
 178
 179 noParens :: SDoc -> SDoc
 180 noParens pp = pp
 181
 182 maybeParen :: Int -> Int -> SDoc -> SDoc
 183 maybeParen ctxt_prec inner_prec pretty
 184   | ctxt_prec < inner_prec = pretty
 185   | otherwise              = parens pretty
 186 \end{code}
 187
 188
 189 ----------------------------- Printing binders ------------------------------------
 190
 191 \begin{code}
 192 instance Outputable IfaceBndr where
 193     ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
 194     ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
 195
 196 pprIfaceBndrs :: [IfaceBndr] -> SDoc
 197 pprIfaceBndrs bs = sep (map ppr bs)
 198
 199 pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
 200 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 201
 202 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
 203 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
 204   = ppr tv
 205 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
 206 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 207 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
 208 \end{code}
 209
 210 ----------------------------- Printing IfaceType ------------------------------------
 211
 212 \begin{code}
 213 ---------------------------------
 214 instance Outputable IfaceType where
 215   ppr ty = pprIfaceType ty
 216
 217 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
 218 pprIfaceType       = ppr_ty tOP_PREC
 219 pprParendIfaceType = ppr_ty tYCON_PREC
 220
 221
 222 ppr_ty :: Int -> IfaceType -> SDoc
 223 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
 224 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
 225 ppr_ty _         (IfacePredTy st)       = ppr st
 226
 227 ppr_ty ctxt_prec (IfaceCoConApp tc tys)
 228   = maybeParen ctxt_prec tYCON_PREC
 229                (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
 230
 231         -- Function types
 232 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
 233   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
 234     maybeParen ctxt_prec fUN_PREC $
 235     sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
 236   where
 237     ppr_fun_tail (IfaceFunTy ty1 ty2)
 238       = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
 239     ppr_fun_tail other_ty
 240       = [arrow <+> pprIfaceType other_ty]
 241
 242 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
 243   = maybeParen ctxt_prec tYCON_PREC $
 244     ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
 245
 246 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
 247   = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
 248  where
 249     (tvs, theta, tau) = splitIfaceSigmaTy ty
 250
 251 -------------------
 252 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
 253 pprIfaceForAllPart tvs ctxt doc
 254   = sep [ppr_tvs, pprIfaceContext ctxt, doc]
 255   where
 256     ppr_tvs | null tvs  = empty
 257             | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
 258
 259 -------------------
 260 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
 261 ppr_tc_app _         tc          []   = ppr_tc tc
 262 ppr_tc_app _         IfaceListTc [ty] = brackets   (pprIfaceType ty)
 263 ppr_tc_app _         IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
 264 ppr_tc_app _         (IfaceTupTc bx arity) tys
 265   | arity == length tys
 266   = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
 267 ppr_tc_app ctxt_prec tc tys
 268   = maybeParen ctxt_prec tYCON_PREC
 269                (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
 270
 271 ppr_tc :: IfaceTyCon -> SDoc
 272 -- Wrap infix type constructors in parens
 273 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
 274 ppr_tc tc                  = ppr tc
 275
 276 -------------------
 277 instance Outputable IfacePredType where
 278         -- Print without parens
 279   ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit "~"), ppr ty2]
 280   ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
 281   ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
 282                              <+> sep (map pprParendIfaceType ts)
 283
 284 instance Outputable IfaceTyCon where
 285   ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k
 286                              -- We can't easily get the Name of an IfaceAnyTc
 287                              -- (see Note [The Name of an IfaceAnyTc])
 288                              -- so we fake it.  It's only for debug printing!
 289   ppr other_tc       = ppr (ifaceTyConName other_tc)
 290
 291 instance Outputable IfaceCoCon where
 292   ppr (IfaceCoAx n)  = ppr n
 293   ppr IfaceReflCo    = ptext (sLit "Refl")
 294   ppr IfaceUnsafeCo  = ptext (sLit "Unsafe")
 295   ppr IfaceSymCo     = ptext (sLit "Sym")
 296   ppr IfaceTransCo   = ptext (sLit "Trans")
 297   ppr IfaceInstCo    = ptext (sLit "Inst")
 298   ppr (IfaceNthCo d) = ptext (sLit "Nth:") <> int d
 299
 300 -------------------
 301 pprIfaceContext :: IfaceContext -> SDoc
 302 -- Prints "(C a, D b) =>", including the arrow
 303 pprIfaceContext []     = empty
 304 pprIfaceContext theta = ppr_preds theta <+> darrow
 305
 306 ppr_preds :: [IfacePredType] -> SDoc
 307 ppr_preds [pred] = ppr pred     -- No parens
 308 ppr_preds preds  = parens (sep (punctuate comma (map ppr preds)))
 309
 310 -------------------
 311 pabrackets :: SDoc -> SDoc
 312 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
 313 \end{code}
 314
 315 %************************************************************************
 316 %*                                                                      *
 317         Conversion from Type to IfaceType
 318 %*                                                                      *
 319 %************************************************************************
 320
 321 \begin{code}
 322 ----------------
 323 toIfaceTvBndr :: TyVar -> (IfLclName, IfaceType)
 324 toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
 325 toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
 326 toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
 327 toIfaceTvBndrs :: [TyVar] -> [(IfLclName, IfaceType)]
 328 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 329
 330 toIfaceBndr :: Var -> IfaceBndr
 331 toIfaceBndr var
 332   | isId var  = IfaceIdBndr (toIfaceIdBndr var)
 333   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 334
 335 toIfaceKind :: Type -> IfaceType
 336 toIfaceKind = toIfaceType
 337
 338 ---------------------
 339 toIfaceType :: Type -> IfaceType
 340 -- Synonyms are retained in the interface type
 341 toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyCoVar tv)
 342 toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
 343 toIfaceType (FunTy t1 t2)     = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
 344 toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
 345 toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 346 toIfaceType (PredTy st)       = IfacePredTy (toIfacePred toIfaceType st)
 347
 348 toIfaceTyCoVar :: TyCoVar -> FastString
 349 toIfaceTyCoVar = occNameFS . getOccName
 350
 351 ----------------
 352 -- A little bit of (perhaps optional) trickiness here.  When
 353 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
 354 -- they have a wired-in name.  But we'd like to dump them into the Iface
 355 -- as a tuple tycon, to save lookups when reading the interface
 356 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
 357 -- toIfaceTyCon_name will still catch it.
 358
 359 toIfaceTyCon :: TyCon -> IfaceTyCon
 360 toIfaceTyCon tc
 361   | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
 362   | isAnyTyCon tc   = IfaceAnyTc (toIfaceKind (tyConKind tc))
 363   | otherwise       = toIfaceTyCon_name (tyConName tc)
 364
 365 toIfaceTyCon_name :: Name -> IfaceTyCon
 366 toIfaceTyCon_name nm
 367   | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
 368   = toIfaceWiredInTyCon tc nm
 369   | otherwise
 370   = IfaceTc nm
 371
 372 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 373 toIfaceWiredInTyCon tc nm
 374   | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConBoxity tc) (tyConArity tc)
 375   | isAnyTyCon tc                   = IfaceAnyTc (toIfaceKind (tyConKind tc))
 376   | nm == intTyConName              = IfaceIntTc
 377   | nm == boolTyConName             = IfaceBoolTc
 378   | nm == charTyConName             = IfaceCharTc
 379   | nm == listTyConName             = IfaceListTc
 380   | nm == parrTyConName             = IfacePArrTc
 381   | nm == liftedTypeKindTyConName   = IfaceLiftedTypeKindTc
 382   | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
 383   | nm == openTypeKindTyConName     = IfaceOpenTypeKindTc
 384   | nm == argTypeKindTyConName      = IfaceArgTypeKindTc
 385   | nm == ubxTupleKindTyConName     = IfaceUbxTupleKindTc
 386   | otherwise                       = IfaceTc nm
 387
 388 ----------------
 389 toIfaceTypes :: [Type] -> [IfaceType]
 390 toIfaceTypes ts = map toIfaceType ts
 391
 392 ----------------
 393 toIfacePred :: (a -> IfaceType) -> Pred a -> IfacePredType
 394 toIfacePred to (ClassP cls ts)  = IfaceClassP (getName cls) (map to ts)
 395 toIfacePred to (IParam ip t)    = IfaceIParam (mapIPName getOccName ip) (to t)
 396 toIfacePred to (EqPred ty1 ty2) =  IfaceEqPred (to ty1) (to ty2)
 397
 398 ----------------
 399 toIfaceContext :: ThetaType -> IfaceContext
 400 toIfaceContext cs = map (toIfacePred toIfaceType) cs
 401
 402 ----------------
 403 coToIfaceType :: Coercion -> IfaceType
 404 coToIfaceType (Refl ty)             = IfaceCoConApp IfaceReflCo [toIfaceType ty]
 405 coToIfaceType (TyConAppCo tc cos)   = IfaceTyConApp (toIfaceTyCon tc)
 406                                                     (map coToIfaceType cos)
 407 coToIfaceType (AppCo co1 co2)       = IfaceAppTy    (coToIfaceType co1)
 408                                                     (coToIfaceType co2)
 409 coToIfaceType (ForAllCo v co)       = IfaceForAllTy (toIfaceTvBndr v)
 410                                                     (coToIfaceType co)
 411 coToIfaceType (CoVarCo cv)          = IfaceTyVar  (toIfaceTyCoVar cv)
 412 coToIfaceType (AxiomInstCo con cos) = IfaceCoConApp (IfaceCoAx (coAxiomName con))
 413                                                     (map coToIfaceType cos)
 414 coToIfaceType (UnsafeCo ty1 ty2)    = IfaceCoConApp IfaceUnsafeCo
 415                                                     [ toIfaceType ty1
 416                                                     , toIfaceType ty2 ]
 417 coToIfaceType (SymCo co)            = IfaceCoConApp IfaceSymCo
 418                                                     [ coToIfaceType co ]
 419 coToIfaceType (TransCo co1 co2)     = IfaceCoConApp IfaceTransCo
 420                                                     [ coToIfaceType co1
 421                                                     , coToIfaceType co2 ]
 422 coToIfaceType (NthCo d co)          = IfaceCoConApp (IfaceNthCo d)
 423                                                     [ coToIfaceType co ]
 424 coToIfaceType (InstCo co ty)        = IfaceCoConApp IfaceInstCo
 425                                                     [ coToIfaceType co
 426                                                     , toIfaceType ty ]
 427 \end{code}
 428