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, toIfaceKind, toIfacePred, toIfaceContext,
16 toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
19 pprIfaceKind, pprParendIfaceKind,
20 pprIfaceType, pprParendIfaceType, pprIfaceContext,
21 pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
23 tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
27 #include "HsVersions.h"
29 import Type ( openTypeKind, liftedTypeKind, unliftedTypeKind,
30 splitFunTy_maybe, eqKind )
31 import TypeRep ( Type(..), TyNote(..), PredType(..), Kind, ThetaType )
32 import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
33 import Var ( isId, tyVarKind, idType )
34 import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
35 import OccName ( OccName )
36 import Name ( Name, getName, getOccName, nameModuleName, nameOccName, isInternalName )
37 import Module ( ModuleName )
38 import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
43 import TypeRep( crudePprType )
48 %************************************************************************
52 %************************************************************************
56 = ExtPkg ModuleName OccName -- From an external package; no version #
57 -- Also used for wired-in things regardless
58 -- of whether they are home-pkg or not
60 | HomePkg ModuleName OccName Version -- From another module in home package;
63 | LocalTop OccName -- Top-level from the same module as
64 -- the enclosing IfaceDecl
66 | LocalTopSub -- Same as LocalTop, but for a class method or constr
67 OccName -- Class-meth/constr name
68 OccName -- Parent class/datatype name
69 -- LocalTopSub is written into iface files as LocalTop; the parent
70 -- info is only used when computing version information in MkIface
72 mkIfaceExtName name = ExtPkg (nameModuleName name) (nameOccName name)
73 -- Local helper for wired-in names
77 %************************************************************************
79 Local (nested) binders
81 %************************************************************************
84 data IfaceBndr -- Local (non-top-level) binders
85 = IfaceIdBndr IfaceIdBndr
86 | IfaceTvBndr IfaceTvBndr
88 type IfaceIdBndr = (OccName, IfaceType) -- OccName, because always local
89 type IfaceTvBndr = (OccName, IfaceKind)
91 -------------------------------
95 | IfaceUnliftedTypeKind
96 | IfaceFunKind IfaceKind IfaceKind
99 -------------------------------
101 = IfaceTyVar OccName -- Type variable only, not tycon
102 | IfaceAppTy IfaceType IfaceType
103 | IfaceForAllTy IfaceTvBndr IfaceType
104 | IfacePredTy IfacePredType
105 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
106 -- Includes newtypes, synonyms, tuples
107 | IfaceFunTy IfaceType IfaceType
109 data IfacePredType -- NewTypes are handled as ordinary TyConApps
110 = IfaceClassP IfaceExtName [IfaceType]
111 | IfaceIParam (IPName OccName) IfaceType
113 type IfaceContext = [IfacePredType]
115 data IfaceTyCon -- Abbreviations for common tycons with known names
116 = IfaceTc IfaceExtName -- The common case
117 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
118 | IfaceListTc | IfacePArrTc
119 | IfaceTupTc Boxity Arity
121 ifaceTyConName :: IfaceTyCon -> Name -- Works for all except IfaceTc
122 ifaceTyConName IfaceIntTc = intTyConName
123 ifaceTyConName IfaceBoolTc = boolTyConName
124 ifaceTyConName IfaceCharTc = charTyConName
125 ifaceTyConName IfaceListTc = listTyConName
126 ifaceTyConName IfacePArrTc = parrTyConName
127 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
128 ifaceTyConName (IfaceTc ext) = pprPanic "ifaceTyConName" (ppr ext)
132 %************************************************************************
134 Functions over IFaceTypes
136 %************************************************************************
140 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
141 -- Mainly for printing purposes
145 (tvs, rho) = split_foralls ty
146 (theta, tau) = split_rho rho
148 split_foralls (IfaceForAllTy tv ty)
149 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
150 split_foralls rho = ([], rho)
152 split_rho (IfaceFunTy (IfacePredTy st) ty)
153 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
154 split_rho tau = ([], tau)
157 %************************************************************************
161 %************************************************************************
165 @ppr_ty@ takes an @Int@ that is the precedence of the context.
166 The precedence levels are:
168 \item[tOP_PREC] No parens required.
169 \item[fUN_PREC] Left hand argument of a function arrow.
170 \item[tYCON_PREC] Argument of a type constructor.
174 tOP_PREC = (0 :: Int) -- type in ParseIface.y
175 fUN_PREC = (1 :: Int) -- btype in ParseIface.y
176 tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
178 noParens :: SDoc -> SDoc
181 maybeParen ctxt_prec inner_prec pretty
182 | ctxt_prec < inner_prec = pretty
183 | otherwise = parens pretty
187 ----------------------------- Printing binders ------------------------------------
190 instance Outputable IfaceExtName where
191 ppr (ExtPkg mod occ) = ppr mod <> dot <> ppr occ
192 ppr (HomePkg mod occ vers) = ppr mod <> dot <> ppr occ <> braces (ppr vers)
193 ppr (LocalTop occ) = ppr occ -- Do we want to distinguish these
194 ppr (LocalTopSub occ _) = ppr occ -- from an ordinary occurrence?
196 getIfaceExt :: ((Name -> IfaceExtName) -> SDoc) -> SDoc
197 -- Uses the print-unqual info from the SDoc to make an 'ext'
198 -- which in turn tells toIfaceType when to make a qualified name
199 -- This is only used when making Iface stuff to print out for the user;
200 -- e.g. we use this in pprType
201 getIfaceExt thing_inside
202 = getPprStyle $ \ sty ->
204 ext nm | unqualStyle sty nm = LocalTop (nameOccName nm)
205 | isInternalName nm = LocalTop (nameOccName nm)
206 -- This only happens for Kind constructors, which
207 -- don't come from any particular module and are unqualified
208 -- This hack will go away when kinds are separated from types
209 | otherwise = ExtPkg (nameModuleName nm) (nameOccName nm)
213 instance Outputable IfaceBndr where
214 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
215 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
217 pprIfaceBndrs :: [IfaceBndr] -> SDoc
218 pprIfaceBndrs bs = sep (map ppr bs)
220 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
222 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
223 pprIfaceTvBndr (tv, IfaceLiftedTypeKind) = ppr tv
224 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
226 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
227 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
230 ----------------------------- Printing IfaceType ------------------------------------
233 ---------------------------------
234 instance Outputable IfaceKind where
235 ppr k = pprIfaceKind tOP_PREC k
237 pprParendIfaceKind :: IfaceKind -> SDoc
238 pprParendIfaceKind k = pprIfaceKind tYCON_PREC k
240 pprIfaceKind prec IfaceLiftedTypeKind = ptext SLIT("*")
241 pprIfaceKind prec IfaceUnliftedTypeKind = ptext SLIT("#")
242 pprIfaceKind prec IfaceOpenTypeKind = ptext SLIT("?")
243 pprIfaceKind prec (IfaceFunKind k1 k2) = maybeParen prec fUN_PREC $
244 sep [ pprIfaceKind fUN_PREC k1, arrow <+> ppr k2]
246 ---------------------------------
247 instance Outputable IfaceType where
250 ppr_ty = pprIfaceType tOP_PREC
251 pprParendIfaceType = pprIfaceType tYCON_PREC
253 pprIfaceType :: Int -> IfaceType -> SDoc
257 pprIfaceType ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
258 pprIfaceType ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
259 pprIfaceType ctxt_prec (IfacePredTy st) = braces (ppr st)
262 pprIfaceType ctxt_prec (IfaceFunTy ty1 ty2)
263 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
264 maybeParen ctxt_prec fUN_PREC $
265 sep (pprIfaceType fUN_PREC ty1 : ppr_fun_tail ty2)
267 ppr_fun_tail (IfaceFunTy ty1 ty2)
268 = (arrow <+> pprIfaceType fUN_PREC ty1) : ppr_fun_tail ty2
269 ppr_fun_tail other_ty
270 = [arrow <+> ppr_ty other_ty]
272 pprIfaceType ctxt_prec (IfaceAppTy ty1 ty2)
273 = maybeParen ctxt_prec tYCON_PREC $
274 pprIfaceType fUN_PREC ty1 <+> pprParendIfaceType ty2
276 pprIfaceType ctxt_prec ty@(IfaceForAllTy _ _)
277 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (ppr_ty tau))
279 (tvs, theta, tau) = splitIfaceSigmaTy ty
282 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
283 pprIfaceForAllPart tvs ctxt doc
284 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
286 ppr_tvs | null tvs = empty
287 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
290 ppr_tc_app ctxt_prec tc [] = ppr tc
291 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (ppr_ty ty)
292 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (ppr_ty ty)
293 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
294 | arity == length tys
295 = tupleParens bx (sep (punctuate comma (map ppr_ty tys)))
296 ppr_tc_app ctxt_prec tc tys
297 = maybeParen ctxt_prec tYCON_PREC
298 (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
301 instance Outputable IfacePredType where
302 -- Print without parens
303 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
304 ppr (IfaceClassP cls ts) = ppr cls <+> sep (map pprParendIfaceType ts)
306 instance Outputable IfaceTyCon where
307 ppr (IfaceTc ext) = ppr ext
308 ppr other_tc = ppr (ifaceTyConName other_tc)
311 pprIfaceContext :: IfaceContext -> SDoc
312 -- Prints "(C a, D b) =>", including the arrow
313 pprIfaceContext [] = empty
314 pprIfaceContext theta = parens (sep (punctuate comma (map ppr theta)))
317 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
320 %************************************************************************
322 Conversion from Type to IfaceType
324 %************************************************************************
328 toIfaceTvBndr tyvar = (getOccName tyvar, toIfaceKind (tyVarKind tyvar))
329 toIfaceIdBndr ext id = (getOccName id, toIfaceType ext (idType id))
330 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
333 | isId var = IfaceIdBndr (toIfaceIdBndr ext var)
334 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
336 ---------------------
337 toIfaceKind :: Kind -> IfaceKind
339 | k `eqKind` openTypeKind = IfaceOpenTypeKind
340 | k `eqKind` liftedTypeKind = IfaceLiftedTypeKind
341 | k `eqKind` unliftedTypeKind = IfaceUnliftedTypeKind
342 | Just (arg,res) <- splitFunTy_maybe k
343 = IfaceFunKind (toIfaceKind arg) (toIfaceKind res)
345 | otherwise = pprTrace "toIfaceKind" (crudePprType k) IfaceOpenTypeKind
348 ---------------------
349 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
350 toIfaceType ext (TyVarTy tv) = IfaceTyVar (getOccName tv)
351 toIfaceType ext (AppTy t1 t2) = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
352 toIfaceType ext (FunTy t1 t2) = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
353 toIfaceType ext (NewTcApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
354 toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
355 toIfaceType ext (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
356 toIfaceType ext (PredTy st) = IfacePredTy (toIfacePred ext st)
357 toIfaceType ext (NoteTy (SynNote tc_app) ty) = toIfaceType ext tc_app
358 toIfaceType ext (NoteTy other_note ty) = toIfaceType ext ty
361 mkIfaceTc :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
363 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
364 | nm == intTyConName = IfaceIntTc
365 | nm == boolTyConName = IfaceBoolTc
366 | nm == charTyConName = IfaceCharTc
367 | nm == listTyConName = IfaceListTc
368 | nm == parrTyConName = IfacePArrTc
369 | otherwise = IfaceTc (ext nm)
374 toIfaceTypes ext ts = map (toIfaceType ext) ts
377 toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
378 toIfacePred ext (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
381 toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
382 toIfaceContext ext cs = map (toIfacePred ext) cs