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