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
36 %************************************************************************
38 Local (nested) binders
40 %************************************************************************
43 data IfaceBndr -- Local (non-top-level) binders
44 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
45 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
47 type IfaceIdBndr = (FastString, IfaceType)
48 type IfaceTvBndr = (FastString, IfaceKind)
50 -------------------------------
51 type IfaceKind = IfaceType
52 type IfaceCoercion = IfaceType
55 = IfaceTyVar FastString -- Type variable only, not tycon
56 | IfaceAppTy IfaceType IfaceType
57 | IfaceForAllTy IfaceTvBndr IfaceType
58 | IfacePredTy IfacePredType
59 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
60 -- Includes newtypes, synonyms, tuples
61 | IfaceFunTy IfaceType IfaceType
63 data IfacePredType -- NewTypes are handled as ordinary TyConApps
64 = IfaceClassP Name [IfaceType]
65 | IfaceIParam (IPName OccName) IfaceType
66 | IfaceEqPred IfaceType IfaceType
68 type IfaceContext = [IfacePredType]
70 -- NB: If you add a data constructor, remember to add a case to
72 data IfaceTyCon -- Abbreviations for common tycons with known names
73 = IfaceTc Name -- The common case
74 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
75 | IfaceListTc | IfacePArrTc
76 | IfaceTupTc Boxity Arity
77 | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
78 | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
81 ifaceTyConName :: IfaceTyCon -> Name
82 ifaceTyConName IfaceIntTc = intTyConName
83 ifaceTyConName IfaceBoolTc = boolTyConName
84 ifaceTyConName IfaceCharTc = charTyConName
85 ifaceTyConName IfaceListTc = listTyConName
86 ifaceTyConName IfacePArrTc = parrTyConName
87 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
88 ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName
89 ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName
90 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
91 ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName
92 ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName
93 ifaceTyConName (IfaceTc ext) = ext
97 %************************************************************************
99 Functions over IFaceTypes
101 %************************************************************************
105 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
106 -- Mainly for printing purposes
110 (tvs, rho) = split_foralls ty
111 (theta, tau) = split_rho rho
113 split_foralls (IfaceForAllTy tv ty)
114 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
115 split_foralls rho = ([], rho)
117 split_rho (IfaceFunTy (IfacePredTy st) ty)
118 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
119 split_rho tau = ([], tau)
122 %************************************************************************
126 %************************************************************************
130 @ppr_ty@ takes an @Int@ that is the precedence of the context.
131 The precedence levels are:
133 \item[tOP_PREC] No parens required.
134 \item[fUN_PREC] Left hand argument of a function arrow.
135 \item[tYCON_PREC] Argument of a type constructor.
139 tOP_PREC, fUN_PREC, tYCON_PREC :: Int
140 tOP_PREC = 0 -- type in ParseIface.y
141 fUN_PREC = 1 -- btype in ParseIface.y
142 tYCON_PREC = 2 -- atype in ParseIface.y
144 noParens :: SDoc -> SDoc
147 maybeParen :: Int -> Int -> 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 :: (FastString, IfaceType) -> SDoc
165 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
167 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
168 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
170 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
171 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
172 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
175 ----------------------------- Printing IfaceType ------------------------------------
178 ---------------------------------
179 instance Outputable IfaceType where
180 ppr ty = pprIfaceType ty
182 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
183 pprIfaceType = ppr_ty tOP_PREC
184 pprParendIfaceType = ppr_ty tYCON_PREC
187 ppr_ty :: Int -> IfaceType -> SDoc
188 ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar
189 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
190 ppr_ty _ (IfacePredTy st) = ppr st
193 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
194 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
195 maybeParen ctxt_prec fUN_PREC $
196 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
198 ppr_fun_tail (IfaceFunTy ty1 ty2)
199 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
200 ppr_fun_tail other_ty
201 = [arrow <+> pprIfaceType other_ty]
203 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
204 = maybeParen ctxt_prec tYCON_PREC $
205 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
207 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
208 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
210 (tvs, theta, tau) = splitIfaceSigmaTy ty
213 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
214 pprIfaceForAllPart tvs ctxt doc
215 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
217 ppr_tvs | null tvs = empty
218 | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
221 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
222 ppr_tc_app _ tc [] = ppr_tc tc
223 ppr_tc_app _ IfaceListTc [ty] = brackets (pprIfaceType ty)
224 ppr_tc_app _ IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
225 ppr_tc_app _ (IfaceTupTc bx arity) tys
226 | arity == length tys
227 = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
228 ppr_tc_app ctxt_prec tc tys
229 = maybeParen ctxt_prec tYCON_PREC
230 (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
232 ppr_tc :: IfaceTyCon -> SDoc
233 -- Wrap infix type constructors in parens
234 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
238 instance Outputable IfacePredType where
239 -- Print without parens
240 ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit ":=:"), ppr ty2]
241 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
242 ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
243 <+> sep (map pprParendIfaceType ts)
245 instance Outputable IfaceTyCon where
246 ppr (IfaceTc ext) = ppr ext
247 ppr other_tc = ppr (ifaceTyConName other_tc)
250 pprIfaceContext :: IfaceContext -> SDoc
251 -- Prints "(C a, D b) =>", including the arrow
252 pprIfaceContext [] = empty
253 pprIfaceContext theta = ppr_preds theta <+> ptext (sLit "=>")
255 ppr_preds :: [IfacePredType] -> SDoc
256 ppr_preds [pred] = ppr pred -- No parens
257 ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
260 pabrackets :: SDoc -> SDoc
261 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
264 %************************************************************************
266 Conversion from Type to IfaceType
268 %************************************************************************
272 toIfaceTvBndr :: TyVar -> (FastString, IfaceType)
273 toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
274 toIfaceIdBndr :: Id -> (FastString, IfaceType)
275 toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
276 toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)]
277 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
279 toIfaceBndr :: Var -> IfaceBndr
281 | isId var = IfaceIdBndr (toIfaceIdBndr var)
282 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
284 toIfaceKind :: Type -> IfaceType
285 toIfaceKind = toIfaceType
287 ---------------------
288 toIfaceType :: Type -> IfaceType
289 -- Synonyms are retained in the interface type
290 toIfaceType (TyVarTy tv) =
291 IfaceTyVar (occNameFS (getOccName tv))
292 toIfaceType (AppTy t1 t2) =
293 IfaceAppTy (toIfaceType t1) (toIfaceType t2)
294 toIfaceType (FunTy t1 t2) =
295 IfaceFunTy (toIfaceType t1) (toIfaceType t2)
296 toIfaceType (TyConApp tc tys) =
297 IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
298 toIfaceType (ForAllTy tv t) =
299 IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
300 toIfaceType (PredTy st) =
301 IfacePredTy (toIfacePred st)
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.
311 toIfaceTyCon :: TyCon -> IfaceTyCon
313 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
314 | otherwise = toIfaceTyCon_name (tyConName tc)
316 toIfaceTyCon_name :: Name -> IfaceTyCon
318 | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
319 = toIfaceWiredInTyCon tc nm
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
339 toIfaceTypes :: [Type] -> [IfaceType]
340 toIfaceTypes ts = map toIfaceType ts
343 toIfacePred :: PredType -> IfacePredType
344 toIfacePred (ClassP cls ts) =
345 IfaceClassP (getName cls) (toIfaceTypes ts)
346 toIfacePred (IParam ip t) =
347 IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
348 toIfacePred (EqPred ty1 ty2) =
349 IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
352 toIfaceContext :: ThetaType -> IfaceContext
353 toIfaceContext cs = map toIfacePred cs