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
37 %************************************************************************
39 Local (nested) binders
41 %************************************************************************
44 data IfaceBndr -- Local (non-top-level) binders
45 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
46 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
48 type IfaceIdBndr = (FastString, IfaceType)
49 type IfaceTvBndr = (FastString, IfaceKind)
51 -------------------------------
52 type IfaceKind = IfaceType
53 type IfaceCoercion = IfaceType
56 = IfaceTyVar FastString -- Type variable only, not tycon
57 | IfaceAppTy IfaceType IfaceType
58 | IfaceForAllTy IfaceTvBndr IfaceType
59 | IfacePredTy IfacePredType
60 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
61 -- Includes newtypes, synonyms, tuples
62 | IfaceFunTy IfaceType IfaceType
64 data IfacePredType -- NewTypes are handled as ordinary TyConApps
65 = IfaceClassP Name [IfaceType]
66 | IfaceIParam (IPName OccName) IfaceType
67 | IfaceEqPred IfaceType IfaceType
69 type IfaceContext = [IfacePredType]
71 data IfaceTyCon -- Abbreviations for common tycons with known names
72 = IfaceTc Name -- The common case
73 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
74 | IfaceListTc | IfacePArrTc
75 | IfaceTupTc Boxity Arity
76 | IfaceAnyTc IfaceKind -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
77 | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
78 | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
80 ifaceTyConName :: IfaceTyCon -> Name
81 ifaceTyConName IfaceIntTc = intTyConName
82 ifaceTyConName IfaceBoolTc = boolTyConName
83 ifaceTyConName IfaceCharTc = charTyConName
84 ifaceTyConName IfaceListTc = listTyConName
85 ifaceTyConName IfacePArrTc = parrTyConName
86 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
87 ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName
88 ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName
89 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
90 ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName
91 ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName
92 ifaceTyConName (IfaceTc ext) = ext
93 ifaceTyConName (IfaceAnyTc kind) = pprPanic "ifaceTyConName" (ppr (IfaceAnyTc kind))
94 -- Note [The Name of an IfaceAnyTc]
97 Note [The Name of an IfaceAnyTc]
98 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
99 It isn't easy to get the Name of an IfaceAnyTc in a pure way. What you
100 really need to do is to transform it to a TyCon, and get the Name of that.
101 But doing so needs the monad.
103 In fact, ifaceTyConName is only used for instances and rules, and we don't
104 expect to instantiate those at these (internal-ish) Any types, so rather
105 than solve this potential problem now, I'm going to defer it until it happens!
107 %************************************************************************
109 Functions over IFaceTypes
111 %************************************************************************
115 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
116 -- Mainly for printing purposes
120 (tvs, rho) = split_foralls ty
121 (theta, tau) = split_rho rho
123 split_foralls (IfaceForAllTy tv ty)
124 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
125 split_foralls rho = ([], rho)
127 split_rho (IfaceFunTy (IfacePredTy st) ty)
128 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
129 split_rho tau = ([], tau)
132 %************************************************************************
136 %************************************************************************
140 @ppr_ty@ takes an @Int@ that is the precedence of the context.
141 The precedence levels are:
143 \item[tOP_PREC] No parens required.
144 \item[fUN_PREC] Left hand argument of a function arrow.
145 \item[tYCON_PREC] Argument of a type constructor.
149 tOP_PREC, fUN_PREC, tYCON_PREC :: Int
150 tOP_PREC = 0 -- type in ParseIface.y
151 fUN_PREC = 1 -- btype in ParseIface.y
152 tYCON_PREC = 2 -- atype in ParseIface.y
154 noParens :: SDoc -> SDoc
157 maybeParen :: Int -> Int -> SDoc -> SDoc
158 maybeParen ctxt_prec inner_prec pretty
159 | ctxt_prec < inner_prec = pretty
160 | otherwise = parens pretty
164 ----------------------------- Printing binders ------------------------------------
167 instance Outputable IfaceBndr where
168 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
169 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
171 pprIfaceBndrs :: [IfaceBndr] -> SDoc
172 pprIfaceBndrs bs = sep (map ppr bs)
174 pprIfaceIdBndr :: (FastString, IfaceType) -> SDoc
175 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
177 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
178 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
180 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
181 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
182 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
185 ----------------------------- Printing IfaceType ------------------------------------
188 ---------------------------------
189 instance Outputable IfaceType where
190 ppr ty = pprIfaceType ty
192 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
193 pprIfaceType = ppr_ty tOP_PREC
194 pprParendIfaceType = ppr_ty tYCON_PREC
197 ppr_ty :: Int -> IfaceType -> SDoc
198 ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar
199 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
200 ppr_ty _ (IfacePredTy st) = ppr st
203 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
204 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
205 maybeParen ctxt_prec fUN_PREC $
206 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
208 ppr_fun_tail (IfaceFunTy ty1 ty2)
209 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
210 ppr_fun_tail other_ty
211 = [arrow <+> pprIfaceType other_ty]
213 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
214 = maybeParen ctxt_prec tYCON_PREC $
215 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
217 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
218 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
220 (tvs, theta, tau) = splitIfaceSigmaTy ty
223 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
224 pprIfaceForAllPart tvs ctxt doc
225 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
227 ppr_tvs | null tvs = empty
228 | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
231 ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc
232 ppr_tc_app _ tc [] = ppr_tc tc
233 ppr_tc_app _ IfaceListTc [ty] = brackets (pprIfaceType ty)
234 ppr_tc_app _ IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
235 ppr_tc_app _ (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 :: [IfacePredType] -> SDoc
266 ppr_preds [pred] = ppr pred -- No parens
267 ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
270 pabrackets :: SDoc -> SDoc
271 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
274 %************************************************************************
276 Conversion from Type to IfaceType
278 %************************************************************************
282 toIfaceTvBndr :: TyVar -> (FastString, IfaceType)
283 toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
284 toIfaceIdBndr :: Id -> (FastString, IfaceType)
285 toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
286 toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)]
287 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
289 toIfaceBndr :: Var -> IfaceBndr
291 | isId var = IfaceIdBndr (toIfaceIdBndr var)
292 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
294 toIfaceKind :: Type -> IfaceType
295 toIfaceKind = toIfaceType
297 ---------------------
298 toIfaceType :: Type -> IfaceType
299 -- Synonyms are retained in the interface type
300 toIfaceType (TyVarTy tv) =
301 IfaceTyVar (occNameFS (getOccName tv))
302 toIfaceType (AppTy t1 t2) =
303 IfaceAppTy (toIfaceType t1) (toIfaceType t2)
304 toIfaceType (FunTy t1 t2) =
305 IfaceFunTy (toIfaceType t1) (toIfaceType t2)
306 toIfaceType (TyConApp tc tys) =
307 IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
308 toIfaceType (ForAllTy tv t) =
309 IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
310 toIfaceType (PredTy st) =
311 IfacePredTy (toIfacePred st)
314 -- A little bit of (perhaps optional) trickiness here. When
315 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
316 -- they have a wired-in name. But we'd like to dump them into the Iface
317 -- as a tuple tycon, to save lookups when reading the interface
318 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
319 -- toIfaceTyCon_name will still catch it.
321 toIfaceTyCon :: TyCon -> IfaceTyCon
323 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
324 | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc))
325 | otherwise = toIfaceTyCon_name (tyConName tc)
327 toIfaceTyCon_name :: Name -> IfaceTyCon
329 | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
330 = toIfaceWiredInTyCon tc nm
334 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
335 toIfaceWiredInTyCon tc nm
336 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
337 | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc))
338 | nm == intTyConName = IfaceIntTc
339 | nm == boolTyConName = IfaceBoolTc
340 | nm == charTyConName = IfaceCharTc
341 | nm == listTyConName = IfaceListTc
342 | nm == parrTyConName = IfacePArrTc
343 | nm == liftedTypeKindTyConName = IfaceLiftedTypeKindTc
344 | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
345 | nm == openTypeKindTyConName = IfaceOpenTypeKindTc
346 | nm == argTypeKindTyConName = IfaceArgTypeKindTc
347 | nm == ubxTupleKindTyConName = IfaceUbxTupleKindTc
348 | otherwise = IfaceTc nm
351 toIfaceTypes :: [Type] -> [IfaceType]
352 toIfaceTypes ts = map toIfaceType ts
355 toIfacePred :: PredType -> IfacePredType
356 toIfacePred (ClassP cls ts) =
357 IfaceClassP (getName cls) (toIfaceTypes ts)
358 toIfacePred (IParam ip t) =
359 IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
360 toIfacePred (EqPred ty1 ty2) =
361 IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
364 toIfaceContext :: ThetaType -> IfaceContext
365 toIfaceContext cs = map toIfacePred cs