2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
8 module IfaceType, -- Re-export all this
10 IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
11 IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
12 IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..), IfaceIdDetails(..),
13 IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
14 IfaceInst(..), IfaceFamInst(..),
17 ifaceDeclSubBndrs, visibleIfConDecls,
20 freeNamesIfDecl, freeNamesIfRule,
23 pprIfaceExpr, pprIfaceDeclHead
26 #include "HsVersions.h"
51 %************************************************************************
53 Data type declarations
55 %************************************************************************
59 = IfaceId { ifName :: OccName,
61 ifIdDetails :: IfaceIdDetails,
62 ifIdInfo :: IfaceIdInfo }
64 | IfaceData { ifName :: OccName, -- Type constructor
65 ifTyVars :: [IfaceTvBndr], -- Type variables
66 ifCtxt :: IfaceContext, -- The "stupid theta"
67 ifCons :: IfaceConDecls, -- Includes new/data info
68 ifRec :: RecFlag, -- Recursive or not?
69 ifGadtSyntax :: Bool, -- True <=> declared using
71 ifGeneric :: Bool, -- True <=> generic converter
72 -- functions available
73 -- We need this for imported
74 -- data decls, since the
75 -- imported modules may have
77 -- different flags to the
78 -- current compilation unit
79 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
80 -- Just <=> instance of family
82 -- ifCons /= IfOpenDataTyCon
83 -- for family instances
86 | IfaceSyn { ifName :: OccName, -- Type constructor
87 ifTyVars :: [IfaceTvBndr], -- Type variables
88 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
89 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
90 -- Nothing for an open family
91 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
92 -- Just <=> instance of family
93 -- Invariant: ifOpenSyn == False
94 -- for family instances
97 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
98 ifName :: OccName, -- Name of the class
99 ifTyVars :: [IfaceTvBndr], -- Type variables
100 ifFDs :: [FunDep FastString], -- Functional dependencies
101 ifATs :: [IfaceDecl], -- Associated type families
102 ifSigs :: [IfaceClassOp], -- Method signatures
103 ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
106 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
108 ifExtName :: Maybe FastString }
110 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
111 -- Nothing => no default method
112 -- Just False => ordinary polymorphic default method
113 -- Just True => generic default method
116 = IfAbstractTyCon -- No info
117 | IfOpenDataTyCon -- Open data family
118 | IfDataTyCon [IfaceConDecl] -- data type decls
119 | IfNewTyCon IfaceConDecl -- newtype decls
121 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
122 visibleIfConDecls IfAbstractTyCon = []
123 visibleIfConDecls IfOpenDataTyCon = []
124 visibleIfConDecls (IfDataTyCon cs) = cs
125 visibleIfConDecls (IfNewTyCon c) = [c]
129 ifConOcc :: OccName, -- Constructor name
130 ifConWrapper :: Bool, -- True <=> has a wrapper
131 ifConInfix :: Bool, -- True <=> declared infix
132 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
133 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
134 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
135 ifConCtxt :: IfaceContext, -- Non-stupid context
136 ifConArgTys :: [IfaceType], -- Arg types
137 ifConFields :: [OccName], -- ...ditto... (field labels)
138 ifConStricts :: [StrictnessMark]} -- Empty (meaning all lazy),
139 -- or 1-1 corresp with arg tys
142 = IfaceInst { ifInstCls :: Name, -- See comments with
143 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
144 ifDFun :: Name, -- The dfun
145 ifOFlag :: OverlapFlag, -- Overlap flag
146 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
147 -- There's always a separate IfaceDecl for the DFun, which gives
148 -- its IdInfo with its full type and version number.
149 -- The instance declarations taken together have a version number,
150 -- and we don't want that to wobble gratuitously
151 -- If this instance decl is *used*, we'll record a usage on the dfun;
152 -- and if the head does not change it won't be used if it wasn't before
155 = IfaceFamInst { ifFamInstFam :: Name -- Family tycon
156 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
157 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
162 ifRuleName :: RuleName,
163 ifActivation :: Activation,
164 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
165 ifRuleHead :: Name, -- Head of lhs
166 ifRuleArgs :: [IfaceExpr], -- Args of LHS
167 ifRuleRhs :: IfaceExpr,
168 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
173 ifAnnotatedTarget :: IfaceAnnTarget,
174 ifAnnotatedValue :: Serialized
177 type IfaceAnnTarget = AnnTarget OccName
179 -- We only serialise the IdDetails of top-level Ids, and even then
180 -- we only need a very limited selection. Notably, none of the
181 -- implicit ones are needed here, becuase they are not put it
190 = NoInfo -- When writing interface file without -O
191 | HasInfo [IfaceInfoItem] -- Has info, and here it is
193 -- Here's a tricky case:
194 -- * Compile with -O module A, and B which imports A.f
195 -- * Change function f in A, and recompile without -O
196 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
197 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
198 -- but we do not do that now. Instead it's discarded when the
199 -- ModIface is read into the various decl pools.)
200 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
201 -- and so gives a new version.
205 | HsStrictness StrictSig
206 | HsInline Activation
209 | HsWorker Name Arity -- Worker, if any see IdInfo.WorkerInfo
210 -- for why we want arity here.
211 -- NB: we need IfaceExtName (not just OccName) because the worker
212 -- can simplify to a function in another module.
213 -- NB: Specialisations and rules come in separately and are
214 -- only later attached to the Id. Partial reason: some are orphans.
216 --------------------------------
218 = IfaceLcl FastString
220 | IfaceType IfaceType
221 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
222 | IfaceLam IfaceBndr IfaceExpr
223 | IfaceApp IfaceExpr IfaceExpr
224 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
225 | IfaceLet IfaceBinding IfaceExpr
226 | IfaceNote IfaceNote IfaceExpr
227 | IfaceCast IfaceExpr IfaceCoercion
229 | IfaceFCall ForeignCall IfaceType
230 | IfaceTick Module Int
232 data IfaceNote = IfaceSCC CostCentre
234 | IfaceCoreNote String
236 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
237 -- Note: FastString, not IfaceBndr (and same with the case binder)
238 -- We reconstruct the kind/type of the thing from the context
239 -- thus saving bulk in interface files
241 data IfaceConAlt = IfaceDefault
243 | IfaceTupleAlt Boxity
244 | IfaceLitAlt Literal
247 = IfaceNonRec IfaceLetBndr IfaceExpr
248 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
250 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
251 -- It's used for *non-top-level* let/rec binders
252 -- See Note [IdInfo on nested let-bindings]
253 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
256 Note [IdInfo on nested let-bindings]
257 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
258 Occasionally we want to preserve IdInfo on nested let bindings. The one
259 that came up was a NOINLINE pragma on a let-binding inside an INLINE
260 function. The user (Duncan Coutts) really wanted the NOINLINE control
261 to cross the separate compilation boundary.
263 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
264 Currently we only actually retain InlinePragInfo, but in principle we could
268 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
269 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
270 If a module contains any "orphans", then its interface file is read
271 regardless, so that its instances are not missed.
273 Roughly speaking, an instance is an orphan if its head (after the =>)
274 mentions nothing defined in this module. Functional dependencies
275 complicate the situation though. Consider
277 module M where { class C a b | a -> b }
279 and suppose we are compiling module X:
284 instance C Int T where ...
286 This instance is an orphan, because when compiling a third module Y we
287 might get a constraint (C Int v), and we'd want to improve v to T. So
288 we must make sure X's instances are loaded, even if we do not directly
291 More precisely, an instance is an orphan iff
293 If there are no fundeps, then at least of the names in
294 the instance head is locally defined.
296 If there are fundeps, then for every fundep, at least one of the
297 names free in a *non-determined* part of the instance head is
298 defined in this module.
300 (Note that these conditions hold trivially if the class is locally
303 Note [Versioning of instances]
304 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
305 Now consider versioning. If we *use* an instance decl in one compilation,
306 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
307 But suppose we *don't* (currently) use an instance! We must recompile if
308 the instance is changed in such a way that it becomes important. (This would
309 only matter with overlapping instances, else the importing module wouldn't have
310 compiled before and the recompilation check is irrelevant.)
312 The is_orph field is set to (Just n) if the instance is not an orphan.
313 The 'n' is *any* of the locally-defined names mentioned anywhere in the
314 instance head. This name is used for versioning; the instance decl is
315 considered part of the defn of this 'n'.
317 I'm worried about whether this works right if we pick a name from
318 a functionally-dependent part of the instance decl. E.g.
320 module M where { class C a b | a -> b }
322 and suppose we are compiling module X:
328 instance C S T where ...
330 If we base the instance verion on T, I'm worried that changing S to S'
331 would change T's version, but not S or S'. But an importing module might
332 not depend on T, and so might not be recompiled even though the new instance
333 (C S' T) might be relevant. I have not been able to make a concrete example,
334 and it seems deeply obscure, so I'm going to leave it for now.
337 Note [Versioning of rules]
338 ~~~~~~~~~~~~~~~~~~~~~~~~~~
339 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
340 n appears on the LHS of the rule; any change in the rule changes the version of n.
344 -- -----------------------------------------------------------------------------
347 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
348 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
349 -- Deeply revolting, because it has to predict what gets bound,
350 -- especially the question of whether there's a wrapper for a datacon
352 -- N.B. the set of names returned here *must* match the set of
353 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
354 -- TyThing.getOccName should define a bijection between the two lists.
355 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
356 -- The order of the list does not matter.
357 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
360 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
361 ifCons = IfNewTyCon (
362 IfCon { ifConOcc = con_occ }),
363 ifFamInst = famInst})
364 = -- implicit coerion and (possibly) family instance coercion
365 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
366 -- data constructor and worker (newtypes don't have a wrapper)
367 [con_occ, mkDataConWorkerOcc con_occ]
370 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
371 ifCons = IfDataTyCon cons,
372 ifFamInst = famInst})
373 = -- (possibly) family instance coercion;
374 -- there is no implicit coercion for non-newtypes
375 famInstCo famInst tc_occ
376 -- for each data constructor in order,
377 -- data constructor, worker, and (possibly) wrapper
378 ++ concatMap dc_occs cons
381 | has_wrapper = [con_occ, work_occ, wrap_occ]
382 | otherwise = [con_occ, work_occ]
384 con_occ = ifConOcc con_decl -- DataCon namespace
385 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
386 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
387 strs = ifConStricts con_decl
388 has_wrapper = ifConWrapper con_decl -- This is the reason for
389 -- having the ifConWrapper field!
391 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
392 ifSigs = sigs, ifATs = ats })
393 = -- dictionary datatype:
396 -- (possibly) newtype coercion
398 -- data constructor (DataCon namespace)
399 -- data worker (Id namespace)
400 -- no wrapper (class dictionaries never have a wrapper)
401 [dc_occ, dcww_occ] ++
403 [ifName at | at <- ats ] ++
404 -- superclass selectors
405 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
406 -- operation selectors
407 [op | IfaceClassOp op _ _ <- sigs]
409 n_ctxt = length sc_ctxt
411 tc_occ = mkClassTyConOcc cls_occ
412 dc_occ = mkClassDataConOcc cls_occ
413 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
415 dcww_occ = mkDataConWorkerOcc dc_occ
416 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
418 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
419 ifFamInst = famInst})
420 = famInstCo famInst tc_occ
422 ifaceDeclSubBndrs _ = []
424 -- coercion for data/newtype family instances
425 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
426 famInstCo Nothing _ = []
427 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
429 ----------------------------- Printing IfaceDecl ------------------------------
431 instance Outputable IfaceDecl where
434 pprIfaceDecl :: IfaceDecl -> SDoc
435 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
436 ifIdDetails = details, ifIdInfo = info})
437 = sep [ ppr var <+> dcolon <+> ppr ty,
438 nest 2 (ppr details),
441 pprIfaceDecl (IfaceForeign {ifName = tycon})
442 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
444 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
445 ifSynRhs = Just mono_ty,
446 ifFamInst = mbFamInst})
447 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
448 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
450 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
451 ifSynRhs = Nothing, ifSynKind = kind })
452 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
453 4 (dcolon <+> ppr kind)
455 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
456 ifTyVars = tyvars, ifCons = condecls,
457 ifRec = isrec, ifFamInst = mbFamInst})
458 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
459 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
460 pprFamily mbFamInst])
462 pp_nd = case condecls of
463 IfAbstractTyCon -> ptext (sLit "data")
464 IfOpenDataTyCon -> ptext (sLit "data family")
465 IfDataTyCon _ -> ptext (sLit "data")
466 IfNewTyCon _ -> ptext (sLit "newtype")
468 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
469 ifFDs = fds, ifATs = ats, ifSigs = sigs,
471 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
472 4 (vcat [pprRec isrec,
476 pprRec :: RecFlag -> SDoc
477 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
479 pprGen :: Bool -> SDoc
480 pprGen True = ptext (sLit "Generics: yes")
481 pprGen False = ptext (sLit "Generics: no")
483 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
484 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
485 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
487 instance Outputable IfaceClassOp where
488 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
490 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
491 pprIfaceDeclHead context thing tyvars
492 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
493 pprIfaceTvBndrs tyvars]
495 pp_condecls :: OccName -> IfaceConDecls -> SDoc
496 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
497 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
498 pp_condecls _ IfOpenDataTyCon = empty
499 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
500 (map (pprIfaceConDecl tc) cs))
502 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
504 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
505 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
506 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
507 ifConStricts = strs, ifConFields = fields })
509 if is_infix then ptext (sLit "Infix") else empty,
510 if has_wrap then ptext (sLit "HasWrapper") else empty,
511 if null strs then empty
512 else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
513 if null fields then empty
514 else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
516 main_payload = ppr name <+> dcolon <+>
517 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
519 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
520 | (tv,ty) <- eq_spec]
522 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
523 -- because we don't have a Name for the tycon, only an OccName
524 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
525 (t:ts) -> fsep (t : map (arrow <+>) ts)
526 [] -> panic "pp_con_taus"
528 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
530 instance Outputable IfaceRule where
531 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
532 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
533 = sep [hsep [doubleQuotes (ftext name), ppr act,
534 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
535 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
536 ptext (sLit "=") <+> ppr rhs])
539 instance Outputable IfaceInst where
540 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
541 ifInstCls = cls, ifInstTys = mb_tcs})
542 = hang (ptext (sLit "instance") <+> ppr flag
543 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
544 2 (equals <+> ppr dfun_id)
546 instance Outputable IfaceFamInst where
547 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
548 ifFamInstTyCon = tycon_id})
549 = hang (ptext (sLit "family instance") <+>
550 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
551 2 (equals <+> ppr tycon_id)
553 ppr_rough :: Maybe IfaceTyCon -> SDoc
554 ppr_rough Nothing = dot
555 ppr_rough (Just tc) = ppr tc
559 ----------------------------- Printing IfaceExpr ------------------------------------
562 instance Outputable IfaceExpr where
563 ppr e = pprIfaceExpr noParens e
565 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
566 -- The function adds parens in context that need
567 -- an atomic value (e.g. function args)
569 pprIfaceExpr _ (IfaceLcl v) = ppr v
570 pprIfaceExpr _ (IfaceExt v) = ppr v
571 pprIfaceExpr _ (IfaceLit l) = ppr l
572 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
573 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
574 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
576 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
577 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
579 pprIfaceExpr add_par e@(IfaceLam _ _)
580 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
581 pprIfaceExpr noParens body])
583 (bndrs,body) = collect [] e
584 collect bs (IfaceLam b e) = collect (b:bs) e
585 collect bs e = (reverse bs, e)
587 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
588 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
589 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
590 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
591 pprIfaceExpr noParens rhs <+> char '}'])
593 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
594 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
595 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
596 <+> ppr bndr <+> char '{',
597 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
599 pprIfaceExpr _ (IfaceCast expr co)
600 = sep [pprIfaceExpr parens expr,
601 nest 2 (ptext (sLit "`cast`")),
602 pprParendIfaceType co]
604 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
605 = add_par (sep [ptext (sLit "let {"),
606 nest 2 (ppr_bind (b, rhs)),
608 pprIfaceExpr noParens body])
610 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
611 = add_par (sep [ptext (sLit "letrec {"),
612 nest 2 (sep (map ppr_bind pairs)),
614 pprIfaceExpr noParens body])
616 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
618 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
619 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
620 arrow <+> pprIfaceExpr noParens rhs]
622 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
623 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
624 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
626 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
627 ppr_bind (IfLetBndr b ty info, rhs)
628 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
629 equals <+> pprIfaceExpr noParens rhs]
632 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
633 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
634 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
637 instance Outputable IfaceNote where
638 ppr (IfaceSCC cc) = pprCostCentreCore cc
639 ppr IfaceInlineMe = ptext (sLit "__inline_me")
640 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
643 instance Outputable IfaceConAlt where
644 ppr IfaceDefault = text "DEFAULT"
645 ppr (IfaceLitAlt l) = ppr l
646 ppr (IfaceDataAlt d) = ppr d
647 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
648 -- IfaceTupleAlt is handled by the case-alternative printer
651 instance Outputable IfaceIdDetails where
652 ppr IfVanillaId = empty
653 ppr (IfRecSelId b) = ptext (sLit "RecSel")
654 <> if b then ptext (sLit "<naughty>") else empty
655 ppr IfDFunId = ptext (sLit "DFunId")
657 instance Outputable IfaceIdInfo where
659 ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
661 instance Outputable IfaceInfoItem where
662 ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+>
663 parens (pprIfaceExpr noParens unf)
664 ppr (HsInline act) = ptext (sLit "Inline:") <+> ppr act
665 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
666 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
667 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
668 ppr (HsWorker w a) = ptext (sLit "Worker:") <+> ppr w <+> int a
671 -- -----------------------------------------------------------------------------
672 -- Finding the Names in IfaceSyn
674 -- This is used for dependency analysis in MkIface, so that we
675 -- fingerprint a declaration before the things that depend on it. It
676 -- is specific to interface-file fingerprinting in the sense that we
677 -- don't collect *all* Names: for example, the DFun of an instance is
678 -- recorded textually rather than by its fingerprint when
679 -- fingerprinting the instance, so DFuns are not dependencies.
681 freeNamesIfDecl :: IfaceDecl -> NameSet
682 freeNamesIfDecl (IfaceId _s t _d i) =
683 freeNamesIfType t &&&
685 freeNamesIfDecl IfaceForeign{} =
687 freeNamesIfDecl d@IfaceData{} =
688 freeNamesIfTvBndrs (ifTyVars d) &&&
689 freeNamesIfTcFam (ifFamInst d) &&&
690 freeNamesIfContext (ifCtxt d) &&&
691 freeNamesIfConDecls (ifCons d)
692 freeNamesIfDecl d@IfaceSyn{} =
693 freeNamesIfTvBndrs (ifTyVars d) &&&
694 freeNamesIfSynRhs (ifSynRhs d) &&&
695 freeNamesIfTcFam (ifFamInst d)
696 freeNamesIfDecl d@IfaceClass{} =
697 freeNamesIfTvBndrs (ifTyVars d) &&&
698 freeNamesIfContext (ifCtxt d) &&&
699 freeNamesIfDecls (ifATs d) &&&
700 fnList freeNamesIfClsSig (ifSigs d)
702 -- All other changes are handled via the version info on the tycon
703 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
704 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
705 freeNamesIfSynRhs Nothing = emptyNameSet
707 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
708 freeNamesIfTcFam (Just (tc,tys)) =
709 freeNamesIfTc tc &&& fnList freeNamesIfType tys
710 freeNamesIfTcFam Nothing =
713 freeNamesIfContext :: IfaceContext -> NameSet
714 freeNamesIfContext = fnList freeNamesIfPredType
716 freeNamesIfDecls :: [IfaceDecl] -> NameSet
717 freeNamesIfDecls = fnList freeNamesIfDecl
719 freeNamesIfClsSig :: IfaceClassOp -> NameSet
720 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
722 freeNamesIfConDecls :: IfaceConDecls -> NameSet
723 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
724 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
725 freeNamesIfConDecls _ = emptyNameSet
727 freeNamesIfConDecl :: IfaceConDecl -> NameSet
728 freeNamesIfConDecl c =
729 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
730 freeNamesIfTvBndrs (ifConExTvs c) &&&
731 freeNamesIfContext (ifConCtxt c) &&&
732 fnList freeNamesIfType (ifConArgTys c) &&&
733 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
735 freeNamesIfPredType :: IfacePredType -> NameSet
736 freeNamesIfPredType (IfaceClassP cl tys) =
737 unitNameSet cl &&& fnList freeNamesIfType tys
738 freeNamesIfPredType (IfaceIParam _n ty) =
740 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
741 freeNamesIfType ty1 &&& freeNamesIfType ty2
743 freeNamesIfType :: IfaceType -> NameSet
744 freeNamesIfType (IfaceTyVar _) = emptyNameSet
745 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
746 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
747 freeNamesIfType (IfaceTyConApp tc ts) =
748 freeNamesIfTc tc &&& fnList freeNamesIfType ts
749 freeNamesIfType (IfaceForAllTy tv t) =
750 freeNamesIfTvBndr tv &&& freeNamesIfType t
751 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
753 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
754 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
756 freeNamesIfBndr :: IfaceBndr -> NameSet
757 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
758 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
760 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
761 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
762 -- kinds can have Names inside, when the Kind is an equality predicate
764 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
765 freeNamesIfIdBndr = freeNamesIfTvBndr
767 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
768 freeNamesIfIdInfo NoInfo = emptyNameSet
769 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
771 freeNamesItem :: IfaceInfoItem -> NameSet
772 freeNamesItem (HsUnfold u) = freeNamesIfExpr u
773 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
774 freeNamesItem _ = emptyNameSet
776 freeNamesIfExpr :: IfaceExpr -> NameSet
777 freeNamesIfExpr (IfaceExt v) = unitNameSet v
778 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
779 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
780 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
781 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
782 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
783 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
784 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
786 freeNamesIfExpr (IfaceCase s _ ty alts)
787 = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
789 -- no need to look at the constructor, because we'll already have its
790 -- parent recorded by the type on the case expression.
791 freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
793 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
794 = freeNamesIfExpr r &&& freeNamesIfExpr x
796 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
797 = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
799 freeNamesIfExpr _ = emptyNameSet
802 freeNamesIfTc :: IfaceTyCon -> NameSet
803 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
804 -- ToDo: shouldn't we include IfaceIntTc & co.?
805 freeNamesIfTc _ = emptyNameSet
807 freeNamesIfRule :: IfaceRule -> NameSet
808 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
810 fnList freeNamesIfBndr bs &&&
811 fnList freeNamesIfExpr es &&&
815 (&&&) :: NameSet -> NameSet -> NameSet
816 (&&&) = unionNameSets
818 fnList :: (a -> NameSet) -> [a] -> NameSet
819 fnList f = foldr (&&&) emptyNameSet . map f