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,
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"
29 import Kind ( Kind(..) )
30 import TypeRep ( TyThing(..), Type(..), PredType(..), ThetaType )
31 import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
32 import Var ( isId, tyVarKind, idType )
33 import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
34 import OccName ( OccName, parenSymOcc )
35 import Name ( Name, getName, getOccName, nameModule, nameOccName,
36 wiredInNameTyThing_maybe )
37 import Module ( Module )
38 import BasicTypes ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
44 %************************************************************************
48 %************************************************************************
52 = ExtPkg Module OccName -- From an external package; no version #
53 -- Also used for wired-in things regardless
54 -- of whether they are home-pkg or not
56 | HomePkg Module OccName Version -- From another module in home package;
57 -- has version #; in all other respects,
58 -- HomePkg and ExtPkg are the same
60 | LocalTop OccName -- Top-level from the same module as
61 -- the enclosing IfaceDecl
63 | LocalTopSub -- Same as LocalTop, but for a class method or constr
64 OccName -- Class-meth/constr name
65 OccName -- Parent class/datatype name
66 -- LocalTopSub is written into iface files as LocalTop; the parent
67 -- info is only used when computing version information in MkIface
69 isLocalIfaceExtName :: IfaceExtName -> Bool
70 isLocalIfaceExtName (LocalTop _) = True
71 isLocalIfaceExtName (LocalTopSub _ _) = True
72 isLocalIfaceExtName other = False
74 mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name)
75 -- Local helper for wired-in names
77 ifaceExtOcc :: IfaceExtName -> OccName
78 ifaceExtOcc (ExtPkg _ occ) = occ
79 ifaceExtOcc (HomePkg _ occ _) = occ
80 ifaceExtOcc (LocalTop occ) = occ
81 ifaceExtOcc (LocalTopSub occ _) = occ
83 interactiveExtNameFun :: PrintUnqualified -> Name-> IfaceExtName
84 interactiveExtNameFun print_unqual name
85 | print_unqual mod occ = LocalTop occ
86 | otherwise = ExtPkg mod occ
89 occ = nameOccName name
93 %************************************************************************
95 Local (nested) binders
97 %************************************************************************
100 data IfaceBndr -- Local (non-top-level) binders
101 = IfaceIdBndr IfaceIdBndr
102 | IfaceTvBndr IfaceTvBndr
104 type IfaceIdBndr = (OccName, IfaceType) -- OccName, because always local
105 type IfaceTvBndr = (OccName, IfaceKind)
107 -------------------------------
108 type IfaceKind = Kind -- Re-use the Kind type, but no KindVars in it
111 = IfaceTyVar OccName -- 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
123 type IfaceContext = [IfacePredType]
125 data IfaceTyCon -- Abbreviations for common tycons with known names
126 = IfaceTc IfaceExtName -- The common case
127 | IfaceIntTc | IfaceBoolTc | IfaceCharTc
128 | IfaceListTc | IfacePArrTc
129 | IfaceTupTc Boxity Arity
131 ifaceTyConName :: IfaceTyCon -> Name -- Works for all except IfaceTc
132 ifaceTyConName IfaceIntTc = intTyConName
133 ifaceTyConName IfaceBoolTc = boolTyConName
134 ifaceTyConName IfaceCharTc = charTyConName
135 ifaceTyConName IfaceListTc = listTyConName
136 ifaceTyConName IfacePArrTc = parrTyConName
137 ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
138 ifaceTyConName (IfaceTc ext) = pprPanic "ifaceTyConName" (ppr ext)
142 %************************************************************************
144 Functions over IFaceTypes
146 %************************************************************************
150 splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
151 -- Mainly for printing purposes
155 (tvs, rho) = split_foralls ty
156 (theta, tau) = split_rho rho
158 split_foralls (IfaceForAllTy tv ty)
159 = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
160 split_foralls rho = ([], rho)
162 split_rho (IfaceFunTy (IfacePredTy st) ty)
163 = case split_rho ty of { (sts, tau) -> (st:sts, tau) }
164 split_rho tau = ([], tau)
167 %************************************************************************
171 %************************************************************************
175 @ppr_ty@ takes an @Int@ that is the precedence of the context.
176 The precedence levels are:
178 \item[tOP_PREC] No parens required.
179 \item[fUN_PREC] Left hand argument of a function arrow.
180 \item[tYCON_PREC] Argument of a type constructor.
184 tOP_PREC = (0 :: Int) -- type in ParseIface.y
185 fUN_PREC = (1 :: Int) -- btype in ParseIface.y
186 tYCON_PREC = (2 :: Int) -- atype in ParseIface.y
188 noParens :: SDoc -> SDoc
191 maybeParen ctxt_prec inner_prec pretty
192 | ctxt_prec < inner_prec = pretty
193 | otherwise = parens pretty
197 ----------------------------- Printing binders ------------------------------------
200 -- These instances are used only when printing for the user, either when
201 -- debugging, or in GHCi when printing the results of a :info command
202 instance Outputable IfaceExtName where
203 ppr (ExtPkg mod occ) = pprExt mod occ
204 ppr (HomePkg mod occ vers) = pprExt mod occ <> braces (ppr vers)
205 ppr (LocalTop occ) = ppr occ -- Do we want to distinguish these
206 ppr (LocalTopSub occ _) = ppr occ -- from an ordinary occurrence?
208 pprExt :: Module -> OccName -> SDoc
209 -- No need to worry about printing unqualified becuase that was handled
210 -- in the transiation to IfaceSyn
211 pprExt mod occ = ppr mod <> dot <> ppr occ
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, LiftedTypeKind) = 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 IfaceType where
235 ppr ty = pprIfaceTypeForUser ty
237 pprIfaceTypeForUser ::IfaceType -> SDoc
238 -- Drop top-level for-alls; if that's not what you want, use pprIfaceType dire
239 pprIfaceTypeForUser ty
240 = pprIfaceForAllPart [] theta (pprIfaceType tau)
242 (_tvs, theta, tau) = splitIfaceSigmaTy ty
244 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
245 pprIfaceType = ppr_ty tOP_PREC
246 pprParendIfaceType = ppr_ty tYCON_PREC
249 ppr_ty :: Int -> IfaceType -> SDoc
250 ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar
251 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
252 ppr_ty ctxt_prec (IfacePredTy st) = ppr st
255 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
256 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
257 maybeParen ctxt_prec fUN_PREC $
258 sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
260 ppr_fun_tail (IfaceFunTy ty1 ty2)
261 = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
262 ppr_fun_tail other_ty
263 = [arrow <+> pprIfaceType other_ty]
265 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
266 = maybeParen ctxt_prec tYCON_PREC $
267 ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
269 ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
270 = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
272 (tvs, theta, tau) = splitIfaceSigmaTy ty
275 pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
276 pprIfaceForAllPart tvs ctxt doc
277 = sep [ppr_tvs, pprIfaceContext ctxt, doc]
279 ppr_tvs | null tvs = empty
280 | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
283 ppr_tc_app ctxt_prec tc [] = ppr_tc tc
284 ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty)
285 ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
286 ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
287 | arity == length tys
288 = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
289 ppr_tc_app ctxt_prec tc tys
290 = maybeParen ctxt_prec tYCON_PREC
291 (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
293 ppr_tc :: IfaceTyCon -> SDoc
294 -- Wrap infix type constructors in parens
295 ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (ifaceExtOcc ext_nm) (ppr tc)
299 instance Outputable IfacePredType where
300 -- Print without parens
301 ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty]
302 ppr (IfaceClassP cls ts) = parenSymOcc (ifaceExtOcc cls) (ppr cls)
303 <+> sep (map pprParendIfaceType ts)
305 instance Outputable IfaceTyCon where
306 ppr (IfaceTc ext) = ppr ext
307 ppr other_tc = ppr (ifaceTyConName other_tc)
310 pprIfaceContext :: IfaceContext -> SDoc
311 -- Prints "(C a, D b) =>", including the arrow
312 pprIfaceContext [] = empty
313 pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
315 ppr_preds [pred] = ppr pred -- No parens
316 ppr_preds preds = parens (sep (punctuate comma (map ppr preds)))
319 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
322 %************************************************************************
324 Conversion from Type to IfaceType
326 %************************************************************************
330 toIfaceTvBndr tyvar = (getOccName tyvar, tyVarKind tyvar)
331 toIfaceIdBndr ext id = (getOccName id, toIfaceType ext (idType id))
332 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
335 | isId var = IfaceIdBndr (toIfaceIdBndr ext var)
336 | otherwise = IfaceTvBndr (toIfaceTvBndr var)
338 ---------------------
339 toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
340 -- Synonyms are retained in the interface type
341 toIfaceType ext (TyVarTy tv) = IfaceTyVar (getOccName tv)
342 toIfaceType ext (AppTy t1 t2) = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
343 toIfaceType ext (FunTy t1 t2) = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
344 toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon ext tc) (toIfaceTypes ext tys)
345 toIfaceType ext (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
346 toIfaceType ext (PredTy st) = IfacePredTy (toIfacePred ext st)
347 toIfaceType ext (NoteTy other_note ty) = toIfaceType ext ty
350 -- A little bit of (perhaps optional) trickiness here. When
351 -- compiling Data.Tuple, the tycons are not TupleTyCons, although
352 -- they have a wired-in name. But we'd like to dump them into the Iface
353 -- as a tuple tycon, to save lookups when reading the interface
354 -- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
355 -- toIfaceTyCon_name will still catch it.
357 toIfaceTyCon :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
359 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
360 | otherwise = toIfaceTyCon_name ext (tyConName tc)
362 toIfaceTyCon_name :: (Name -> IfaceExtName) -> Name -> IfaceTyCon
363 toIfaceTyCon_name ext nm
364 | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
365 = toIfaceWiredInTyCon ext tc nm
369 toIfaceWiredInTyCon :: (Name -> IfaceExtName) -> TyCon -> Name -> IfaceTyCon
370 toIfaceWiredInTyCon ext tc nm
371 | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
372 | nm == intTyConName = IfaceIntTc
373 | nm == boolTyConName = IfaceBoolTc
374 | nm == charTyConName = IfaceCharTc
375 | nm == listTyConName = IfaceListTc
376 | nm == parrTyConName = IfacePArrTc
377 | otherwise = IfaceTc (ext nm)
380 toIfaceTypes ext ts = map (toIfaceType ext) ts
383 toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
384 toIfacePred ext (IParam ip t) = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
387 toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
388 toIfaceContext ext cs = map (toIfacePred ext) cs