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