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(..),
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"
49 %************************************************************************
51 Data type declarations
53 %************************************************************************
57 = IfaceId { ifName :: OccName,
59 ifIdDetails :: IfaceIdDetails,
60 ifIdInfo :: IfaceIdInfo }
62 | IfaceData { ifName :: OccName, -- Type constructor
63 ifTyVars :: [IfaceTvBndr], -- Type variables
64 ifCtxt :: IfaceContext, -- The "stupid theta"
65 ifCons :: IfaceConDecls, -- Includes new/data info
66 ifRec :: RecFlag, -- Recursive or not?
67 ifGadtSyntax :: Bool, -- True <=> declared using
69 ifGeneric :: Bool, -- True <=> generic converter
70 -- functions available
71 -- We need this for imported
72 -- data decls, since the
73 -- imported modules may have
75 -- different flags to the
76 -- current compilation unit
77 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
78 -- Just <=> instance of family
80 -- ifCons /= IfOpenDataTyCon
81 -- for family instances
84 | IfaceSyn { ifName :: OccName, -- Type constructor
85 ifTyVars :: [IfaceTvBndr], -- Type variables
86 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
87 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
88 -- Nothing for an open family
89 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
90 -- Just <=> instance of family
91 -- Invariant: ifOpenSyn == False
92 -- for family instances
95 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
96 ifName :: OccName, -- Name of the class
97 ifTyVars :: [IfaceTvBndr], -- Type variables
98 ifFDs :: [FunDep FastString], -- Functional dependencies
99 ifATs :: [IfaceDecl], -- Associated type families
100 ifSigs :: [IfaceClassOp], -- Method signatures
101 ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
104 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
106 ifExtName :: Maybe FastString }
108 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
109 -- Nothing => no default method
110 -- Just False => ordinary polymorphic default method
111 -- Just True => generic default method
114 = IfAbstractTyCon -- No info
115 | IfOpenDataTyCon -- Open data family
116 | IfDataTyCon [IfaceConDecl] -- data type decls
117 | IfNewTyCon IfaceConDecl -- newtype decls
119 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
120 visibleIfConDecls IfAbstractTyCon = []
121 visibleIfConDecls IfOpenDataTyCon = []
122 visibleIfConDecls (IfDataTyCon cs) = cs
123 visibleIfConDecls (IfNewTyCon c) = [c]
127 ifConOcc :: OccName, -- Constructor name
128 ifConWrapper :: Bool, -- True <=> has a wrapper
129 ifConInfix :: Bool, -- True <=> declared infix
130 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
131 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
132 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
133 ifConCtxt :: IfaceContext, -- Non-stupid context
134 ifConArgTys :: [IfaceType], -- Arg types
135 ifConFields :: [OccName], -- ...ditto... (field labels)
136 ifConStricts :: [HsBang]} -- Empty (meaning all lazy),
137 -- or 1-1 corresp with arg tys
140 = IfaceInst { ifInstCls :: Name, -- See comments with
141 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
142 ifDFun :: Name, -- The dfun
143 ifOFlag :: OverlapFlag, -- Overlap flag
144 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
145 -- There's always a separate IfaceDecl for the DFun, which gives
146 -- its IdInfo with its full type and version number.
147 -- The instance declarations taken together have a version number,
148 -- and we don't want that to wobble gratuitously
149 -- If this instance decl is *used*, we'll record a usage on the dfun;
150 -- and if the head does not change it won't be used if it wasn't before
153 = IfaceFamInst { ifFamInstFam :: Name -- Family tycon
154 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
155 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
160 ifRuleName :: RuleName,
161 ifActivation :: Activation,
162 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
163 ifRuleHead :: Name, -- Head of lhs
164 ifRuleArgs :: [IfaceExpr], -- Args of LHS
165 ifRuleRhs :: IfaceExpr,
166 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
171 ifAnnotatedTarget :: IfaceAnnTarget,
172 ifAnnotatedValue :: Serialized
175 type IfaceAnnTarget = AnnTarget OccName
177 -- We only serialise the IdDetails of top-level Ids, and even then
178 -- we only need a very limited selection. Notably, none of the
179 -- implicit ones are needed here, becuase they are not put it
184 | IfRecSelId IfaceTyCon Bool
188 = NoInfo -- When writing interface file without -O
189 | HasInfo [IfaceInfoItem] -- Has info, and here it is
191 -- Here's a tricky case:
192 -- * Compile with -O module A, and B which imports A.f
193 -- * Change function f in A, and recompile without -O
194 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
195 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
196 -- but we do not do that now. Instead it's discarded when the
197 -- ModIface is read into the various decl pools.)
198 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
199 -- and so gives a new version.
203 | HsStrictness StrictSig
204 | HsInline InlinePragma
205 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
206 IfaceUnfolding -- See Note [Expose recursive functions]
209 -- NB: Specialisations and rules come in separately and are
210 -- only later attached to the Id. Partial reason: some are orphans.
213 = IfCoreUnfold IfaceExpr
214 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
217 Bool -- OK to inline even if *un*-saturated
218 Bool -- OK to inline even if context is boring
221 | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
222 -- can simplify to a function in another module.
224 | IfDFunUnfold [IfaceExpr]
226 --------------------------------
228 = IfaceLcl FastString
230 | IfaceType IfaceType
231 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
232 | IfaceLam IfaceBndr IfaceExpr
233 | IfaceApp IfaceExpr IfaceExpr
234 | IfaceCase IfaceExpr FastString IfaceType [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, [FastString], IfaceExpr)
246 -- Note: FastString, 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
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 FastString 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 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
280 Currently we only actually retain InlinePragInfo, but in principle we could
284 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
285 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
286 If a module contains any "orphans", then its interface file is read
287 regardless, so that its instances are not missed.
289 Roughly speaking, an instance is an orphan if its head (after the =>)
290 mentions nothing defined in this module. Functional dependencies
291 complicate the situation though. Consider
293 module M where { class C a b | a -> b }
295 and suppose we are compiling module X:
300 instance C Int T where ...
302 This instance is an orphan, because when compiling a third module Y we
303 might get a constraint (C Int v), and we'd want to improve v to T. So
304 we must make sure X's instances are loaded, even if we do not directly
307 More precisely, an instance is an orphan iff
309 If there are no fundeps, then at least of the names in
310 the instance head is locally defined.
312 If there are fundeps, then for every fundep, at least one of the
313 names free in a *non-determined* part of the instance head is
314 defined in this module.
316 (Note that these conditions hold trivially if the class is locally
319 Note [Versioning of instances]
320 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
321 Now consider versioning. If we *use* an instance decl in one compilation,
322 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
323 But suppose we *don't* (currently) use an instance! We must recompile if
324 the instance is changed in such a way that it becomes important. (This would
325 only matter with overlapping instances, else the importing module wouldn't have
326 compiled before and the recompilation check is irrelevant.)
328 The is_orph field is set to (Just n) if the instance is not an orphan.
329 The 'n' is *any* of the locally-defined names mentioned anywhere in the
330 instance head. This name is used for versioning; the instance decl is
331 considered part of the defn of this 'n'.
333 I'm worried about whether this works right if we pick a name from
334 a functionally-dependent part of the instance decl. E.g.
336 module M where { class C a b | a -> b }
338 and suppose we are compiling module X:
344 instance C S T where ...
346 If we base the instance verion on T, I'm worried that changing S to S'
347 would change T's version, but not S or S'. But an importing module might
348 not depend on T, and so might not be recompiled even though the new instance
349 (C S' T) might be relevant. I have not been able to make a concrete example,
350 and it seems deeply obscure, so I'm going to leave it for now.
353 Note [Versioning of rules]
354 ~~~~~~~~~~~~~~~~~~~~~~~~~~
355 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
356 n appears on the LHS of the rule; any change in the rule changes the version of n.
360 -- -----------------------------------------------------------------------------
363 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
364 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
365 -- Deeply revolting, because it has to predict what gets bound,
366 -- especially the question of whether there's a wrapper for a datacon
368 -- N.B. the set of names returned here *must* match the set of
369 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
370 -- TyThing.getOccName should define a bijection between the two lists.
371 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
372 -- The order of the list does not matter.
373 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
376 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
377 ifCons = IfNewTyCon (
378 IfCon { ifConOcc = con_occ }),
379 ifFamInst = famInst})
380 = -- implicit coerion and (possibly) family instance coercion
381 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
382 -- data constructor and worker (newtypes don't have a wrapper)
383 [con_occ, mkDataConWorkerOcc con_occ]
386 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
387 ifCons = IfDataTyCon cons,
388 ifFamInst = famInst})
389 = -- (possibly) family instance coercion;
390 -- there is no implicit coercion for non-newtypes
391 famInstCo famInst tc_occ
392 -- for each data constructor in order,
393 -- data constructor, worker, and (possibly) wrapper
394 ++ concatMap dc_occs cons
397 | has_wrapper = [con_occ, work_occ, wrap_occ]
398 | otherwise = [con_occ, work_occ]
400 con_occ = ifConOcc con_decl -- DataCon namespace
401 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
402 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
403 has_wrapper = ifConWrapper con_decl -- This is the reason for
404 -- having the ifConWrapper field!
406 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
407 ifSigs = sigs, ifATs = ats })
408 = -- dictionary datatype:
411 -- (possibly) newtype coercion
413 -- data constructor (DataCon namespace)
414 -- data worker (Id namespace)
415 -- no wrapper (class dictionaries never have a wrapper)
416 [dc_occ, dcww_occ] ++
418 [ifName at | at <- ats ] ++
419 -- superclass selectors
420 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
421 -- operation selectors
422 [op | IfaceClassOp op _ _ <- sigs]
424 n_ctxt = length sc_ctxt
426 tc_occ = mkClassTyConOcc cls_occ
427 dc_occ = mkClassDataConOcc cls_occ
428 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
430 dcww_occ = mkDataConWorkerOcc dc_occ
431 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
433 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
434 ifFamInst = famInst})
435 = famInstCo famInst tc_occ
437 ifaceDeclSubBndrs _ = []
439 -- coercion for data/newtype family instances
440 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
441 famInstCo Nothing _ = []
442 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
444 ----------------------------- Printing IfaceDecl ------------------------------
446 instance Outputable IfaceDecl where
449 pprIfaceDecl :: IfaceDecl -> SDoc
450 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
451 ifIdDetails = details, ifIdInfo = info})
452 = sep [ ppr var <+> dcolon <+> ppr ty,
453 nest 2 (ppr details),
456 pprIfaceDecl (IfaceForeign {ifName = tycon})
457 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
459 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
460 ifSynRhs = Just mono_ty,
461 ifFamInst = mbFamInst})
462 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
463 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
465 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
466 ifSynRhs = Nothing, ifSynKind = kind })
467 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
468 4 (dcolon <+> ppr kind)
470 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
471 ifTyVars = tyvars, ifCons = condecls,
472 ifRec = isrec, ifFamInst = mbFamInst})
473 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
474 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
475 pprFamily mbFamInst])
477 pp_nd = case condecls of
478 IfAbstractTyCon -> ptext (sLit "data")
479 IfOpenDataTyCon -> ptext (sLit "data family")
480 IfDataTyCon _ -> ptext (sLit "data")
481 IfNewTyCon _ -> ptext (sLit "newtype")
483 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
484 ifFDs = fds, ifATs = ats, ifSigs = sigs,
486 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
487 4 (vcat [pprRec isrec,
491 pprRec :: RecFlag -> SDoc
492 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
494 pprGen :: Bool -> SDoc
495 pprGen True = ptext (sLit "Generics: yes")
496 pprGen False = ptext (sLit "Generics: no")
498 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
499 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
500 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
502 instance Outputable IfaceClassOp where
503 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
505 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
506 pprIfaceDeclHead context thing tyvars
507 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
508 pprIfaceTvBndrs tyvars]
510 pp_condecls :: OccName -> IfaceConDecls -> SDoc
511 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
512 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
513 pp_condecls _ IfOpenDataTyCon = empty
514 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
515 (map (pprIfaceConDecl tc) cs))
517 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
519 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
520 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
521 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
522 ifConStricts = strs, ifConFields = fields })
524 if is_infix then ptext (sLit "Infix") else empty,
525 if has_wrap then ptext (sLit "HasWrapper") else empty,
526 ppUnless (null strs) $
527 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
528 ppUnless (null fields) $
529 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
531 ppr_bang HsNoBang = char '_' -- Want to see these
532 ppr_bang bang = ppr bang
534 main_payload = ppr name <+> dcolon <+>
535 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
537 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
538 | (tv,ty) <- eq_spec]
540 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
541 -- because we don't have a Name for the tycon, only an OccName
542 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
543 (t:ts) -> fsep (t : map (arrow <+>) ts)
544 [] -> panic "pp_con_taus"
546 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
548 instance Outputable IfaceRule where
549 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
550 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
551 = sep [hsep [doubleQuotes (ftext name), ppr act,
552 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
553 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
554 ptext (sLit "=") <+> ppr rhs])
557 instance Outputable IfaceInst where
558 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
559 ifInstCls = cls, ifInstTys = mb_tcs})
560 = hang (ptext (sLit "instance") <+> ppr flag
561 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
562 2 (equals <+> ppr dfun_id)
564 instance Outputable IfaceFamInst where
565 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
566 ifFamInstTyCon = tycon_id})
567 = hang (ptext (sLit "family instance") <+>
568 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
569 2 (equals <+> ppr tycon_id)
571 ppr_rough :: Maybe IfaceTyCon -> SDoc
572 ppr_rough Nothing = dot
573 ppr_rough (Just tc) = ppr tc
577 ----------------------------- Printing IfaceExpr ------------------------------------
580 instance Outputable IfaceExpr where
581 ppr e = pprIfaceExpr noParens e
583 pprParendIfaceExpr :: IfaceExpr -> SDoc
584 pprParendIfaceExpr = pprIfaceExpr parens
586 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
587 -- The function adds parens in context that need
588 -- an atomic value (e.g. function args)
590 pprIfaceExpr _ (IfaceLcl v) = ppr v
591 pprIfaceExpr _ (IfaceExt v) = ppr v
592 pprIfaceExpr _ (IfaceLit l) = ppr l
593 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
594 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
595 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
597 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
598 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
600 pprIfaceExpr add_par e@(IfaceLam _ _)
601 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
602 pprIfaceExpr noParens body])
604 (bndrs,body) = collect [] e
605 collect bs (IfaceLam b e) = collect (b:bs) e
606 collect bs e = (reverse bs, e)
608 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
609 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
610 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
611 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
612 pprIfaceExpr noParens rhs <+> char '}'])
614 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
615 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
616 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
617 <+> ppr bndr <+> char '{',
618 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
620 pprIfaceExpr _ (IfaceCast expr co)
621 = sep [pprParendIfaceExpr expr,
622 nest 2 (ptext (sLit "`cast`")),
623 pprParendIfaceType co]
625 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
626 = add_par (sep [ptext (sLit "let {"),
627 nest 2 (ppr_bind (b, rhs)),
629 pprIfaceExpr noParens body])
631 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
632 = add_par (sep [ptext (sLit "letrec {"),
633 nest 2 (sep (map ppr_bind pairs)),
635 pprIfaceExpr noParens body])
637 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
639 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
640 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
641 arrow <+> pprIfaceExpr noParens rhs]
643 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
644 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
645 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
647 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
648 ppr_bind (IfLetBndr b ty info, rhs)
649 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
650 equals <+> pprIfaceExpr noParens rhs]
653 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
654 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
655 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
658 instance Outputable IfaceNote where
659 ppr (IfaceSCC cc) = pprCostCentreCore cc
660 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> 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 = ptext (sLit "DFunId")
677 instance Outputable IfaceIdInfo where
679 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
681 instance Outputable IfaceInfoItem where
682 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
684 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
685 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
686 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
687 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
689 instance Outputable IfaceUnfolding where
690 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
691 ppr (IfCoreUnfold e) = parens (ppr e)
692 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
693 pprParendIfaceExpr e]
694 ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
695 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:") <+> brackets (pprWithCommas pprParendIfaceExpr ns)
698 -- -----------------------------------------------------------------------------
699 -- Finding the Names in IfaceSyn
701 -- This is used for dependency analysis in MkIface, so that we
702 -- fingerprint a declaration before the things that depend on it. It
703 -- is specific to interface-file fingerprinting in the sense that we
704 -- don't collect *all* Names: for example, the DFun of an instance is
705 -- recorded textually rather than by its fingerprint when
706 -- fingerprinting the instance, so DFuns are not dependencies.
708 freeNamesIfDecl :: IfaceDecl -> NameSet
709 freeNamesIfDecl (IfaceId _s t d i) =
710 freeNamesIfType t &&&
711 freeNamesIfIdInfo i &&&
712 freeNamesIfIdDetails d
713 freeNamesIfDecl IfaceForeign{} =
715 freeNamesIfDecl d@IfaceData{} =
716 freeNamesIfTvBndrs (ifTyVars d) &&&
717 freeNamesIfTcFam (ifFamInst d) &&&
718 freeNamesIfContext (ifCtxt d) &&&
719 freeNamesIfConDecls (ifCons d)
720 freeNamesIfDecl d@IfaceSyn{} =
721 freeNamesIfTvBndrs (ifTyVars d) &&&
722 freeNamesIfSynRhs (ifSynRhs d) &&&
723 freeNamesIfTcFam (ifFamInst d)
724 freeNamesIfDecl d@IfaceClass{} =
725 freeNamesIfTvBndrs (ifTyVars d) &&&
726 freeNamesIfContext (ifCtxt d) &&&
727 freeNamesIfDecls (ifATs d) &&&
728 fnList freeNamesIfClsSig (ifSigs d)
730 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
731 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
732 freeNamesIfIdDetails _ = emptyNameSet
734 -- All other changes are handled via the version info on the tycon
735 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
736 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
737 freeNamesIfSynRhs Nothing = emptyNameSet
739 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
740 freeNamesIfTcFam (Just (tc,tys)) =
741 freeNamesIfTc tc &&& fnList freeNamesIfType tys
742 freeNamesIfTcFam Nothing =
745 freeNamesIfContext :: IfaceContext -> NameSet
746 freeNamesIfContext = fnList freeNamesIfPredType
748 freeNamesIfDecls :: [IfaceDecl] -> NameSet
749 freeNamesIfDecls = fnList freeNamesIfDecl
751 freeNamesIfClsSig :: IfaceClassOp -> NameSet
752 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
754 freeNamesIfConDecls :: IfaceConDecls -> NameSet
755 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
756 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
757 freeNamesIfConDecls _ = emptyNameSet
759 freeNamesIfConDecl :: IfaceConDecl -> NameSet
760 freeNamesIfConDecl c =
761 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
762 freeNamesIfTvBndrs (ifConExTvs c) &&&
763 freeNamesIfContext (ifConCtxt c) &&&
764 fnList freeNamesIfType (ifConArgTys c) &&&
765 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
767 freeNamesIfPredType :: IfacePredType -> NameSet
768 freeNamesIfPredType (IfaceClassP cl tys) =
769 unitNameSet cl &&& fnList freeNamesIfType tys
770 freeNamesIfPredType (IfaceIParam _n ty) =
772 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
773 freeNamesIfType ty1 &&& freeNamesIfType ty2
775 freeNamesIfType :: IfaceType -> NameSet
776 freeNamesIfType (IfaceTyVar _) = emptyNameSet
777 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
778 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
779 freeNamesIfType (IfaceTyConApp tc ts) =
780 freeNamesIfTc tc &&& fnList freeNamesIfType ts
781 freeNamesIfType (IfaceForAllTy tv t) =
782 freeNamesIfTvBndr tv &&& freeNamesIfType t
783 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
785 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
786 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
788 freeNamesIfBndr :: IfaceBndr -> NameSet
789 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
790 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
792 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
793 -- Remember IfaceLetBndr is used only for *nested* bindings
794 -- The cut-down IdInfo never contains any Names, but the type may!
795 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
797 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
798 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
799 -- kinds can have Names inside, when the Kind is an equality predicate
801 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
802 freeNamesIfIdBndr = freeNamesIfTvBndr
804 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
805 freeNamesIfIdInfo NoInfo = emptyNameSet
806 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
808 freeNamesItem :: IfaceInfoItem -> NameSet
809 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
810 freeNamesItem _ = emptyNameSet
812 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
813 freeNamesIfUnfold (IfCoreUnfold e) = freeNamesIfExpr e
814 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
815 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
816 freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
817 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
819 freeNamesIfExpr :: IfaceExpr -> NameSet
820 freeNamesIfExpr (IfaceExt v) = unitNameSet v
821 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
822 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
823 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
824 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
825 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
826 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
827 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
829 freeNamesIfExpr (IfaceCase s _ ty alts)
831 &&& fnList fn_alt alts &&& fn_cons alts
832 &&& freeNamesIfType ty
834 fn_alt (_con,_bs,r) = freeNamesIfExpr r
836 -- Depend on the data constructors. Just one will do!
837 -- Note [Tracking data constructors]
838 fn_cons [] = emptyNameSet
839 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
840 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
841 fn_cons (_ : _ ) = emptyNameSet
843 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
844 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
846 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
847 = fnList fn_pair as &&& freeNamesIfExpr x
849 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
851 freeNamesIfExpr _ = emptyNameSet
854 freeNamesIfTc :: IfaceTyCon -> NameSet
855 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
856 -- ToDo: shouldn't we include IfaceIntTc & co.?
857 freeNamesIfTc _ = emptyNameSet
859 freeNamesIfRule :: IfaceRule -> NameSet
860 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
862 fnList freeNamesIfBndr bs &&&
863 fnList freeNamesIfExpr es &&&
867 (&&&) :: NameSet -> NameSet -> NameSet
868 (&&&) = unionNameSets
870 fnList :: (a -> NameSet) -> [a] -> NameSet
871 fnList f = foldr (&&&) emptyNameSet . map f
874 Note [Tracking data constructors]
875 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
877 case e of { C a -> ...; ... }
878 You might think that we don't need to include the datacon C
879 in the free names, because its type will probably show up in
880 the free names of 'e'. But in rare circumstances this may
881 not happen. Here's the one that bit me:
883 module DynFlags where
884 import {-# SOURCE #-} Packages( PackageState )
885 data DynFlags = DF ... PackageState ...
887 module Packages where
889 data PackageState = PS ...
890 lookupModule (df :: DynFlags)
892 DF ...p... -> case p of
895 Now, lookupModule depends on DynFlags, but the transitive dependency
896 on the *locally-defined* type PackageState is not visible. We need
897 to take account of the use of the data constructor PS in the pattern match.