2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
10 IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
11 IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
12 IfaceBinding(..), IfaceConAlt(..),
13 IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
14 IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
15 IfaceInst(..), IfaceFamInst(..),
18 ifaceDeclSubBndrs, visibleIfConDecls,
21 freeNamesIfDecl, freeNamesIfRule,
24 pprIfaceExpr, pprIfaceDeclHead
27 #include "HsVersions.h"
30 import CoreSyn( DFunArg, dfunArgExprs )
31 import PprCore() -- Printing DFunArgs
50 %************************************************************************
52 Data type declarations
54 %************************************************************************
58 = IfaceId { ifName :: OccName,
60 ifIdDetails :: IfaceIdDetails,
61 ifIdInfo :: IfaceIdInfo }
63 | IfaceData { ifName :: OccName, -- Type constructor
64 ifTyVars :: [IfaceTvBndr], -- Type variables
65 ifCtxt :: IfaceContext, -- The "stupid theta"
66 ifCons :: IfaceConDecls, -- Includes new/data info
67 ifRec :: RecFlag, -- Recursive or not?
68 ifGadtSyntax :: Bool, -- True <=> declared using
70 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
71 -- Just <=> instance of family
73 -- ifCons /= IfOpenDataTyCon
74 -- for family instances
77 | IfaceSyn { ifName :: OccName, -- Type constructor
78 ifTyVars :: [IfaceTvBndr], -- Type variables
79 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
80 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
81 -- Nothing for an open family
82 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
83 -- Just <=> instance of family
84 -- Invariant: ifOpenSyn == False
85 -- for family instances
88 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
89 ifName :: OccName, -- Name of the class
90 ifTyVars :: [IfaceTvBndr], -- Type variables
91 ifFDs :: [FunDep FastString], -- Functional dependencies
92 ifATs :: [IfaceDecl], -- Associated type families
93 ifSigs :: [IfaceClassOp], -- Method signatures
94 ifRec :: RecFlag -- Is newtype/datatype associated
95 -- with the class recursive?
98 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
100 ifExtName :: Maybe FastString }
102 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
103 -- Nothing => no default method
104 -- Just False => ordinary polymorphic default method
105 -- Just True => generic default method
108 = IfAbstractTyCon -- No info
109 | IfOpenDataTyCon -- Open data family
110 | IfDataTyCon [IfaceConDecl] -- data type decls
111 | IfNewTyCon IfaceConDecl -- newtype decls
113 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
114 visibleIfConDecls IfAbstractTyCon = []
115 visibleIfConDecls IfOpenDataTyCon = []
116 visibleIfConDecls (IfDataTyCon cs) = cs
117 visibleIfConDecls (IfNewTyCon c) = [c]
121 ifConOcc :: OccName, -- Constructor name
122 ifConWrapper :: Bool, -- True <=> has a wrapper
123 ifConInfix :: Bool, -- True <=> declared infix
124 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
125 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
126 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
127 ifConCtxt :: IfaceContext, -- Non-stupid context
128 ifConArgTys :: [IfaceType], -- Arg types
129 ifConFields :: [OccName], -- ...ditto... (field labels)
130 ifConStricts :: [HsBang]} -- Empty (meaning all lazy),
131 -- or 1-1 corresp with arg tys
134 = IfaceInst { ifInstCls :: IfExtName, -- See comments with
135 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
136 ifDFun :: IfExtName, -- The dfun
137 ifOFlag :: OverlapFlag, -- Overlap flag
138 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
139 -- There's always a separate IfaceDecl for the DFun, which gives
140 -- its IdInfo with its full type and version number.
141 -- The instance declarations taken together have a version number,
142 -- and we don't want that to wobble gratuitously
143 -- If this instance decl is *used*, we'll record a usage on the dfun;
144 -- and if the head does not change it won't be used if it wasn't before
147 = IfaceFamInst { ifFamInstFam :: IfExtName -- Family tycon
148 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
149 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
154 ifRuleName :: RuleName,
155 ifActivation :: Activation,
156 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
157 ifRuleHead :: IfExtName, -- Head of lhs
158 ifRuleArgs :: [IfaceExpr], -- Args of LHS
159 ifRuleRhs :: IfaceExpr,
161 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
166 ifAnnotatedTarget :: IfaceAnnTarget,
167 ifAnnotatedValue :: Serialized
170 type IfaceAnnTarget = AnnTarget OccName
172 -- We only serialise the IdDetails of top-level Ids, and even then
173 -- we only need a very limited selection. Notably, none of the
174 -- implicit ones are needed here, becuase they are not put it
179 | IfRecSelId IfaceTyCon Bool
180 | IfDFunId Int -- Number of silent args
183 = NoInfo -- When writing interface file without -O
184 | HasInfo [IfaceInfoItem] -- Has info, and here it is
186 -- Here's a tricky case:
187 -- * Compile with -O module A, and B which imports A.f
188 -- * Change function f in A, and recompile without -O
189 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
190 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
191 -- but we do not do that now. Instead it's discarded when the
192 -- ModIface is read into the various decl pools.)
193 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
194 -- and so gives a new version.
198 | HsStrictness StrictSig
199 | HsInline InlinePragma
200 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
201 IfaceUnfolding -- See Note [Expose recursive functions]
204 -- NB: Specialisations and rules come in separately and are
205 -- only later attached to the Id. Partial reason: some are orphans.
208 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
209 -- Possibly could eliminate the Bool here, the information
210 -- is also in the InlinePragma.
212 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
214 | IfInlineRule Arity -- INLINE pragmas
215 Bool -- OK to inline even if *un*-saturated
216 Bool -- OK to inline even if context is boring
219 | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName)
220 | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
223 | IfDFunUnfold [DFunArg IfaceExpr]
225 --------------------------------
229 | IfaceType IfaceType
230 | IfaceCo IfaceType -- We re-use IfaceType for coercions
231 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
232 | IfaceLam IfaceBndr IfaceExpr
233 | IfaceApp IfaceExpr IfaceExpr
234 | IfaceCase IfaceExpr IfLclName [IfaceAlt]
235 | IfaceLet IfaceBinding IfaceExpr
236 | IfaceNote IfaceNote IfaceExpr
237 | IfaceCast IfaceExpr IfaceCoercion
239 | IfaceFCall ForeignCall IfaceType
240 | IfaceTick Module Int
242 data IfaceNote = IfaceSCC CostCentre
243 | IfaceCoreNote String
245 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
246 -- Note: IfLclName, not IfaceBndr (and same with the case binder)
247 -- We reconstruct the kind/type of the thing from the context
248 -- thus saving bulk in interface files
250 data IfaceConAlt = IfaceDefault
251 | IfaceDataAlt IfExtName
252 | IfaceTupleAlt Boxity
253 | IfaceLitAlt Literal
256 = IfaceNonRec IfaceLetBndr IfaceExpr
257 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
259 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
260 -- It's used for *non-top-level* let/rec binders
261 -- See Note [IdInfo on nested let-bindings]
262 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
265 Note [Expose recursive functions]
266 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
267 For supercompilation we want to put *all* unfoldings in the interface
268 file, even for functions that are recursive (or big). So we need to
269 know when an unfolding belongs to a loop-breaker so that we can refrain
270 from inlining it (except during supercompilation).
272 Note [IdInfo on nested let-bindings]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
274 Occasionally we want to preserve IdInfo on nested let bindings. The one
275 that came up was a NOINLINE pragma on a let-binding inside an INLINE
276 function. The user (Duncan Coutts) really wanted the NOINLINE control
277 to cross the separate compilation boundary.
279 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
280 that is what is seen by importing module with --make
282 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
283 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
284 If a module contains any "orphans", then its interface file is read
285 regardless, so that its instances are not missed.
287 Roughly speaking, an instance is an orphan if its head (after the =>)
288 mentions nothing defined in this module. Functional dependencies
289 complicate the situation though. Consider
291 module M where { class C a b | a -> b }
293 and suppose we are compiling module X:
298 instance C Int T where ...
300 This instance is an orphan, because when compiling a third module Y we
301 might get a constraint (C Int v), and we'd want to improve v to T. So
302 we must make sure X's instances are loaded, even if we do not directly
305 More precisely, an instance is an orphan iff
307 If there are no fundeps, then at least of the names in
308 the instance head is locally defined.
310 If there are fundeps, then for every fundep, at least one of the
311 names free in a *non-determined* part of the instance head is
312 defined in this module.
314 (Note that these conditions hold trivially if the class is locally
317 Note [Versioning of instances]
318 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
319 Now consider versioning. If we *use* an instance decl in one compilation,
320 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
321 But suppose we *don't* (currently) use an instance! We must recompile if
322 the instance is changed in such a way that it becomes important. (This would
323 only matter with overlapping instances, else the importing module wouldn't have
324 compiled before and the recompilation check is irrelevant.)
326 The is_orph field is set to (Just n) if the instance is not an orphan.
327 The 'n' is *any* of the locally-defined names mentioned anywhere in the
328 instance head. This name is used for versioning; the instance decl is
329 considered part of the defn of this 'n'.
331 I'm worried about whether this works right if we pick a name from
332 a functionally-dependent part of the instance decl. E.g.
334 module M where { class C a b | a -> b }
336 and suppose we are compiling module X:
342 instance C S T where ...
344 If we base the instance verion on T, I'm worried that changing S to S'
345 would change T's version, but not S or S'. But an importing module might
346 not depend on T, and so might not be recompiled even though the new instance
347 (C S' T) might be relevant. I have not been able to make a concrete example,
348 and it seems deeply obscure, so I'm going to leave it for now.
351 Note [Versioning of rules]
352 ~~~~~~~~~~~~~~~~~~~~~~~~~~
353 A rule that is not an orphan has an ifRuleOrph field of (Just n), where n
354 appears on the LHS of the rule; any change in the rule changes the version of n.
358 -- -----------------------------------------------------------------------------
361 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
362 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
363 -- Deeply revolting, because it has to predict what gets bound,
364 -- especially the question of whether there's a wrapper for a datacon
366 -- N.B. the set of names returned here *must* match the set of
367 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
368 -- TyThing.getOccName should define a bijection between the two lists.
369 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
370 -- The order of the list does not matter.
371 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
374 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
375 ifCons = IfNewTyCon (
376 IfCon { ifConOcc = con_occ }),
377 ifFamInst = famInst})
378 = -- implicit coerion and (possibly) family instance coercion
379 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
380 -- data constructor and worker (newtypes don't have a wrapper)
381 [con_occ, mkDataConWorkerOcc con_occ]
384 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
385 ifCons = IfDataTyCon cons,
386 ifFamInst = famInst})
387 = -- (possibly) family instance coercion;
388 -- there is no implicit coercion for non-newtypes
389 famInstCo famInst tc_occ
390 -- for each data constructor in order,
391 -- data constructor, worker, and (possibly) wrapper
392 ++ concatMap dc_occs cons
395 | has_wrapper = [con_occ, work_occ, wrap_occ]
396 | otherwise = [con_occ, work_occ]
398 con_occ = ifConOcc con_decl -- DataCon namespace
399 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
400 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
401 has_wrapper = ifConWrapper con_decl -- This is the reason for
402 -- having the ifConWrapper field!
404 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
405 ifSigs = sigs, ifATs = ats })
406 = -- dictionary datatype:
409 -- (possibly) newtype coercion
411 -- data constructor (DataCon namespace)
412 -- data worker (Id namespace)
413 -- no wrapper (class dictionaries never have a wrapper)
414 [dc_occ, dcww_occ] ++
416 [ifName at | at <- ats ] ++
417 -- superclass selectors
418 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
419 -- operation selectors
420 [op | IfaceClassOp op _ _ <- sigs]
422 n_ctxt = length sc_ctxt
424 tc_occ = mkClassTyConOcc cls_occ
425 dc_occ = mkClassDataConOcc cls_occ
426 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
428 dcww_occ = mkDataConWorkerOcc dc_occ
429 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
431 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
432 ifFamInst = famInst})
433 = famInstCo famInst tc_occ
435 ifaceDeclSubBndrs _ = []
437 -- coercion for data/newtype family instances
438 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
439 famInstCo Nothing _ = []
440 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
442 ----------------------------- Printing IfaceDecl ------------------------------
444 instance Outputable IfaceDecl where
447 pprIfaceDecl :: IfaceDecl -> SDoc
448 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
449 ifIdDetails = details, ifIdInfo = info})
450 = sep [ ppr var <+> dcolon <+> ppr ty,
451 nest 2 (ppr details),
454 pprIfaceDecl (IfaceForeign {ifName = tycon})
455 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
457 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
458 ifSynRhs = Just mono_ty,
459 ifFamInst = mbFamInst})
460 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
461 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
463 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
464 ifSynRhs = Nothing, ifSynKind = kind })
465 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
466 4 (dcolon <+> ppr kind)
468 pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
469 ifTyVars = tyvars, ifCons = condecls,
470 ifRec = isrec, ifFamInst = mbFamInst})
471 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
472 4 (vcat [pprRec isrec, pp_condecls tycon condecls,
473 pprFamily mbFamInst])
475 pp_nd = case condecls of
476 IfAbstractTyCon -> ptext (sLit "data")
477 IfOpenDataTyCon -> ptext (sLit "data family")
478 IfDataTyCon _ -> ptext (sLit "data")
479 IfNewTyCon _ -> ptext (sLit "newtype")
481 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
482 ifFDs = fds, ifATs = ats, ifSigs = sigs,
484 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
485 4 (vcat [pprRec isrec,
489 pprRec :: RecFlag -> SDoc
490 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
492 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
493 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
494 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
496 instance Outputable IfaceClassOp where
497 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
499 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
500 pprIfaceDeclHead context thing tyvars
501 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
502 pprIfaceTvBndrs tyvars]
504 pp_condecls :: OccName -> IfaceConDecls -> SDoc
505 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
506 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
507 pp_condecls _ IfOpenDataTyCon = empty
508 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
509 (map (pprIfaceConDecl tc) cs))
511 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
513 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
514 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
515 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
516 ifConStricts = strs, ifConFields = fields })
518 if is_infix then ptext (sLit "Infix") else empty,
519 if has_wrap then ptext (sLit "HasWrapper") else empty,
520 ppUnless (null strs) $
521 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
522 ppUnless (null fields) $
523 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
525 ppr_bang HsNoBang = char '_' -- Want to see these
526 ppr_bang bang = ppr bang
528 main_payload = ppr name <+> dcolon <+>
529 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
531 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
532 | (tv,ty) <- eq_spec]
534 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
535 -- because we don't have a Name for the tycon, only an OccName
536 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
537 (t:ts) -> fsep (t : map (arrow <+>) ts)
538 [] -> panic "pp_con_taus"
540 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
542 instance Outputable IfaceRule where
543 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
544 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
545 = sep [hsep [doubleQuotes (ftext name), ppr act,
546 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
547 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
548 ptext (sLit "=") <+> ppr rhs])
551 instance Outputable IfaceInst where
552 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
553 ifInstCls = cls, ifInstTys = mb_tcs})
554 = hang (ptext (sLit "instance") <+> ppr flag
555 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
556 2 (equals <+> ppr dfun_id)
558 instance Outputable IfaceFamInst where
559 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
560 ifFamInstTyCon = tycon_id})
561 = hang (ptext (sLit "family instance") <+>
562 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
563 2 (equals <+> ppr tycon_id)
565 ppr_rough :: Maybe IfaceTyCon -> SDoc
566 ppr_rough Nothing = dot
567 ppr_rough (Just tc) = ppr tc
571 ----------------------------- Printing IfaceExpr ------------------------------------
574 instance Outputable IfaceExpr where
575 ppr e = pprIfaceExpr noParens e
577 pprParendIfaceExpr :: IfaceExpr -> SDoc
578 pprParendIfaceExpr = pprIfaceExpr parens
580 -- | Pretty Print an IfaceExpre
582 -- The first argument should be a function that adds parens in context that need
583 -- an atomic value (e.g. function args)
584 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
586 pprIfaceExpr _ (IfaceLcl v) = ppr v
587 pprIfaceExpr _ (IfaceExt v) = ppr v
588 pprIfaceExpr _ (IfaceLit l) = ppr l
589 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
590 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
591 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
592 pprIfaceExpr _ (IfaceCo co) = text "@~" <+> pprParendIfaceType co
594 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
595 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
597 pprIfaceExpr add_par i@(IfaceLam _ _)
598 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
599 pprIfaceExpr noParens body])
601 (bndrs,body) = collect [] i
602 collect bs (IfaceLam b e) = collect (b:bs) e
603 collect bs e = (reverse bs, e)
605 pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
606 = add_par (sep [ptext (sLit "case")
607 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
608 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
609 pprIfaceExpr noParens rhs <+> char '}'])
611 pprIfaceExpr add_par (IfaceCase scrut bndr alts)
612 = add_par (sep [ptext (sLit "case")
613 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
614 <+> ppr bndr <+> char '{',
615 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
617 pprIfaceExpr _ (IfaceCast expr co)
618 = sep [pprParendIfaceExpr expr,
619 nest 2 (ptext (sLit "`cast`")),
620 pprParendIfaceType co]
622 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
623 = add_par (sep [ptext (sLit "let {"),
624 nest 2 (ppr_bind (b, rhs)),
626 pprIfaceExpr noParens body])
628 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
629 = add_par (sep [ptext (sLit "letrec {"),
630 nest 2 (sep (map ppr_bind pairs)),
632 pprIfaceExpr noParens body])
634 pprIfaceExpr add_par (IfaceNote note body) = add_par $ ppr note
635 <+> pprParendIfaceExpr body
637 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
638 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
639 arrow <+> pprIfaceExpr noParens rhs]
641 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
642 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
643 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
645 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
646 ppr_bind (IfLetBndr b ty info, rhs)
647 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
648 equals <+> pprIfaceExpr noParens rhs]
651 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
652 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
653 nest 2 (pprParendIfaceExpr arg) : args
654 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
657 instance Outputable IfaceNote where
658 ppr (IfaceSCC cc) = pprCostCentreCore cc
659 ppr (IfaceCoreNote s) = ptext (sLit "__core_note")
660 <+> pprHsString (mkFastString s)
663 instance Outputable IfaceConAlt where
664 ppr IfaceDefault = text "DEFAULT"
665 ppr (IfaceLitAlt l) = ppr l
666 ppr (IfaceDataAlt d) = ppr d
667 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
668 -- IfaceTupleAlt is handled by the case-alternative printer
671 instance Outputable IfaceIdDetails where
672 ppr IfVanillaId = empty
673 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
674 <+> if b then ptext (sLit "<naughty>") else empty
675 ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns)
677 instance Outputable IfaceIdInfo where
679 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
680 <+> ptext (sLit "-}")
682 instance Outputable IfaceInfoItem where
683 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding")
684 <> ppWhen lb (ptext (sLit "(loop-breaker)"))
686 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
687 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
688 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
689 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
691 instance Outputable IfaceUnfolding where
692 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
693 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty)
695 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
697 pprParendIfaceExpr e]
698 ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
699 <+> parens (ptext (sLit "arity") <+> int a)
700 ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
701 <+> parens (ptext (sLit "arity") <+> int a)
702 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
703 <+> brackets (pprWithCommas ppr ns)
705 -- -----------------------------------------------------------------------------
706 -- | Finding the Names in IfaceSyn
708 -- This is used for dependency analysis in MkIface, so that we
709 -- fingerprint a declaration before the things that depend on it. It
710 -- is specific to interface-file fingerprinting in the sense that we
711 -- don't collect *all* Names: for example, the DFun of an instance is
712 -- recorded textually rather than by its fingerprint when
713 -- fingerprinting the instance, so DFuns are not dependencies.
715 freeNamesIfDecl :: IfaceDecl -> NameSet
716 freeNamesIfDecl (IfaceId _s t d i) =
717 freeNamesIfType t &&&
718 freeNamesIfIdInfo i &&&
719 freeNamesIfIdDetails d
720 freeNamesIfDecl IfaceForeign{} =
722 freeNamesIfDecl d@IfaceData{} =
723 freeNamesIfTvBndrs (ifTyVars d) &&&
724 freeNamesIfTcFam (ifFamInst d) &&&
725 freeNamesIfContext (ifCtxt d) &&&
726 freeNamesIfConDecls (ifCons d)
727 freeNamesIfDecl d@IfaceSyn{} =
728 freeNamesIfTvBndrs (ifTyVars d) &&&
729 freeNamesIfSynRhs (ifSynRhs d) &&&
730 freeNamesIfTcFam (ifFamInst d)
731 freeNamesIfDecl d@IfaceClass{} =
732 freeNamesIfTvBndrs (ifTyVars d) &&&
733 freeNamesIfContext (ifCtxt d) &&&
734 freeNamesIfDecls (ifATs d) &&&
735 fnList freeNamesIfClsSig (ifSigs d)
737 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
738 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
739 freeNamesIfIdDetails _ = emptyNameSet
741 -- All other changes are handled via the version info on the tycon
742 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
743 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
744 freeNamesIfSynRhs Nothing = emptyNameSet
746 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
747 freeNamesIfTcFam (Just (tc,tys)) =
748 freeNamesIfTc tc &&& fnList freeNamesIfType tys
749 freeNamesIfTcFam Nothing =
752 freeNamesIfContext :: IfaceContext -> NameSet
753 freeNamesIfContext = fnList freeNamesIfPredType
755 freeNamesIfDecls :: [IfaceDecl] -> NameSet
756 freeNamesIfDecls = fnList freeNamesIfDecl
758 freeNamesIfClsSig :: IfaceClassOp -> NameSet
759 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
761 freeNamesIfConDecls :: IfaceConDecls -> NameSet
762 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
763 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
764 freeNamesIfConDecls _ = emptyNameSet
766 freeNamesIfConDecl :: IfaceConDecl -> NameSet
767 freeNamesIfConDecl c =
768 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
769 freeNamesIfTvBndrs (ifConExTvs c) &&&
770 freeNamesIfContext (ifConCtxt c) &&&
771 fnList freeNamesIfType (ifConArgTys c) &&&
772 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
774 freeNamesIfPredType :: IfacePredType -> NameSet
775 freeNamesIfPredType (IfaceClassP cl tys) =
776 unitNameSet cl &&& fnList freeNamesIfType tys
777 freeNamesIfPredType (IfaceIParam _n ty) =
779 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
780 freeNamesIfType ty1 &&& freeNamesIfType ty2
782 freeNamesIfType :: IfaceType -> NameSet
783 freeNamesIfType (IfaceTyVar _) = emptyNameSet
784 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
785 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
786 freeNamesIfType (IfaceTyConApp tc ts) =
787 freeNamesIfTc tc &&& fnList freeNamesIfType ts
788 freeNamesIfType (IfaceForAllTy tv t) =
789 freeNamesIfTvBndr tv &&& freeNamesIfType t
790 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
791 freeNamesIfType (IfaceCoConApp tc ts) =
792 freeNamesIfCo tc &&& fnList freeNamesIfType ts
794 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
795 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
797 freeNamesIfBndr :: IfaceBndr -> NameSet
798 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
799 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
801 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
802 -- Remember IfaceLetBndr is used only for *nested* bindings
803 -- The IdInfo can contain an unfolding (in the case of
804 -- local INLINE pragmas), so look there too
805 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
806 &&& freeNamesIfIdInfo info
808 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
809 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
810 -- kinds can have Names inside, when the Kind is an equality predicate
812 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
813 freeNamesIfIdBndr = freeNamesIfTvBndr
815 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
816 freeNamesIfIdInfo NoInfo = emptyNameSet
817 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
819 freeNamesItem :: IfaceInfoItem -> NameSet
820 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
821 freeNamesItem _ = emptyNameSet
823 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
824 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
825 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
826 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
827 freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
828 freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
829 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
831 freeNamesIfExpr :: IfaceExpr -> NameSet
832 freeNamesIfExpr (IfaceExt v) = unitNameSet v
833 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
834 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
835 freeNamesIfExpr (IfaceCo co) = freeNamesIfType co
836 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
837 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
838 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
839 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
840 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
842 freeNamesIfExpr (IfaceCase s _ alts)
844 &&& fnList fn_alt alts &&& fn_cons alts
846 fn_alt (_con,_bs,r) = freeNamesIfExpr r
848 -- Depend on the data constructors. Just one will do!
849 -- Note [Tracking data constructors]
850 fn_cons [] = emptyNameSet
851 fn_cons ((IfaceDefault ,_,_) : xs) = fn_cons xs
852 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
853 fn_cons (_ : _ ) = emptyNameSet
855 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
856 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
858 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
859 = fnList fn_pair as &&& freeNamesIfExpr x
861 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
863 freeNamesIfExpr _ = emptyNameSet
865 freeNamesIfTc :: IfaceTyCon -> NameSet
866 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
867 -- ToDo: shouldn't we include IfaceIntTc & co.?
868 freeNamesIfTc _ = emptyNameSet
870 freeNamesIfCo :: IfaceCoCon -> NameSet
871 freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
872 freeNamesIfCo _ = emptyNameSet
874 freeNamesIfRule :: IfaceRule -> NameSet
875 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
876 , ifRuleArgs = es, ifRuleRhs = rhs })
878 fnList freeNamesIfBndr bs &&&
879 fnList freeNamesIfExpr es &&&
883 (&&&) :: NameSet -> NameSet -> NameSet
884 (&&&) = unionNameSets
886 fnList :: (a -> NameSet) -> [a] -> NameSet
887 fnList f = foldr (&&&) emptyNameSet . map f
890 Note [Tracking data constructors]
891 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
893 case e of { C a -> ...; ... }
894 You might think that we don't need to include the datacon C
895 in the free names, because its type will probably show up in
896 the free names of 'e'. But in rare circumstances this may
897 not happen. Here's the one that bit me:
899 module DynFlags where
900 import {-# SOURCE #-} Packages( PackageState )
901 data DynFlags = DF ... PackageState ...
903 module Packages where
905 data PackageState = PS ...
906 lookupModule (df :: DynFlags)
908 DF ...p... -> case p of
911 Now, lookupModule depends on DynFlags, but the transitive dependency
912 on the *locally-defined* type PackageState is not visible. We need
913 to take account of the use of the data constructor PS in the pattern match.