2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
5 This module defines intereace types and binders
9 IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
10 IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
12 IfaceExtName(..), mkIfaceExtName, ifaceTyConName,
14 -- Conversion from Type -> IfaceType
15 toIfaceType, toIfacePred, toIfaceContext,
16 toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
19 pprIfaceType, pprParendIfaceType, pprIfaceContext,
20 pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
22 tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
26 #include "HsVersions.h"
28 import Kind ( Kind(..) )
29 import TypeRep ( Type(..), TyNote(..), PredType(..), Kind, ThetaType )
30 import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
31 import Var ( isId, tyVarKind, idType )
32 import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
33 import OccName ( OccName )
34 import Name ( Name, getName, getOccName, nameModuleName, nameOccName, isInternalName )
35 import Module ( ModuleName )
36 import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
42 %************************************************************************
46 %************************************************************************
50 = ExtPkg ModuleName OccName -- From an external package; no version #
51 -- Also used for wired-in things regardless
52 -- of whether they are home-pkg or not
54 | HomePkg ModuleName OccName Version -- From another module in home package;
57 | LocalTop OccName -- Top-level from the same module as
58 -- the enclosing IfaceDecl
60 | LocalTopSub -- Same as LocalTop, but for a class method or constr
61 OccName -- Class-meth/constr name
62 OccName -- Parent class/datatype name
63 -- LocalTopSub is written into iface files as LocalTop; the parent
64 -- info is only used when computing version information in MkIface
66 mkIfaceExtName name = ExtPkg (nameModuleName name) (nameOccName name)
67 -- Local helper for wired-in names
71 %************************************************************************
73 Local (nested) binders
75 %************************************************************************
78 data IfaceBndr -- Local (non-top-level) binders
79 = IfaceIdBndr IfaceIdBndr
80 | IfaceTvBndr IfaceTvBndr
82 type IfaceIdBndr = (OccName, IfaceType) -- OccName, because always local
83 type IfaceTvBndr = (OccName, IfaceKind)
85 -------------------------------
86 type IfaceKind = Kind -- Re-use the Kind type, but no KindVars in it
89 = IfaceTyVar OccName -- Type variable only, not tycon
90 | IfaceAppTy IfaceType IfaceType
91 | IfaceForAllTy IfaceTvBndr IfaceType
92 | IfacePredTy IfacePredType
93 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
94 -- Includes newtypes, synonyms, tuples
95 | IfaceFunTy IfaceType IfaceType
97 data IfacePredType -- NewTypes are handled as ordinary TyConApps
98 = IfaceClassP IfaceExtName [IfaceType]
99 | IfaceIParam (IPName OccName) IfaceType
101 type IfaceContext = [IfacePredType]
103 data IfaceTyCon -- Abbreviations for common tycons with known names
104 = IfaceTc IfaceExtName -- The common case
105 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
106 | IfaceListTc | IfacePArrTc
107 | IfaceTupTc Boxity Arity
109 ifaceTyConName :: IfaceTyCon -> Name -- Works for all except IfaceTc
110 ifaceTyConName IfaceIntTc = intTyConName
111 ifaceTyConName IfaceBoolTc = boolTyConName
112 ifaceTyConName IfaceCharTc = charTyConName
113 ifaceTyConName IfaceListTc = listTyConName
114 ifaceTyConName IfacePArrTc = parrTyConName
115 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
116 ifaceTyConName (IfaceTc ext) = pprPanic "ifaceTyConName" (ppr ext)
120 %************************************************************************
122 Functions over IFaceTypes
124 %************************************************************************
128 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
129 -- Mainly for printing purposes
133 (tvs, rho) = split_foralls ty
134 (theta, tau) = split_rho rho
136 split_foralls (IfaceForAllTy tv ty)
137 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
138 split_foralls rho = ([], rho)
140 split_rho (IfaceFunTy (IfacePredTy st) ty)
141 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
142 split_rho tau = ([], tau)
145 %************************************************************************
149 %************************************************************************
153 @ppr_ty@ takes an @Int@ that is the precedence of the context.
154 The precedence levels are:
156 \item[tOP_PREC] No parens required.
157 \item[fUN_PREC] Left hand argument of a function arrow.
158 \item[tYCON_PREC] Argument of a type constructor.
162 tOP_PREC = (0 :: Int) -- type in ParseIface.y
163 fUN_PREC = (1 :: Int) -- btype in ParseIface.y
164 tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
166 noParens :: SDoc -> SDoc
169 maybeParen ctxt_prec inner_prec pretty
170 | ctxt_prec < inner_prec = pretty
171 | otherwise = parens pretty
175 ----------------------------- Printing binders ------------------------------------
178 instance Outputable IfaceExtName where
179 ppr (ExtPkg mod occ) = ppr mod <> dot <> ppr occ
180 ppr (HomePkg mod occ vers) = ppr mod <> dot <> ppr occ <> braces (ppr vers)
181 ppr (LocalTop occ) = ppr occ -- Do we want to distinguish these
182 ppr (LocalTopSub occ _) = ppr occ -- from an ordinary occurrence?
184 getIfaceExt :: ((Name -> IfaceExtName) -> SDoc) -> SDoc
185 -- Uses the print-unqual info from the SDoc to make an 'ext'
186 -- which in turn tells toIfaceType when to make a qualified name
187 -- This is only used when making Iface stuff to print out for the user;
188 -- e.g. we use this in pprType
189 getIfaceExt thing_inside
190 = getPprStyle $ \ sty ->
192 ext nm | unqualStyle sty nm = LocalTop (nameOccName nm)
193 | isInternalName nm = LocalTop (nameOccName nm)
194 -- This only happens for Kind constructors, which
195 -- don't come from any particular module and are unqualified
196 -- This hack will go away when kinds are separated from types
197 | otherwise = ExtPkg (nameModuleName nm) (nameOccName nm)
201 instance Outputable IfaceBndr where
202 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
203 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
205 pprIfaceBndrs :: [IfaceBndr] -> SDoc
206 pprIfaceBndrs bs = sep (map ppr bs)
208 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
210 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
211 pprIfaceTvBndr (tv, LiftedTypeKind) = ppr tv
212 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
214 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
215 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
218 ----------------------------- Printing IfaceType ------------------------------------
221 ---------------------------------
222 instance Outputable IfaceType where
225 ppr_ty = pprIfaceType tOP_PREC
226 pprParendIfaceType = pprIfaceType tYCON_PREC
228 pprIfaceType :: Int -> IfaceType -> SDoc
232 pprIfaceType ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
233 pprIfaceType ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
234 pprIfaceType ctxt_prec (IfacePredTy st) = braces (ppr st)
237 pprIfaceType ctxt_prec (IfaceFunTy ty1 ty2)
238 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
239 maybeParen ctxt_prec fUN_PREC $
240 sep (pprIfaceType fUN_PREC ty1 : ppr_fun_tail ty2)
242 ppr_fun_tail (IfaceFunTy ty1 ty2)
243 = (arrow <+> pprIfaceType fUN_PREC ty1) : ppr_fun_tail ty2
244 ppr_fun_tail other_ty
245 = [arrow <+> ppr_ty other_ty]
247 pprIfaceType ctxt_prec (IfaceAppTy ty1 ty2)
248 = maybeParen ctxt_prec tYCON_PREC $
249 pprIfaceType fUN_PREC ty1 <+> pprParendIfaceType ty2
251 pprIfaceType ctxt_prec ty@(IfaceForAllTy _ _)
252 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (ppr_ty tau))
254 (tvs, theta, tau) = splitIfaceSigmaTy ty
257 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
258 pprIfaceForAllPart tvs ctxt doc
259 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
261 ppr_tvs | null tvs = empty
262 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
265 ppr_tc_app ctxt_prec tc [] = ppr tc
266 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (ppr_ty ty)
267 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (ppr_ty ty)
268 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
269 | arity == length tys
270 = tupleParens bx (sep (punctuate comma (map ppr_ty tys)))
271 ppr_tc_app ctxt_prec tc tys
272 = maybeParen ctxt_prec tYCON_PREC
273 (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
276 instance Outputable IfacePredType where
277 -- Print without parens
278 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
279 ppr (IfaceClassP cls ts) = ppr cls <+> sep (map pprParendIfaceType ts)
281 instance Outputable IfaceTyCon where
282 ppr (IfaceTc ext) = ppr ext
283 ppr other_tc = ppr (ifaceTyConName other_tc)
286 pprIfaceContext :: IfaceContext -> SDoc
287 -- Prints "(C a, D b) =>", including the arrow
288 pprIfaceContext [] = empty
289 pprIfaceContext theta = parens (sep (punctuate comma (map ppr theta)))
292 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
295 %************************************************************************
297 Conversion from Type to IfaceType
299 %************************************************************************
303 toIfaceTvBndr tyvar = (getOccName tyvar, tyVarKind tyvar)
304 toIfaceIdBndr ext id = (getOccName id, toIfaceType ext (idType id))
305 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
308 | isId var = IfaceIdBndr (toIfaceIdBndr ext var)
309 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
311 ---------------------
312 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
313 toIfaceType ext (TyVarTy tv) = IfaceTyVar (getOccName tv)
314 toIfaceType ext (AppTy t1 t2) = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
315 toIfaceType ext (FunTy t1 t2) = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
316 toIfaceType ext (NewTcApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
317 toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
318 toIfaceType ext (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
319 toIfaceType ext (PredTy st) = IfacePredTy (toIfacePred ext st)
320 toIfaceType ext (NoteTy (SynNote tc_app) ty) = toIfaceType ext tc_app
321 toIfaceType ext (NoteTy other_note ty) = toIfaceType ext ty
324 mkIfaceTc :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
326 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
327 | nm == intTyConName = IfaceIntTc
328 | nm == boolTyConName = IfaceBoolTc
329 | nm == charTyConName = IfaceCharTc
330 | nm == listTyConName = IfaceListTc
331 | nm == parrTyConName = IfacePArrTc
332 | otherwise = IfaceTc (ext nm)
337 toIfaceTypes ext ts = map (toIfaceType ext) ts
340 toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
341 toIfacePred ext (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
344 toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
345 toIfaceContext ext cs = map (toIfacePred ext) cs