2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
5 This module defines interface types and binders
9 IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
10 IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
13 -- Conversion from Type -> IfaceType
14 toIfaceType, toIfacePred, toIfaceContext,
15 toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
16 toIfaceTyCon, toIfaceTyCon_name,
19 pprIfaceType, pprParendIfaceType, pprIfaceContext,
20 pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
21 tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
25 #include "HsVersions.h"
27 import TypeRep ( TyThing(..), Type(..), PredType(..), ThetaType,
28 unliftedTypeKindTyConName, openTypeKindTyConName,
29 ubxTupleKindTyConName, argTypeKindTyConName,
30 liftedTypeKindTyConName )
31 import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
32 import Var ( isId, tyVarKind, idType )
33 import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
34 import OccName ( OccName, parenSymOcc, occNameFS )
35 import Name ( Name, getName, getOccName, nameModule, nameOccName,
36 wiredInNameTyThing_maybe )
37 import Module ( Module, ModuleName )
38 import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
43 %************************************************************************
45 Local (nested) binders
47 %************************************************************************
50 data IfaceBndr -- Local (non-top-level) binders
51 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
52 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
54 type IfaceIdBndr = (FastString, IfaceType)
55 type IfaceTvBndr = (FastString, IfaceKind)
57 -------------------------------
58 type IfaceKind = IfaceType -- Re-use the Kind type, but no KindVars in it
60 type IfaceCoercion = IfaceType
63 = IfaceTyVar FastString -- 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
71 data IfacePredType -- NewTypes are handled as ordinary TyConApps
72 = IfaceClassP Name [IfaceType]
73 | IfaceIParam (IPName OccName) IfaceType
74 | IfaceEqPred IfaceType IfaceType
76 type IfaceContext = [IfacePredType]
78 -- NB: If you add a data constructor, remember to add a case to
80 data IfaceTyCon -- Abbreviations for common tycons with known names
81 = IfaceTc Name -- The common case
82 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
83 | IfaceListTc | IfacePArrTc
84 | IfaceTupTc Boxity Arity
85 | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
86 | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
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
104 %************************************************************************
106 Functions over IFaceTypes
108 %************************************************************************
112 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
113 -- Mainly for printing purposes
117 (tvs, rho) = split_foralls ty
118 (theta, tau) = split_rho rho
120 split_foralls (IfaceForAllTy tv ty)
121 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
122 split_foralls rho = ([], rho)
124 split_rho (IfaceFunTy (IfacePredTy st) ty)
125 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
126 split_rho tau = ([], tau)
129 %************************************************************************
133 %************************************************************************
137 @ppr_ty@ takes an @Int@ that is the precedence of the context.
138 The precedence levels are:
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.
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
150 noParens :: SDoc -> SDoc
153 maybeParen ctxt_prec inner_prec pretty
154 | ctxt_prec < inner_prec = pretty
155 | otherwise = parens pretty
159 ----------------------------- Printing binders ------------------------------------
162 instance Outputable IfaceBndr where
163 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
164 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
166 pprIfaceBndrs :: [IfaceBndr] -> SDoc
167 pprIfaceBndrs bs = sep (map ppr bs)
169 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
171 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
172 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
174 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
175 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
176 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
179 ----------------------------- Printing IfaceType ------------------------------------
182 ---------------------------------
183 instance Outputable IfaceType where
184 ppr ty = pprIfaceTypeForUser ty
186 pprIfaceTypeForUser ::IfaceType -> SDoc
187 -- Drop top-level for-alls; if that's not what you want, use pprIfaceType dire
188 pprIfaceTypeForUser ty
189 = pprIfaceForAllPart [] theta (pprIfaceType tau)
191 (_tvs, theta, tau) = splitIfaceSigmaTy ty
193 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
194 pprIfaceType = ppr_ty tOP_PREC
195 pprParendIfaceType = ppr_ty tYCON_PREC
198 ppr_ty :: Int -> IfaceType -> SDoc
199 ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
200 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
201 ppr_ty ctxt_prec (IfacePredTy st) = ppr st
204 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
205 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
206 maybeParen ctxt_prec fUN_PREC $
207 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
209 ppr_fun_tail (IfaceFunTy ty1 ty2)
210 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
211 ppr_fun_tail other_ty
212 = [arrow <+> pprIfaceType other_ty]
214 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
215 = maybeParen ctxt_prec tYCON_PREC $
216 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
218 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
219 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
221 (tvs, theta, tau) = splitIfaceSigmaTy ty
224 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
225 pprIfaceForAllPart tvs ctxt doc
226 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
228 ppr_tvs | null tvs = empty
229 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
232 ppr_tc_app ctxt_prec tc [] = ppr_tc tc
233 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty)
234 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
235 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
236 | arity == length tys
237 = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
238 ppr_tc_app ctxt_prec tc tys
239 = maybeParen ctxt_prec tYCON_PREC
240 (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
242 ppr_tc :: IfaceTyCon -> SDoc
243 -- Wrap infix type constructors in parens
244 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
248 instance Outputable IfacePredType where
249 -- Print without parens
250 ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext SLIT(":=:"), ppr ty2]
251 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
252 ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
253 <+> sep (map pprParendIfaceType ts)
255 instance Outputable IfaceTyCon where
256 ppr (IfaceTc ext) = ppr ext
257 ppr other_tc = ppr (ifaceTyConName other_tc)
260 pprIfaceContext :: IfaceContext -> SDoc
261 -- Prints "(C a, D b) =>", including the arrow
262 pprIfaceContext [] = empty
263 pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
265 ppr_preds [pred] = ppr pred -- No parens
266 ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
269 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
272 %************************************************************************
274 Conversion from Type to IfaceType
276 %************************************************************************
280 toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
281 toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
282 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
285 | isId var = IfaceIdBndr (toIfaceIdBndr var)
286 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
288 toIfaceKind = toIfaceType
290 ---------------------
291 toIfaceType :: Type -> IfaceType
292 -- Synonyms are retained in the interface type
293 toIfaceType (TyVarTy tv) =
294 IfaceTyVar (occNameFS (getOccName tv))
295 toIfaceType (AppTy t1 t2) =
296 IfaceAppTy (toIfaceType t1) (toIfaceType t2)
297 toIfaceType (FunTy t1 t2) =
298 IfaceFunTy (toIfaceType t1) (toIfaceType t2)
299 toIfaceType (TyConApp tc tys) =
300 IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
301 toIfaceType (ForAllTy tv t) =
302 IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
303 toIfaceType (PredTy st) =
304 IfacePredTy (toIfacePred st)
305 toIfaceType (NoteTy other_note ty) =
309 -- A little bit of (perhaps optional) trickiness here. When
310 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
311 -- they have a wired-in name. But we'd like to dump them into the Iface
312 -- as a tuple tycon, to save lookups when reading the interface
313 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
314 -- toIfaceTyCon_name will still catch it.
316 toIfaceTyCon :: TyCon -> IfaceTyCon
318 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
319 | otherwise = toIfaceTyCon_name (tyConName tc)
321 toIfaceTyCon_name :: Name -> IfaceTyCon
323 | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
324 = toIfaceWiredInTyCon tc nm
328 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
329 toIfaceWiredInTyCon tc nm
330 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
331 | nm == intTyConName = IfaceIntTc
332 | nm == boolTyConName = IfaceBoolTc
333 | nm == charTyConName = IfaceCharTc
334 | nm == listTyConName = IfaceListTc
335 | nm == parrTyConName = IfacePArrTc
336 | nm == liftedTypeKindTyConName = IfaceLiftedTypeKindTc
337 | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
338 | nm == openTypeKindTyConName = IfaceOpenTypeKindTc
339 | nm == argTypeKindTyConName = IfaceArgTypeKindTc
340 | nm == ubxTupleKindTyConName = IfaceUbxTupleKindTc
341 | otherwise = IfaceTc nm
344 toIfaceTypes ts = map toIfaceType ts
347 toIfacePred (ClassP cls ts) =
348 IfaceClassP (getName cls) (toIfaceTypes ts)
349 toIfacePred (IParam ip t) =
350 IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
351 toIfacePred (EqPred ty1 ty2) =
352 IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
355 toIfaceContext :: ThetaType -> IfaceContext
356 toIfaceContext cs = map toIfacePred cs