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 ifGeneric :: Bool, -- True <=> generic converter
71 -- functions available
72 -- We need this for imported
73 -- data decls, since the
74 -- imported modules may have
76 -- different flags to the
77 -- current compilation unit
78 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
79 -- Just <=> instance of family
81 -- ifCons /= IfOpenDataTyCon
82 -- for family instances
85 | IfaceSyn { ifName :: OccName, -- Type constructor
86 ifTyVars :: [IfaceTvBndr], -- Type variables
87 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
88 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
89 -- Nothing for an open family
90 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
91 -- Just <=> instance of family
92 -- Invariant: ifOpenSyn == False
93 -- for family instances
96 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
97 ifName :: OccName, -- Name of the class
98 ifTyVars :: [IfaceTvBndr], -- Type variables
99 ifFDs :: [FunDep FastString], -- Functional dependencies
100 ifATs :: [IfaceDecl], -- Associated type families
101 ifSigs :: [IfaceClassOp], -- Method signatures
102 ifRec :: RecFlag -- Is newtype/datatype associated
103 -- with the class recursive?
106 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
108 ifExtName :: Maybe FastString }
110 data IfaceClassOp = IfaceClassOp OccName DefMethSpec 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 :: [HsBang]} -- Empty (meaning all lazy),
139 -- or 1-1 corresp with arg tys
142 = IfaceInst { ifInstCls :: IfExtName, -- See comments with
143 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
144 ifDFun :: IfExtName, -- 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 :: IfExtName -- 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 :: IfExtName, -- Head of lhs
166 ifRuleArgs :: [IfaceExpr], -- Args of LHS
167 ifRuleRhs :: IfaceExpr,
169 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
174 ifAnnotatedTarget :: IfaceAnnTarget,
175 ifAnnotatedValue :: Serialized
178 type IfaceAnnTarget = AnnTarget OccName
180 -- We only serialise the IdDetails of top-level Ids, and even then
181 -- we only need a very limited selection. Notably, none of the
182 -- implicit ones are needed here, becuase they are not put it
187 | IfRecSelId IfaceTyCon Bool
188 | IfDFunId Int -- Number of silent args
191 = NoInfo -- When writing interface file without -O
192 | HasInfo [IfaceInfoItem] -- Has info, and here it is
194 -- Here's a tricky case:
195 -- * Compile with -O module A, and B which imports A.f
196 -- * Change function f in A, and recompile without -O
197 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
198 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
199 -- but we do not do that now. Instead it's discarded when the
200 -- ModIface is read into the various decl pools.)
201 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
202 -- and so gives a new version.
206 | HsStrictness StrictSig
207 | HsInline InlinePragma
208 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
209 IfaceUnfolding -- See Note [Expose recursive functions]
212 -- NB: Specialisations and rules come in separately and are
213 -- only later attached to the Id. Partial reason: some are orphans.
216 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
217 -- Possibly could eliminate the Bool here, the information
218 -- is also in the InlinePragma.
220 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
222 | IfInlineRule Arity -- INLINE pragmas
223 Bool -- OK to inline even if *un*-saturated
224 Bool -- OK to inline even if context is boring
227 | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName)
228 | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
231 | IfDFunUnfold [DFunArg IfaceExpr]
233 --------------------------------
237 | IfaceType IfaceType
238 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
239 | IfaceLam IfaceBndr IfaceExpr
240 | IfaceApp IfaceExpr IfaceExpr
241 | IfaceCase IfaceExpr IfLclName IfaceType [IfaceAlt]
242 | IfaceLet IfaceBinding IfaceExpr
243 | IfaceNote IfaceNote IfaceExpr
244 | IfaceCast IfaceExpr IfaceCoercion
246 | IfaceFCall ForeignCall IfaceType
247 | IfaceTick Module Int
249 data IfaceNote = IfaceSCC CostCentre
250 | IfaceCoreNote String
252 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
253 -- Note: IfLclName, not IfaceBndr (and same with the case binder)
254 -- We reconstruct the kind/type of the thing from the context
255 -- thus saving bulk in interface files
257 data IfaceConAlt = IfaceDefault
258 | IfaceDataAlt IfExtName
259 | IfaceTupleAlt Boxity
260 | IfaceLitAlt Literal
263 = IfaceNonRec IfaceLetBndr IfaceExpr
264 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
266 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
267 -- It's used for *non-top-level* let/rec binders
268 -- See Note [IdInfo on nested let-bindings]
269 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
272 Note [Expose recursive functions]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
274 For supercompilation we want to put *all* unfoldings in the interface
275 file, even for functions that are recursive (or big). So we need to
276 know when an unfolding belongs to a loop-breaker so that we can refrain
277 from inlining it (except during supercompilation).
279 Note [IdInfo on nested let-bindings]
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281 Occasionally we want to preserve IdInfo on nested let bindings. The one
282 that came up was a NOINLINE pragma on a let-binding inside an INLINE
283 function. The user (Duncan Coutts) really wanted the NOINLINE control
284 to cross the separate compilation boundary.
286 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
287 that is what is seen by importing module with --make
289 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
290 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
291 If a module contains any "orphans", then its interface file is read
292 regardless, so that its instances are not missed.
294 Roughly speaking, an instance is an orphan if its head (after the =>)
295 mentions nothing defined in this module. Functional dependencies
296 complicate the situation though. Consider
298 module M where { class C a b | a -> b }
300 and suppose we are compiling module X:
305 instance C Int T where ...
307 This instance is an orphan, because when compiling a third module Y we
308 might get a constraint (C Int v), and we'd want to improve v to T. So
309 we must make sure X's instances are loaded, even if we do not directly
312 More precisely, an instance is an orphan iff
314 If there are no fundeps, then at least of the names in
315 the instance head is locally defined.
317 If there are fundeps, then for every fundep, at least one of the
318 names free in a *non-determined* part of the instance head is
319 defined in this module.
321 (Note that these conditions hold trivially if the class is locally
324 Note [Versioning of instances]
325 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
326 Now consider versioning. If we *use* an instance decl in one compilation,
327 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
328 But suppose we *don't* (currently) use an instance! We must recompile if
329 the instance is changed in such a way that it becomes important. (This would
330 only matter with overlapping instances, else the importing module wouldn't have
331 compiled before and the recompilation check is irrelevant.)
333 The is_orph field is set to (Just n) if the instance is not an orphan.
334 The 'n' is *any* of the locally-defined names mentioned anywhere in the
335 instance head. This name is used for versioning; the instance decl is
336 considered part of the defn of this 'n'.
338 I'm worried about whether this works right if we pick a name from
339 a functionally-dependent part of the instance decl. E.g.
341 module M where { class C a b | a -> b }
343 and suppose we are compiling module X:
349 instance C S T where ...
351 If we base the instance verion on T, I'm worried that changing S to S'
352 would change T's version, but not S or S'. But an importing module might
353 not depend on T, and so might not be recompiled even though the new instance
354 (C S' T) might be relevant. I have not been able to make a concrete example,
355 and it seems deeply obscure, so I'm going to leave it for now.
358 Note [Versioning of rules]
359 ~~~~~~~~~~~~~~~~~~~~~~~~~~
360 A rule that is not an orphan has an ifRuleOrph field of (Just n), where n
361 appears on the LHS of the rule; any change in the rule changes the version of n.
365 -- -----------------------------------------------------------------------------
368 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
369 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
370 -- Deeply revolting, because it has to predict what gets bound,
371 -- especially the question of whether there's a wrapper for a datacon
373 -- N.B. the set of names returned here *must* match the set of
374 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
375 -- TyThing.getOccName should define a bijection between the two lists.
376 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
377 -- The order of the list does not matter.
378 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
381 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
382 ifCons = IfNewTyCon (
383 IfCon { ifConOcc = con_occ }),
384 ifFamInst = famInst})
385 = -- implicit coerion and (possibly) family instance coercion
386 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
387 -- data constructor and worker (newtypes don't have a wrapper)
388 [con_occ, mkDataConWorkerOcc con_occ]
391 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
392 ifCons = IfDataTyCon cons,
393 ifFamInst = famInst})
394 = -- (possibly) family instance coercion;
395 -- there is no implicit coercion for non-newtypes
396 famInstCo famInst tc_occ
397 -- for each data constructor in order,
398 -- data constructor, worker, and (possibly) wrapper
399 ++ concatMap dc_occs cons
402 | has_wrapper = [con_occ, work_occ, wrap_occ]
403 | otherwise = [con_occ, work_occ]
405 con_occ = ifConOcc con_decl -- DataCon namespace
406 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
407 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
408 has_wrapper = ifConWrapper con_decl -- This is the reason for
409 -- having the ifConWrapper field!
411 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
412 ifSigs = sigs, ifATs = ats })
413 = -- dictionary datatype:
416 -- (possibly) newtype coercion
418 -- data constructor (DataCon namespace)
419 -- data worker (Id namespace)
420 -- no wrapper (class dictionaries never have a wrapper)
421 [dc_occ, dcww_occ] ++
423 [ifName at | at <- ats ] ++
424 -- superclass selectors
425 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
426 -- operation selectors
427 [op | IfaceClassOp op _ _ <- sigs]
429 n_ctxt = length sc_ctxt
431 tc_occ = mkClassTyConOcc cls_occ
432 dc_occ = mkClassDataConOcc cls_occ
433 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
435 dcww_occ = mkDataConWorkerOcc dc_occ
436 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
438 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
439 ifFamInst = famInst})
440 = famInstCo famInst tc_occ
442 ifaceDeclSubBndrs _ = []
444 -- coercion for data/newtype family instances
445 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
446 famInstCo Nothing _ = []
447 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
449 ----------------------------- Printing IfaceDecl ------------------------------
451 instance Outputable IfaceDecl where
454 pprIfaceDecl :: IfaceDecl -> SDoc
455 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
456 ifIdDetails = details, ifIdInfo = info})
457 = sep [ ppr var <+> dcolon <+> ppr ty,
458 nest 2 (ppr details),
461 pprIfaceDecl (IfaceForeign {ifName = tycon})
462 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
464 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
465 ifSynRhs = Just mono_ty,
466 ifFamInst = mbFamInst})
467 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
468 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
470 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
471 ifSynRhs = Nothing, ifSynKind = kind })
472 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
473 4 (dcolon <+> ppr kind)
475 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
476 ifTyVars = tyvars, ifCons = condecls,
477 ifRec = isrec, ifFamInst = mbFamInst})
478 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
479 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
480 pprFamily mbFamInst])
482 pp_nd = case condecls of
483 IfAbstractTyCon -> ptext (sLit "data")
484 IfOpenDataTyCon -> ptext (sLit "data family")
485 IfDataTyCon _ -> ptext (sLit "data")
486 IfNewTyCon _ -> ptext (sLit "newtype")
488 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
489 ifFDs = fds, ifATs = ats, ifSigs = sigs,
491 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
492 4 (vcat [pprRec isrec,
496 pprRec :: RecFlag -> SDoc
497 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
499 pprGen :: Bool -> SDoc
500 pprGen True = ptext (sLit "Generics: yes")
501 pprGen False = ptext (sLit "Generics: no")
503 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
504 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
505 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
507 instance Outputable IfaceClassOp where
508 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
510 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
511 pprIfaceDeclHead context thing tyvars
512 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
513 pprIfaceTvBndrs tyvars]
515 pp_condecls :: OccName -> IfaceConDecls -> SDoc
516 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
517 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
518 pp_condecls _ IfOpenDataTyCon = empty
519 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
520 (map (pprIfaceConDecl tc) cs))
522 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
524 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
525 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
526 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
527 ifConStricts = strs, ifConFields = fields })
529 if is_infix then ptext (sLit "Infix") else empty,
530 if has_wrap then ptext (sLit "HasWrapper") else empty,
531 ppUnless (null strs) $
532 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
533 ppUnless (null fields) $
534 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
536 ppr_bang HsNoBang = char '_' -- Want to see these
537 ppr_bang bang = ppr bang
539 main_payload = ppr name <+> dcolon <+>
540 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
542 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
543 | (tv,ty) <- eq_spec]
545 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
546 -- because we don't have a Name for the tycon, only an OccName
547 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
548 (t:ts) -> fsep (t : map (arrow <+>) ts)
549 [] -> panic "pp_con_taus"
551 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
553 instance Outputable IfaceRule where
554 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
555 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
556 = sep [hsep [doubleQuotes (ftext name), ppr act,
557 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
558 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
559 ptext (sLit "=") <+> ppr rhs])
562 instance Outputable IfaceInst where
563 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
564 ifInstCls = cls, ifInstTys = mb_tcs})
565 = hang (ptext (sLit "instance") <+> ppr flag
566 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
567 2 (equals <+> ppr dfun_id)
569 instance Outputable IfaceFamInst where
570 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
571 ifFamInstTyCon = tycon_id})
572 = hang (ptext (sLit "family instance") <+>
573 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
574 2 (equals <+> ppr tycon_id)
576 ppr_rough :: Maybe IfaceTyCon -> SDoc
577 ppr_rough Nothing = dot
578 ppr_rough (Just tc) = ppr tc
582 ----------------------------- Printing IfaceExpr ------------------------------------
585 instance Outputable IfaceExpr where
586 ppr e = pprIfaceExpr noParens e
588 pprParendIfaceExpr :: IfaceExpr -> SDoc
589 pprParendIfaceExpr = pprIfaceExpr parens
591 -- | Pretty Print an IfaceExpre
593 -- The first argument should be a function that adds parens in context that need
594 -- an atomic value (e.g. function args)
595 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
597 pprIfaceExpr _ (IfaceLcl v) = ppr v
598 pprIfaceExpr _ (IfaceExt v) = ppr v
599 pprIfaceExpr _ (IfaceLit l) = ppr l
600 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
601 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
602 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
604 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
605 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
607 pprIfaceExpr add_par i@(IfaceLam _ _)
608 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
609 pprIfaceExpr noParens body])
611 (bndrs,body) = collect [] i
612 collect bs (IfaceLam b e) = collect (b:bs) e
613 collect bs e = (reverse bs, e)
615 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
616 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
617 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
618 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
619 pprIfaceExpr noParens rhs <+> char '}'])
621 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
622 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
623 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
624 <+> ppr bndr <+> char '{',
625 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
627 pprIfaceExpr _ (IfaceCast expr co)
628 = sep [pprParendIfaceExpr expr,
629 nest 2 (ptext (sLit "`cast`")),
630 pprParendIfaceType co]
632 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
633 = add_par (sep [ptext (sLit "let {"),
634 nest 2 (ppr_bind (b, rhs)),
636 pprIfaceExpr noParens body])
638 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
639 = add_par (sep [ptext (sLit "letrec {"),
640 nest 2 (sep (map ppr_bind pairs)),
642 pprIfaceExpr noParens body])
644 pprIfaceExpr add_par (IfaceNote note body) = add_par $ ppr note
645 <+> pprParendIfaceExpr body
647 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
648 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
649 arrow <+> pprIfaceExpr noParens rhs]
651 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
652 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
653 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
655 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
656 ppr_bind (IfLetBndr b ty info, rhs)
657 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
658 equals <+> pprIfaceExpr noParens rhs]
661 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
662 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
663 nest 2 (pprParendIfaceExpr arg) : args
664 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
667 instance Outputable IfaceNote where
668 ppr (IfaceSCC cc) = pprCostCentreCore cc
669 ppr (IfaceCoreNote s) = ptext (sLit "__core_note")
670 <+> pprHsString (mkFastString s)
673 instance Outputable IfaceConAlt where
674 ppr IfaceDefault = text "DEFAULT"
675 ppr (IfaceLitAlt l) = ppr l
676 ppr (IfaceDataAlt d) = ppr d
677 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
678 -- IfaceTupleAlt is handled by the case-alternative printer
681 instance Outputable IfaceIdDetails where
682 ppr IfVanillaId = empty
683 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
684 <+> if b then ptext (sLit "<naughty>") else empty
685 ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns)
687 instance Outputable IfaceIdInfo where
689 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
690 <+> ptext (sLit "-}")
692 instance Outputable IfaceInfoItem where
693 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding")
694 <> ppWhen lb (ptext (sLit "(loop-breaker)"))
696 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
697 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
698 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
699 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
701 instance Outputable IfaceUnfolding where
702 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
703 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty)
705 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
707 pprParendIfaceExpr e]
708 ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
709 <+> parens (ptext (sLit "arity") <+> int a)
710 ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
711 <+> parens (ptext (sLit "arity") <+> int a)
712 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
713 <+> brackets (pprWithCommas ppr ns)
715 -- -----------------------------------------------------------------------------
716 -- | Finding the Names in IfaceSyn
718 -- This is used for dependency analysis in MkIface, so that we
719 -- fingerprint a declaration before the things that depend on it. It
720 -- is specific to interface-file fingerprinting in the sense that we
721 -- don't collect *all* Names: for example, the DFun of an instance is
722 -- recorded textually rather than by its fingerprint when
723 -- fingerprinting the instance, so DFuns are not dependencies.
725 freeNamesIfDecl :: IfaceDecl -> NameSet
726 freeNamesIfDecl (IfaceId _s t d i) =
727 freeNamesIfType t &&&
728 freeNamesIfIdInfo i &&&
729 freeNamesIfIdDetails d
730 freeNamesIfDecl IfaceForeign{} =
732 freeNamesIfDecl d@IfaceData{} =
733 freeNamesIfTvBndrs (ifTyVars d) &&&
734 freeNamesIfTcFam (ifFamInst d) &&&
735 freeNamesIfContext (ifCtxt d) &&&
736 freeNamesIfConDecls (ifCons d)
737 freeNamesIfDecl d@IfaceSyn{} =
738 freeNamesIfTvBndrs (ifTyVars d) &&&
739 freeNamesIfSynRhs (ifSynRhs d) &&&
740 freeNamesIfTcFam (ifFamInst d)
741 freeNamesIfDecl d@IfaceClass{} =
742 freeNamesIfTvBndrs (ifTyVars d) &&&
743 freeNamesIfContext (ifCtxt d) &&&
744 freeNamesIfDecls (ifATs d) &&&
745 fnList freeNamesIfClsSig (ifSigs d)
747 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
748 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
749 freeNamesIfIdDetails _ = emptyNameSet
751 -- All other changes are handled via the version info on the tycon
752 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
753 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
754 freeNamesIfSynRhs Nothing = emptyNameSet
756 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
757 freeNamesIfTcFam (Just (tc,tys)) =
758 freeNamesIfTc tc &&& fnList freeNamesIfType tys
759 freeNamesIfTcFam Nothing =
762 freeNamesIfContext :: IfaceContext -> NameSet
763 freeNamesIfContext = fnList freeNamesIfPredType
765 freeNamesIfDecls :: [IfaceDecl] -> NameSet
766 freeNamesIfDecls = fnList freeNamesIfDecl
768 freeNamesIfClsSig :: IfaceClassOp -> NameSet
769 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
771 freeNamesIfConDecls :: IfaceConDecls -> NameSet
772 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
773 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
774 freeNamesIfConDecls _ = emptyNameSet
776 freeNamesIfConDecl :: IfaceConDecl -> NameSet
777 freeNamesIfConDecl c =
778 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
779 freeNamesIfTvBndrs (ifConExTvs c) &&&
780 freeNamesIfContext (ifConCtxt c) &&&
781 fnList freeNamesIfType (ifConArgTys c) &&&
782 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
784 freeNamesIfPredType :: IfacePredType -> NameSet
785 freeNamesIfPredType (IfaceClassP cl tys) =
786 unitNameSet cl &&& fnList freeNamesIfType tys
787 freeNamesIfPredType (IfaceIParam _n ty) =
789 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
790 freeNamesIfType ty1 &&& freeNamesIfType ty2
792 freeNamesIfType :: IfaceType -> NameSet
793 freeNamesIfType (IfaceTyVar _) = emptyNameSet
794 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
795 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
796 freeNamesIfType (IfaceTyConApp tc ts) =
797 freeNamesIfTc tc &&& fnList freeNamesIfType ts
798 freeNamesIfType (IfaceForAllTy tv t) =
799 freeNamesIfTvBndr tv &&& freeNamesIfType t
800 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
802 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
803 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
805 freeNamesIfBndr :: IfaceBndr -> NameSet
806 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
807 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
809 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
810 -- Remember IfaceLetBndr is used only for *nested* bindings
811 -- The IdInfo can contain an unfolding (in the case of
812 -- local INLINE pragmas), so look there too
813 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
814 &&& freeNamesIfIdInfo info
816 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
817 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
818 -- kinds can have Names inside, when the Kind is an equality predicate
820 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
821 freeNamesIfIdBndr = freeNamesIfTvBndr
823 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
824 freeNamesIfIdInfo NoInfo = emptyNameSet
825 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
827 freeNamesItem :: IfaceInfoItem -> NameSet
828 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
829 freeNamesItem _ = emptyNameSet
831 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
832 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
833 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
834 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
835 freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
836 freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
837 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
839 freeNamesIfExpr :: IfaceExpr -> NameSet
840 freeNamesIfExpr (IfaceExt v) = unitNameSet v
841 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
842 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
843 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
844 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
845 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
846 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
847 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
849 freeNamesIfExpr (IfaceCase s _ ty alts)
851 &&& fnList fn_alt alts &&& fn_cons alts
852 &&& freeNamesIfType ty
854 fn_alt (_con,_bs,r) = freeNamesIfExpr r
856 -- Depend on the data constructors. Just one will do!
857 -- Note [Tracking data constructors]
858 fn_cons [] = emptyNameSet
859 fn_cons ((IfaceDefault ,_,_) : xs) = fn_cons xs
860 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
861 fn_cons (_ : _ ) = emptyNameSet
863 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
864 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
866 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
867 = fnList fn_pair as &&& freeNamesIfExpr x
869 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
871 freeNamesIfExpr _ = emptyNameSet
873 freeNamesIfTc :: IfaceTyCon -> NameSet
874 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
875 -- ToDo: shouldn't we include IfaceIntTc & co.?
876 freeNamesIfTc _ = emptyNameSet
878 freeNamesIfRule :: IfaceRule -> NameSet
879 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
880 , ifRuleArgs = es, ifRuleRhs = rhs })
882 fnList freeNamesIfBndr bs &&&
883 fnList freeNamesIfExpr es &&&
887 (&&&) :: NameSet -> NameSet -> NameSet
888 (&&&) = unionNameSets
890 fnList :: (a -> NameSet) -> [a] -> NameSet
891 fnList f = foldr (&&&) emptyNameSet . map f
894 Note [Tracking data constructors]
895 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
897 case e of { C a -> ...; ... }
898 You might think that we don't need to include the datacon C
899 in the free names, because its type will probably show up in
900 the free names of 'e'. But in rare circumstances this may
901 not happen. Here's the one that bit me:
903 module DynFlags where
904 import {-# SOURCE #-} Packages( PackageState )
905 data DynFlags = DF ... PackageState ...
907 module Packages where
909 data PackageState = PS ...
910 lookupModule (df :: DynFlags)
912 DF ...p... -> case p of
915 Now, lookupModule depends on DynFlags, but the transitive dependency
916 on the *locally-defined* type PackageState is not visible. We need
917 to take account of the use of the data constructor PS in the pattern match.