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,
12 IfaceExtName(..), mkIfaceExtName, isLocalIfaceExtName,
15 -- Conversion from Type -> IfaceType
16 toIfaceType, toIfacePred, toIfaceContext,
17 toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
18 toIfaceTyCon, toIfaceTyCon_name,
21 pprIfaceType, pprParendIfaceType, pprIfaceContext,
22 pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
23 tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
27 #include "HsVersions.h"
30 import Coercion ( Coercion )
31 import TypeRep ( TyThing(..), Type(..), PredType(..), ThetaType,
32 unliftedTypeKindTyConName, openTypeKindTyConName,
33 ubxTupleKindTyConName, argTypeKindTyConName,
34 liftedTypeKindTyConName, isLiftedTypeKind )
35 import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
36 import Var ( isId, tyVarKind, idType )
37 import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
38 import OccName ( OccName, parenSymOcc, occNameFS )
39 import Name ( Name, getName, getOccName, nameModule, nameOccName,
40 wiredInNameTyThing_maybe )
41 import Module ( Module, ModuleName )
42 import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
48 %************************************************************************
52 %************************************************************************
56 = ExtPkg Module OccName
57 -- From an external package; no version # Also used for
58 -- wired-in things regardless of whether they are home-pkg or
61 | HomePkg ModuleName OccName Version
62 -- From another module in home package; has version #; in all
63 -- other respects, HomePkg and ExtPkg are the same. Since this
64 -- is a home package name, we use ModuleName rather than Module
66 | LocalTop OccName -- Top-level from the same module as
67 -- the enclosing IfaceDecl
69 | LocalTopSub -- Same as LocalTop, but for a class method or constr
70 OccName -- Class-meth/constr name
71 OccName -- Parent class/datatype name
72 -- LocalTopSub is written into iface files as LocalTop; the parent
73 -- info is only used when computing version information in MkIface
75 isLocalIfaceExtName :: IfaceExtName -> Bool
76 isLocalIfaceExtName (LocalTop _) = True
77 isLocalIfaceExtName (LocalTopSub _ _) = True
78 isLocalIfaceExtName other = False
80 mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name)
81 -- Local helper for wired-in names
83 ifaceExtOcc :: IfaceExtName -> OccName
84 ifaceExtOcc (ExtPkg _ occ) = occ
85 ifaceExtOcc (HomePkg _ occ _) = occ
86 ifaceExtOcc (LocalTop occ) = occ
87 ifaceExtOcc (LocalTopSub occ _) = occ
91 %************************************************************************
93 Local (nested) binders
95 %************************************************************************
98 data IfaceBndr -- Local (non-top-level) binders
99 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
100 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
102 type IfaceIdBndr = (FastString, IfaceType)
103 type IfaceTvBndr = (FastString, IfaceKind)
105 -------------------------------
106 type IfaceKind = IfaceType -- Re-use the Kind type, but no KindVars in it
108 type IfaceCoercion = IfaceType
111 = IfaceTyVar FastString -- Type variable only, not tycon
112 | IfaceAppTy IfaceType IfaceType
113 | IfaceForAllTy IfaceTvBndr IfaceType
114 | IfacePredTy IfacePredType
115 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
116 -- Includes newtypes, synonyms, tuples
117 | IfaceFunTy IfaceType IfaceType
119 data IfacePredType -- NewTypes are handled as ordinary TyConApps
120 = IfaceClassP IfaceExtName [IfaceType]
121 | IfaceIParam (IPName OccName) IfaceType
122 | IfaceEqPred IfaceType IfaceType
124 type IfaceContext = [IfacePredType]
126 -- NB: If you add a data constructor, remember to add a case to
128 data IfaceTyCon -- Abbreviations for common tycons with known names
129 = IfaceTc IfaceExtName -- The common case
130 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
131 | IfaceListTc | IfacePArrTc
132 | IfaceTupTc Boxity Arity
133 | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
134 | IfaceUbxTupleKindTc | IfaceArgTypeKindTc
136 ifaceTyConName :: IfaceTyCon -> Name -- Works for all except IfaceTc
137 ifaceTyConName IfaceIntTc = intTyConName
138 ifaceTyConName IfaceBoolTc = boolTyConName
139 ifaceTyConName IfaceCharTc = charTyConName
140 ifaceTyConName IfaceListTc = listTyConName
141 ifaceTyConName IfacePArrTc = parrTyConName
142 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
143 ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName
144 ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName
145 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
146 ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName
147 ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName
148 ifaceTyConName (IfaceTc ext) = pprPanic "ifaceTyConName" (ppr ext)
154 %************************************************************************
156 Functions over IFaceTypes
158 %************************************************************************
162 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
163 -- Mainly for printing purposes
167 (tvs, rho) = split_foralls ty
168 (theta, tau) = split_rho rho
170 split_foralls (IfaceForAllTy tv ty)
171 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
172 split_foralls rho = ([], rho)
174 split_rho (IfaceFunTy (IfacePredTy st) ty)
175 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
176 split_rho tau = ([], tau)
179 %************************************************************************
183 %************************************************************************
187 @ppr_ty@ takes an @Int@ that is the precedence of the context.
188 The precedence levels are:
190 \item[tOP_PREC] No parens required.
191 \item[fUN_PREC] Left hand argument of a function arrow.
192 \item[tYCON_PREC] Argument of a type constructor.
196 tOP_PREC = (0 :: Int) -- type in ParseIface.y
197 fUN_PREC = (1 :: Int) -- btype in ParseIface.y
198 tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
200 noParens :: SDoc -> SDoc
203 maybeParen ctxt_prec inner_prec pretty
204 | ctxt_prec < inner_prec = pretty
205 | otherwise = parens pretty
209 ----------------------------- Printing binders ------------------------------------
212 -- These instances are used only when printing for the user, either when
213 -- debugging, or in GHCi when printing the results of a :info command
214 instance Outputable IfaceExtName where
215 ppr (ExtPkg mod occ) = ppr mod <> dot <> ppr occ
216 ppr (HomePkg mod occ vers) = ppr mod <> dot <> ppr occ <> braces (ppr vers)
217 ppr (LocalTop occ) = ppr occ -- Do we want to distinguish these
218 ppr (LocalTopSub occ _) = ppr occ -- from an ordinary occurrence?
219 -- No need to worry about printing unqualified becuase that was handled
220 -- in the transiation to IfaceSyn
222 instance Outputable IfaceBndr where
223 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
224 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
226 pprIfaceBndrs :: [IfaceBndr] -> SDoc
227 pprIfaceBndrs bs = sep (map ppr bs)
229 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
231 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
232 pprIfaceTvBndr (tv, IfaceTyConApp IfaceLiftedTypeKindTc [])
234 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
235 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
236 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
239 ----------------------------- Printing IfaceType ------------------------------------
242 ---------------------------------
243 instance Outputable IfaceType where
244 ppr ty = pprIfaceTypeForUser ty
246 pprIfaceTypeForUser ::IfaceType -> SDoc
247 -- Drop top-level for-alls; if that's not what you want, use pprIfaceType dire
248 pprIfaceTypeForUser ty
249 = pprIfaceForAllPart [] theta (pprIfaceType tau)
251 (_tvs, theta, tau) = splitIfaceSigmaTy ty
253 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
254 pprIfaceType = ppr_ty tOP_PREC
255 pprParendIfaceType = ppr_ty tYCON_PREC
258 ppr_ty :: Int -> IfaceType -> SDoc
259 ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
260 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
261 ppr_ty ctxt_prec (IfacePredTy st) = ppr st
264 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
265 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
266 maybeParen ctxt_prec fUN_PREC $
267 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
269 ppr_fun_tail (IfaceFunTy ty1 ty2)
270 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
271 ppr_fun_tail other_ty
272 = [arrow <+> pprIfaceType other_ty]
274 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
275 = maybeParen ctxt_prec tYCON_PREC $
276 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
278 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
279 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
281 (tvs, theta, tau) = splitIfaceSigmaTy ty
284 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
285 pprIfaceForAllPart tvs ctxt doc
286 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
288 ppr_tvs | null tvs = empty
289 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
292 ppr_tc_app ctxt_prec tc [] = ppr_tc tc
293 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty)
294 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
295 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
296 | arity == length tys
297 = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
298 ppr_tc_app ctxt_prec tc tys
299 = maybeParen ctxt_prec tYCON_PREC
300 (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
302 ppr_tc :: IfaceTyCon -> SDoc
303 -- Wrap infix type constructors in parens
304 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (ifaceExtOcc ext_nm) (ppr tc)
308 instance Outputable IfacePredType where
309 -- Print without parens
310 ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext SLIT(":=:"), ppr ty2]
311 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
312 ppr (IfaceClassP cls ts) = parenSymOcc (ifaceExtOcc cls) (ppr cls)
313 <+> sep (map pprParendIfaceType ts)
315 instance Outputable IfaceTyCon where
316 ppr (IfaceTc ext) = ppr ext
317 ppr other_tc = ppr (ifaceTyConName other_tc)
320 pprIfaceContext :: IfaceContext -> SDoc
321 -- Prints "(C a, D b) =>", including the arrow
322 pprIfaceContext [] = empty
323 pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
325 ppr_preds [pred] = ppr pred -- No parens
326 ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
329 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
332 %************************************************************************
334 Conversion from Type to IfaceType
336 %************************************************************************
340 toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
341 toIfaceIdBndr ext id = (occNameFS (getOccName id), toIfaceType ext (idType id))
342 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
345 | isId var = IfaceIdBndr (toIfaceIdBndr ext var)
346 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
348 -- we had better not have to use ext for kinds
349 toIfaceKind = toIfaceType (\name -> pprPanic "toIfaceKind ext used on:" (ppr name))
351 ---------------------
352 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
353 -- Synonyms are retained in the interface type
354 toIfaceType ext (TyVarTy tv) = IfaceTyVar (occNameFS (getOccName tv))
355 toIfaceType ext (AppTy t1 t2) = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
356 toIfaceType ext (FunTy t1 t2) = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
357 toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon ext tc) (toIfaceTypes ext tys)
358 toIfaceType ext (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
359 toIfaceType ext (PredTy st) = IfacePredTy (toIfacePred ext st)
360 toIfaceType ext (NoteTy other_note ty) = toIfaceType ext ty
363 -- A little bit of (perhaps optional) trickiness here. When
364 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
365 -- they have a wired-in name. But we'd like to dump them into the Iface
366 -- as a tuple tycon, to save lookups when reading the interface
367 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
368 -- toIfaceTyCon_name will still catch it.
370 toIfaceTyCon :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
372 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
373 | otherwise = toIfaceTyCon_name ext (tyConName tc)
375 toIfaceTyCon_name :: (Name -> IfaceExtName) -> Name -> IfaceTyCon
376 toIfaceTyCon_name ext nm
377 | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
378 = toIfaceWiredInTyCon ext tc nm
382 toIfaceWiredInTyCon :: (Name -> IfaceExtName) -> TyCon -> Name -> IfaceTyCon
383 toIfaceWiredInTyCon ext tc nm
384 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
385 | nm == intTyConName = IfaceIntTc
386 | nm == boolTyConName = IfaceBoolTc
387 | nm == charTyConName = IfaceCharTc
388 | nm == listTyConName = IfaceListTc
389 | nm == parrTyConName = IfacePArrTc
390 | nm == liftedTypeKindTyConName = IfaceLiftedTypeKindTc
391 | nm == unliftedTypeKindTyConName = IfaceUnliftedTypeKindTc
392 | nm == openTypeKindTyConName = IfaceOpenTypeKindTc
393 | nm == argTypeKindTyConName = IfaceArgTypeKindTc
394 | nm == ubxTupleKindTyConName = IfaceUbxTupleKindTc
395 | otherwise = IfaceTc (ext nm)
398 toIfaceTypes ext ts = map (toIfaceType ext) ts
401 toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
402 toIfacePred ext (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
403 toIfacePred ext (EqPred ty1 ty2) = IfaceEqPred (toIfaceType ext ty1) (toIfaceType ext ty2)
406 toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
407 toIfaceContext ext cs = map (toIfacePred ext) cs