2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
6 This module defines interface types and binders
10 IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
11 IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
14 -- Conversion from Type -> IfaceType
15 toIfaceType, toIfacePred, toIfaceContext,
16 toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
17 toIfaceTyCon, toIfaceTyCon_name,
20 pprIfaceType, pprParendIfaceType, pprIfaceContext,
21 pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
22 tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
26 #include "HsVersions.h"
38 %************************************************************************
40 Local (nested) binders
42 %************************************************************************
45 data IfaceBndr -- Local (non-top-level) binders
46 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
47 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
49 type IfaceIdBndr = (FastString, IfaceType)
50 type IfaceTvBndr = (FastString, IfaceKind)
52 -------------------------------
53 type IfaceKind = IfaceType
54 type IfaceCoercion = IfaceType
57 = IfaceTyVar FastString -- Type variable only, not tycon
58 | IfaceAppTy IfaceType IfaceType
59 | IfaceForAllTy IfaceTvBndr IfaceType
60 | IfacePredTy IfacePredType
61 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
62 -- Includes newtypes, synonyms, tuples
63 | IfaceFunTy IfaceType IfaceType
65 data IfacePredType -- NewTypes are handled as ordinary TyConApps
66 = IfaceClassP Name [IfaceType]
67 | IfaceIParam (IPName OccName) IfaceType
68 | IfaceEqPred IfaceType IfaceType
70 type IfaceContext = [IfacePredType]
72 -- NB: If you add a data constructor, remember to add a case to
74 data IfaceTyCon -- Abbreviations for common tycons with known names
75 = IfaceTc Name -- The common case
76 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
77 | IfaceListTc | IfacePArrTc
78 | IfaceTupTc Boxity Arity
79 | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
80 | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
83 ifaceTyConName :: IfaceTyCon -> Name
84 ifaceTyConName IfaceIntTc = intTyConName
85 ifaceTyConName IfaceBoolTc = boolTyConName
86 ifaceTyConName IfaceCharTc = charTyConName
87 ifaceTyConName IfaceListTc = listTyConName
88 ifaceTyConName IfacePArrTc = parrTyConName
89 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
90 ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName
91 ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName
92 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
93 ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName
94 ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName
95 ifaceTyConName (IfaceTc ext) = ext
99 %************************************************************************
101 Functions over IFaceTypes
103 %************************************************************************
107 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
108 -- Mainly for printing purposes
112 (tvs, rho) = split_foralls ty
113 (theta, tau) = split_rho rho
115 split_foralls (IfaceForAllTy tv ty)
116 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
117 split_foralls rho = ([], rho)
119 split_rho (IfaceFunTy (IfacePredTy st) ty)
120 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
121 split_rho tau = ([], tau)
124 %************************************************************************
128 %************************************************************************
132 @ppr_ty@ takes an @Int@ that is the precedence of the context.
133 The precedence levels are:
135 \item[tOP_PREC] No parens required.
136 \item[fUN_PREC] Left hand argument of a function arrow.
137 \item[tYCON_PREC] Argument of a type constructor.
141 tOP_PREC = (0 :: Int) -- type in ParseIface.y
142 fUN_PREC = (1 :: Int) -- btype in ParseIface.y
143 tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
145 noParens :: SDoc -> SDoc
148 maybeParen ctxt_prec inner_prec pretty
149 | ctxt_prec < inner_prec = pretty
150 | otherwise = parens pretty
154 ----------------------------- Printing binders ------------------------------------
157 instance Outputable IfaceBndr where
158 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
159 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
161 pprIfaceBndrs :: [IfaceBndr] -> SDoc
162 pprIfaceBndrs bs = sep (map ppr bs)
164 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
166 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
167 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
169 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
170 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
171 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
174 ----------------------------- Printing IfaceType ------------------------------------
177 ---------------------------------
178 instance Outputable IfaceType where
179 ppr ty = pprIfaceType ty
181 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
182 pprIfaceType = ppr_ty tOP_PREC
183 pprParendIfaceType = ppr_ty tYCON_PREC
186 ppr_ty :: Int -> IfaceType -> SDoc
187 ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
188 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
189 ppr_ty ctxt_prec (IfacePredTy st) = ppr st
192 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
193 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
194 maybeParen ctxt_prec fUN_PREC $
195 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
197 ppr_fun_tail (IfaceFunTy ty1 ty2)
198 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
199 ppr_fun_tail other_ty
200 = [arrow <+> pprIfaceType other_ty]
202 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
203 = maybeParen ctxt_prec tYCON_PREC $
204 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
206 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
207 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
209 (tvs, theta, tau) = splitIfaceSigmaTy ty
212 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
213 pprIfaceForAllPart tvs ctxt doc
214 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
216 ppr_tvs | null tvs = empty
217 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
220 ppr_tc_app ctxt_prec tc [] = ppr_tc tc
221 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty)
222 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
223 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
224 | arity == length tys
225 = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
226 ppr_tc_app ctxt_prec tc tys
227 = maybeParen ctxt_prec tYCON_PREC
228 (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
230 ppr_tc :: IfaceTyCon -> SDoc
231 -- Wrap infix type constructors in parens
232 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
236 instance Outputable IfacePredType where
237 -- Print without parens
238 ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext SLIT(":=:"), ppr ty2]
239 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
240 ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
241 <+> sep (map pprParendIfaceType ts)
243 instance Outputable IfaceTyCon where
244 ppr (IfaceTc ext) = ppr ext
245 ppr other_tc = ppr (ifaceTyConName other_tc)
248 pprIfaceContext :: IfaceContext -> SDoc
249 -- Prints "(C a, D b) =>", including the arrow
250 pprIfaceContext [] = empty
251 pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
253 ppr_preds [pred] = ppr pred -- No parens
254 ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
257 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
260 %************************************************************************
262 Conversion from Type to IfaceType
264 %************************************************************************
268 toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
269 toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
270 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
273 | isId var = IfaceIdBndr (toIfaceIdBndr var)
274 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
276 toIfaceKind = toIfaceType
278 ---------------------
279 toIfaceType :: Type -> IfaceType
280 -- Synonyms are retained in the interface type
281 toIfaceType (TyVarTy tv) =
282 IfaceTyVar (occNameFS (getOccName tv))
283 toIfaceType (AppTy t1 t2) =
284 IfaceAppTy (toIfaceType t1) (toIfaceType t2)
285 toIfaceType (FunTy t1 t2) =
286 IfaceFunTy (toIfaceType t1) (toIfaceType t2)
287 toIfaceType (TyConApp tc tys) =
288 IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
289 toIfaceType (ForAllTy tv t) =
290 IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
291 toIfaceType (PredTy st) =
292 IfacePredTy (toIfacePred st)
293 toIfaceType (NoteTy other_note ty) =
297 -- A little bit of (perhaps optional) trickiness here. When
298 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
299 -- they have a wired-in name. But we'd like to dump them into the Iface
300 -- as a tuple tycon, to save lookups when reading the interface
301 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
302 -- toIfaceTyCon_name will still catch it.
304 toIfaceTyCon :: TyCon -> IfaceTyCon
306 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
307 | otherwise = toIfaceTyCon_name (tyConName tc)
309 toIfaceTyCon_name :: Name -> IfaceTyCon
311 | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
312 = toIfaceWiredInTyCon tc nm
316 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
317 toIfaceWiredInTyCon tc nm
318 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
319 | nm == intTyConName = IfaceIntTc
320 | nm == boolTyConName = IfaceBoolTc
321 | nm == charTyConName = IfaceCharTc
322 | nm == listTyConName = IfaceListTc
323 | nm == parrTyConName = IfacePArrTc
324 | nm == liftedTypeKindTyConName = IfaceLiftedTypeKindTc
325 | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
326 | nm == openTypeKindTyConName = IfaceOpenTypeKindTc
327 | nm == argTypeKindTyConName = IfaceArgTypeKindTc
328 | nm == ubxTupleKindTyConName = IfaceUbxTupleKindTc
329 | otherwise = IfaceTc nm
332 toIfaceTypes ts = map toIfaceType ts
335 toIfacePred (ClassP cls ts) =
336 IfaceClassP (getName cls) (toIfaceTypes ts)
337 toIfacePred (IParam ip t) =
338 IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
339 toIfacePred (EqPred ty1 ty2) =
340 IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
343 toIfaceContext :: ThetaType -> IfaceContext
344 toIfaceContext cs = map toIfacePred cs