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,
12 IfaceExtName(..), mkIfaceExtName, isLocalIfaceExtName,
13 ifaceTyConName, interactiveExtNameFun,
15 -- Conversion from Type -> IfaceType
16 toIfaceType, toIfacePred, toIfaceContext,
17 toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
20 pprIfaceType, pprParendIfaceType, pprIfaceContext,
21 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(..), 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, parenSymOcc )
34 import Name ( Name, getName, getOccName, nameModule, nameOccName )
35 import Module ( Module )
36 import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
42 %************************************************************************
46 %************************************************************************
50 = ExtPkg Module 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 Module OccName Version -- From another module in home package;
55 -- has version #; in all other respects,
56 -- HomePkg and ExtPkg are the same
58 | LocalTop OccName -- Top-level from the same module as
59 -- the enclosing IfaceDecl
61 | LocalTopSub -- Same as LocalTop, but for a class method or constr
62 OccName -- Class-meth/constr name
63 OccName -- Parent class/datatype name
64 -- LocalTopSub is written into iface files as LocalTop; the parent
65 -- info is only used when computing version information in MkIface
67 isLocalIfaceExtName :: IfaceExtName -> Bool
68 isLocalIfaceExtName (LocalTop _) = True
69 isLocalIfaceExtName (LocalTopSub _ _) = True
70 isLocalIfaceExtName other = False
72 mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name)
73 -- Local helper for wired-in names
75 ifaceExtOcc :: IfaceExtName -> OccName
76 ifaceExtOcc (ExtPkg _ occ) = occ
77 ifaceExtOcc (HomePkg _ occ _) = occ
78 ifaceExtOcc (LocalTop occ) = occ
79 ifaceExtOcc (LocalTopSub occ _) = occ
81 interactiveExtNameFun :: PrintUnqualified -> Name-> IfaceExtName
82 interactiveExtNameFun print_unqual name
83 | print_unqual mod occ = LocalTop occ
84 | otherwise = ExtPkg mod occ
87 occ = nameOccName name
91 %************************************************************************
93 Local (nested) binders
95 %************************************************************************
98 data IfaceBndr -- Local (non-top-level) binders
99 = IfaceIdBndr IfaceIdBndr
100 | IfaceTvBndr IfaceTvBndr
102 type IfaceIdBndr = (OccName, IfaceType) -- OccName, because always local
103 type IfaceTvBndr = (OccName, IfaceKind)
105 -------------------------------
106 type IfaceKind = Kind -- Re-use the Kind type, but no KindVars in it
109 = IfaceTyVar OccName -- Type variable only, not tycon
110 | IfaceAppTy IfaceType IfaceType
111 | IfaceForAllTy IfaceTvBndr IfaceType
112 | IfacePredTy IfacePredType
113 | IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
114 -- Includes newtypes, synonyms, tuples
115 | IfaceFunTy IfaceType IfaceType
117 data IfacePredType -- NewTypes are handled as ordinary TyConApps
118 = IfaceClassP IfaceExtName [IfaceType]
119 | IfaceIParam (IPName OccName) IfaceType
121 type IfaceContext = [IfacePredType]
123 data IfaceTyCon -- Abbreviations for common tycons with known names
124 = IfaceTc IfaceExtName -- The common case
125 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
126 | IfaceListTc | IfacePArrTc
127 | IfaceTupTc Boxity Arity
129 ifaceTyConName :: IfaceTyCon -> Name -- Works for all except IfaceTc
130 ifaceTyConName IfaceIntTc = intTyConName
131 ifaceTyConName IfaceBoolTc = boolTyConName
132 ifaceTyConName IfaceCharTc = charTyConName
133 ifaceTyConName IfaceListTc = listTyConName
134 ifaceTyConName IfacePArrTc = parrTyConName
135 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
136 ifaceTyConName (IfaceTc ext) = pprPanic "ifaceTyConName" (ppr ext)
140 %************************************************************************
142 Functions over IFaceTypes
144 %************************************************************************
148 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
149 -- Mainly for printing purposes
153 (tvs, rho) = split_foralls ty
154 (theta, tau) = split_rho rho
156 split_foralls (IfaceForAllTy tv ty)
157 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
158 split_foralls rho = ([], rho)
160 split_rho (IfaceFunTy (IfacePredTy st) ty)
161 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
162 split_rho tau = ([], tau)
165 %************************************************************************
169 %************************************************************************
173 @ppr_ty@ takes an @Int@ that is the precedence of the context.
174 The precedence levels are:
176 \item[tOP_PREC] No parens required.
177 \item[fUN_PREC] Left hand argument of a function arrow.
178 \item[tYCON_PREC] Argument of a type constructor.
182 tOP_PREC = (0 :: Int) -- type in ParseIface.y
183 fUN_PREC = (1 :: Int) -- btype in ParseIface.y
184 tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
186 noParens :: SDoc -> SDoc
189 maybeParen ctxt_prec inner_prec pretty
190 | ctxt_prec < inner_prec = pretty
191 | otherwise = parens pretty
195 ----------------------------- Printing binders ------------------------------------
198 -- These instances are used only when printing for the user, either when
199 -- debugging, or in GHCi when printing the results of a :info command
200 instance Outputable IfaceExtName where
201 ppr (ExtPkg mod occ) = pprExt mod occ
202 ppr (HomePkg mod occ vers) = pprExt mod occ <> braces (ppr vers)
203 ppr (LocalTop occ) = ppr occ -- Do we want to distinguish these
204 ppr (LocalTopSub occ _) = ppr occ -- from an ordinary occurrence?
206 pprExt :: Module -> OccName -> SDoc
207 -- No need to worry about printing unqualified becuase that was handled
208 -- in the transiation to IfaceSyn
209 pprExt mod occ = ppr mod <> dot <> ppr occ
211 instance Outputable IfaceBndr where
212 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
213 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
215 pprIfaceBndrs :: [IfaceBndr] -> SDoc
216 pprIfaceBndrs bs = sep (map ppr bs)
218 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
220 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
221 pprIfaceTvBndr (tv, LiftedTypeKind) = ppr tv
222 pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
224 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
225 pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
228 ----------------------------- Printing IfaceType ------------------------------------
231 ---------------------------------
232 instance Outputable IfaceType where
233 ppr ty = pprIfaceTypeForUser ty
235 pprIfaceTypeForUser ::IfaceType -> SDoc
236 -- Drop top-level for-alls; if that's not what you want, use pprIfaceType dire
237 pprIfaceTypeForUser ty
238 = pprIfaceForAllPart [] theta (pprIfaceType tau)
240 (_tvs, theta, tau) = splitIfaceSigmaTy ty
242 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
243 pprIfaceType = ppr_ty tOP_PREC
244 pprParendIfaceType = ppr_ty tYCON_PREC
247 ppr_ty :: Int -> IfaceType -> SDoc
248 ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
249 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
250 ppr_ty ctxt_prec (IfacePredTy st) = ppr st
253 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
254 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
255 maybeParen ctxt_prec fUN_PREC $
256 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
258 ppr_fun_tail (IfaceFunTy ty1 ty2)
259 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
260 ppr_fun_tail other_ty
261 = [arrow <+> pprIfaceType other_ty]
263 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
264 = maybeParen ctxt_prec tYCON_PREC $
265 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
267 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
268 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
270 (tvs, theta, tau) = splitIfaceSigmaTy ty
273 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
274 pprIfaceForAllPart tvs ctxt doc
275 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
277 ppr_tvs | null tvs = empty
278 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
281 ppr_tc_app ctxt_prec tc [] = ppr_tc tc
282 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty)
283 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
284 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
285 | arity == length tys
286 = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
287 ppr_tc_app ctxt_prec tc tys
288 = maybeParen ctxt_prec tYCON_PREC
289 (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
291 ppr_tc :: IfaceTyCon -> SDoc
292 -- Wrap infix type constructors in parens
293 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (ifaceExtOcc ext_nm) (ppr tc)
297 instance Outputable IfacePredType where
298 -- Print without parens
299 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
300 ppr (IfaceClassP cls ts) = parenSymOcc (ifaceExtOcc cls) (ppr cls)
301 <+> sep (map pprParendIfaceType ts)
303 instance Outputable IfaceTyCon where
304 ppr (IfaceTc ext) = ppr ext
305 ppr other_tc = ppr (ifaceTyConName other_tc)
308 pprIfaceContext :: IfaceContext -> SDoc
309 -- Prints "(C a, D b) =>", including the arrow
310 pprIfaceContext [] = empty
311 pprIfaceContext theta = parens (sep (punctuate comma (map ppr theta)))
314 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
317 %************************************************************************
319 Conversion from Type to IfaceType
321 %************************************************************************
325 toIfaceTvBndr tyvar = (getOccName tyvar, tyVarKind tyvar)
326 toIfaceIdBndr ext id = (getOccName id, toIfaceType ext (idType id))
327 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
330 | isId var = IfaceIdBndr (toIfaceIdBndr ext var)
331 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
333 ---------------------
334 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
335 toIfaceType ext (TyVarTy tv) = IfaceTyVar (getOccName tv)
336 toIfaceType ext (AppTy t1 t2) = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
337 toIfaceType ext (FunTy t1 t2) = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
338 toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (mkIfaceTc ext tc) (toIfaceTypes ext tys)
339 toIfaceType ext (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
340 toIfaceType ext (PredTy st) = IfacePredTy (toIfacePred ext st)
341 toIfaceType ext (NoteTy (SynNote tc_app) ty) = toIfaceType ext tc_app -- Retain synonyms
342 toIfaceType ext (NoteTy other_note ty) = toIfaceType ext ty
345 mkIfaceTc :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
347 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
348 | nm == intTyConName = IfaceIntTc
349 | nm == boolTyConName = IfaceBoolTc
350 | nm == charTyConName = IfaceCharTc
351 | nm == listTyConName = IfaceListTc
352 | nm == parrTyConName = IfacePArrTc
353 | otherwise = IfaceTc (ext nm)
358 toIfaceTypes ext ts = map (toIfaceType ext) ts
361 toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
362 toIfacePred ext (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
365 toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
366 toIfaceContext ext cs = map (toIfacePred ext) cs