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 -- 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
17 IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
18 IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
21 -- Conversion from Type -> IfaceType
22 toIfaceType, toIfacePred, toIfaceContext,
23 toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
24 toIfaceTyCon, toIfaceTyCon_name,
27 pprIfaceType, pprParendIfaceType, pprIfaceContext,
28 pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
29 tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
33 #include "HsVersions.h"
45 %************************************************************************
47 Local (nested) binders
49 %************************************************************************
52 data IfaceBndr -- Local (non-top-level) binders
53 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
54 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
56 type IfaceIdBndr = (FastString, IfaceType)
57 type IfaceTvBndr = (FastString, IfaceKind)
59 -------------------------------
60 type IfaceKind = IfaceType
61 type IfaceCoercion = IfaceType
64 = IfaceTyVar FastString -- Type variable only, not tycon
65 | IfaceAppTy IfaceType IfaceType
66 | IfaceForAllTy IfaceTvBndr IfaceType
67 | IfacePredTy IfacePredType
68 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
69 -- Includes newtypes, synonyms, tuples
70 | IfaceFunTy IfaceType IfaceType
72 data IfacePredType -- NewTypes are handled as ordinary TyConApps
73 = IfaceClassP Name [IfaceType]
74 | IfaceIParam (IPName OccName) IfaceType
75 | IfaceEqPred IfaceType IfaceType
77 type IfaceContext = [IfacePredType]
79 -- NB: If you add a data constructor, remember to add a case to
81 data IfaceTyCon -- Abbreviations for common tycons with known names
82 = IfaceTc Name -- The common case
83 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
84 | IfaceListTc | IfacePArrTc
85 | IfaceTupTc Boxity Arity
86 | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
87 | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
90 ifaceTyConName :: IfaceTyCon -> Name
91 ifaceTyConName IfaceIntTc = intTyConName
92 ifaceTyConName IfaceBoolTc = boolTyConName
93 ifaceTyConName IfaceCharTc = charTyConName
94 ifaceTyConName IfaceListTc = listTyConName
95 ifaceTyConName IfacePArrTc = parrTyConName
96 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
97 ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName
98 ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName
99 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
100 ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName
101 ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName
102 ifaceTyConName (IfaceTc ext) = ext
106 %************************************************************************
108 Functions over IFaceTypes
110 %************************************************************************
114 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
115 -- Mainly for printing purposes
119 (tvs, rho) = split_foralls ty
120 (theta, tau) = split_rho rho
122 split_foralls (IfaceForAllTy tv ty)
123 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
124 split_foralls rho = ([], rho)
126 split_rho (IfaceFunTy (IfacePredTy st) ty)
127 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
128 split_rho tau = ([], tau)
131 %************************************************************************
135 %************************************************************************
139 @ppr_ty@ takes an @Int@ that is the precedence of the context.
140 The precedence levels are:
142 \item[tOP_PREC] No parens required.
143 \item[fUN_PREC] Left hand argument of a function arrow.
144 \item[tYCON_PREC] Argument of a type constructor.
148 tOP_PREC = (0 :: Int) -- type in ParseIface.y
149 fUN_PREC = (1 :: Int) -- btype in ParseIface.y
150 tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
152 noParens :: SDoc -> SDoc
155 maybeParen ctxt_prec inner_prec pretty
156 | ctxt_prec < inner_prec = pretty
157 | otherwise = parens pretty
161 ----------------------------- Printing binders ------------------------------------
164 instance Outputable IfaceBndr where
165 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
166 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
168 pprIfaceBndrs :: [IfaceBndr] -> SDoc
169 pprIfaceBndrs bs = sep (map ppr bs)
171 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
173 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
174 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
176 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
177 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
178 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
181 ----------------------------- Printing IfaceType ------------------------------------
184 ---------------------------------
185 instance Outputable IfaceType where
186 ppr ty = pprIfaceType ty
188 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
189 pprIfaceType = ppr_ty tOP_PREC
190 pprParendIfaceType = ppr_ty tYCON_PREC
193 ppr_ty :: Int -> IfaceType -> SDoc
194 ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
195 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
196 ppr_ty ctxt_prec (IfacePredTy st) = ppr st
199 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
200 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
201 maybeParen ctxt_prec fUN_PREC $
202 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
204 ppr_fun_tail (IfaceFunTy ty1 ty2)
205 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
206 ppr_fun_tail other_ty
207 = [arrow <+> pprIfaceType other_ty]
209 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
210 = maybeParen ctxt_prec tYCON_PREC $
211 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
213 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
214 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
216 (tvs, theta, tau) = splitIfaceSigmaTy ty
219 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
220 pprIfaceForAllPart tvs ctxt doc
221 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
223 ppr_tvs | null tvs = empty
224 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
227 ppr_tc_app ctxt_prec tc [] = ppr_tc tc
228 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty)
229 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
230 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
231 | arity == length tys
232 = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
233 ppr_tc_app ctxt_prec tc tys
234 = maybeParen ctxt_prec tYCON_PREC
235 (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
237 ppr_tc :: IfaceTyCon -> SDoc
238 -- Wrap infix type constructors in parens
239 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
243 instance Outputable IfacePredType where
244 -- Print without parens
245 ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext SLIT(":=:"), ppr ty2]
246 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
247 ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls)
248 <+> sep (map pprParendIfaceType ts)
250 instance Outputable IfaceTyCon where
251 ppr (IfaceTc ext) = ppr ext
252 ppr other_tc = ppr (ifaceTyConName other_tc)
255 pprIfaceContext :: IfaceContext -> SDoc
256 -- Prints "(C a, D b) =>", including the arrow
257 pprIfaceContext [] = empty
258 pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
260 ppr_preds [pred] = ppr pred -- No parens
261 ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
264 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
267 %************************************************************************
269 Conversion from Type to IfaceType
271 %************************************************************************
275 toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
276 toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
277 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
280 | isId var = IfaceIdBndr (toIfaceIdBndr var)
281 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
283 toIfaceKind = toIfaceType
285 ---------------------
286 toIfaceType :: Type -> IfaceType
287 -- Synonyms are retained in the interface type
288 toIfaceType (TyVarTy tv) =
289 IfaceTyVar (occNameFS (getOccName tv))
290 toIfaceType (AppTy t1 t2) =
291 IfaceAppTy (toIfaceType t1) (toIfaceType t2)
292 toIfaceType (FunTy t1 t2) =
293 IfaceFunTy (toIfaceType t1) (toIfaceType t2)
294 toIfaceType (TyConApp tc tys) =
295 IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
296 toIfaceType (ForAllTy tv t) =
297 IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
298 toIfaceType (PredTy st) =
299 IfacePredTy (toIfacePred st)
300 toIfaceType (NoteTy other_note ty) =
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 ts = map toIfaceType ts
342 toIfacePred (ClassP cls ts) =
343 IfaceClassP (getName cls) (toIfaceTypes ts)
344 toIfacePred (IParam ip t) =
345 IfaceIParam (mapIPName getOccName ip) (toIfaceType t)
346 toIfacePred (EqPred ty1 ty2) =
347 IfaceEqPred (toIfaceType ty1) (toIfaceType ty2)
350 toIfaceContext :: ThetaType -> IfaceContext
351 toIfaceContext cs = map toIfacePred cs