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 DefMeth 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 :: [StrictnessMark]} -- 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
217 | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
218 -- can simplify to a function in another module.
219 | IfDFunUnfold [IfaceExpr]
221 --------------------------------
223 = IfaceLcl FastString
225 | IfaceType IfaceType
226 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
227 | IfaceLam IfaceBndr IfaceExpr
228 | IfaceApp IfaceExpr IfaceExpr
229 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
230 | IfaceLet IfaceBinding IfaceExpr
231 | IfaceNote IfaceNote IfaceExpr
232 | IfaceCast IfaceExpr IfaceCoercion
234 | IfaceFCall ForeignCall IfaceType
235 | IfaceTick Module Int
237 data IfaceNote = IfaceSCC CostCentre
238 | IfaceCoreNote String
240 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
241 -- Note: FastString, not IfaceBndr (and same with the case binder)
242 -- We reconstruct the kind/type of the thing from the context
243 -- thus saving bulk in interface files
245 data IfaceConAlt = IfaceDefault
247 | IfaceTupleAlt Boxity
248 | IfaceLitAlt Literal
251 = IfaceNonRec IfaceLetBndr IfaceExpr
252 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
254 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
255 -- It's used for *non-top-level* let/rec binders
256 -- See Note [IdInfo on nested let-bindings]
257 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
260 Note [Expose recursive functions]
261 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
262 For supercompilation we want to put *all* unfoldings in the interface
263 file, even for functions that are recursive (or big). So we need to
264 know when an unfolding belongs to a loop-breaker so that we can refrain
265 from inlining it (except during supercompilation).
267 Note [IdInfo on nested let-bindings]
268 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
269 Occasionally we want to preserve IdInfo on nested let bindings. The one
270 that came up was a NOINLINE pragma on a let-binding inside an INLINE
271 function. The user (Duncan Coutts) really wanted the NOINLINE control
272 to cross the separate compilation boundary.
274 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
275 Currently we only actually retain InlinePragInfo, but in principle we could
279 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281 If a module contains any "orphans", then its interface file is read
282 regardless, so that its instances are not missed.
284 Roughly speaking, an instance is an orphan if its head (after the =>)
285 mentions nothing defined in this module. Functional dependencies
286 complicate the situation though. Consider
288 module M where { class C a b | a -> b }
290 and suppose we are compiling module X:
295 instance C Int T where ...
297 This instance is an orphan, because when compiling a third module Y we
298 might get a constraint (C Int v), and we'd want to improve v to T. So
299 we must make sure X's instances are loaded, even if we do not directly
302 More precisely, an instance is an orphan iff
304 If there are no fundeps, then at least of the names in
305 the instance head is locally defined.
307 If there are fundeps, then for every fundep, at least one of the
308 names free in a *non-determined* part of the instance head is
309 defined in this module.
311 (Note that these conditions hold trivially if the class is locally
314 Note [Versioning of instances]
315 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
316 Now consider versioning. If we *use* an instance decl in one compilation,
317 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
318 But suppose we *don't* (currently) use an instance! We must recompile if
319 the instance is changed in such a way that it becomes important. (This would
320 only matter with overlapping instances, else the importing module wouldn't have
321 compiled before and the recompilation check is irrelevant.)
323 The is_orph field is set to (Just n) if the instance is not an orphan.
324 The 'n' is *any* of the locally-defined names mentioned anywhere in the
325 instance head. This name is used for versioning; the instance decl is
326 considered part of the defn of this 'n'.
328 I'm worried about whether this works right if we pick a name from
329 a functionally-dependent part of the instance decl. E.g.
331 module M where { class C a b | a -> b }
333 and suppose we are compiling module X:
339 instance C S T where ...
341 If we base the instance verion on T, I'm worried that changing S to S'
342 would change T's version, but not S or S'. But an importing module might
343 not depend on T, and so might not be recompiled even though the new instance
344 (C S' T) might be relevant. I have not been able to make a concrete example,
345 and it seems deeply obscure, so I'm going to leave it for now.
348 Note [Versioning of rules]
349 ~~~~~~~~~~~~~~~~~~~~~~~~~~
350 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
351 n appears on the LHS of the rule; any change in the rule changes the version of n.
355 -- -----------------------------------------------------------------------------
358 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
359 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
360 -- Deeply revolting, because it has to predict what gets bound,
361 -- especially the question of whether there's a wrapper for a datacon
363 -- N.B. the set of names returned here *must* match the set of
364 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
365 -- TyThing.getOccName should define a bijection between the two lists.
366 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
367 -- The order of the list does not matter.
368 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
371 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
372 ifCons = IfNewTyCon (
373 IfCon { ifConOcc = con_occ }),
374 ifFamInst = famInst})
375 = -- implicit coerion and (possibly) family instance coercion
376 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
377 -- data constructor and worker (newtypes don't have a wrapper)
378 [con_occ, mkDataConWorkerOcc con_occ]
381 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
382 ifCons = IfDataTyCon cons,
383 ifFamInst = famInst})
384 = -- (possibly) family instance coercion;
385 -- there is no implicit coercion for non-newtypes
386 famInstCo famInst tc_occ
387 -- for each data constructor in order,
388 -- data constructor, worker, and (possibly) wrapper
389 ++ concatMap dc_occs cons
392 | has_wrapper = [con_occ, work_occ, wrap_occ]
393 | otherwise = [con_occ, work_occ]
395 con_occ = ifConOcc con_decl -- DataCon namespace
396 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
397 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
398 has_wrapper = ifConWrapper con_decl -- This is the reason for
399 -- having the ifConWrapper field!
401 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
402 ifSigs = sigs, ifATs = ats })
403 = -- dictionary datatype:
406 -- (possibly) newtype coercion
408 -- data constructor (DataCon namespace)
409 -- data worker (Id namespace)
410 -- no wrapper (class dictionaries never have a wrapper)
411 [dc_occ, dcww_occ] ++
413 [ifName at | at <- ats ] ++
414 -- superclass selectors
415 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
416 -- operation selectors
417 [op | IfaceClassOp op _ _ <- sigs]
419 n_ctxt = length sc_ctxt
421 tc_occ = mkClassTyConOcc cls_occ
422 dc_occ = mkClassDataConOcc cls_occ
423 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
425 dcww_occ = mkDataConWorkerOcc dc_occ
426 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
428 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
429 ifFamInst = famInst})
430 = famInstCo famInst tc_occ
432 ifaceDeclSubBndrs _ = []
434 -- coercion for data/newtype family instances
435 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
436 famInstCo Nothing _ = []
437 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
439 ----------------------------- Printing IfaceDecl ------------------------------
441 instance Outputable IfaceDecl where
444 pprIfaceDecl :: IfaceDecl -> SDoc
445 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
446 ifIdDetails = details, ifIdInfo = info})
447 = sep [ ppr var <+> dcolon <+> ppr ty,
448 nest 2 (ppr details),
451 pprIfaceDecl (IfaceForeign {ifName = tycon})
452 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
454 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
455 ifSynRhs = Just mono_ty,
456 ifFamInst = mbFamInst})
457 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
458 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
460 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
461 ifSynRhs = Nothing, ifSynKind = kind })
462 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
463 4 (dcolon <+> ppr kind)
465 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
466 ifTyVars = tyvars, ifCons = condecls,
467 ifRec = isrec, ifFamInst = mbFamInst})
468 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
469 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
470 pprFamily mbFamInst])
472 pp_nd = case condecls of
473 IfAbstractTyCon -> ptext (sLit "data")
474 IfOpenDataTyCon -> ptext (sLit "data family")
475 IfDataTyCon _ -> ptext (sLit "data")
476 IfNewTyCon _ -> ptext (sLit "newtype")
478 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
479 ifFDs = fds, ifATs = ats, ifSigs = sigs,
481 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
482 4 (vcat [pprRec isrec,
486 pprRec :: RecFlag -> SDoc
487 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
489 pprGen :: Bool -> SDoc
490 pprGen True = ptext (sLit "Generics: yes")
491 pprGen False = ptext (sLit "Generics: no")
493 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
494 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
495 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
497 instance Outputable IfaceClassOp where
498 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
500 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
501 pprIfaceDeclHead context thing tyvars
502 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
503 pprIfaceTvBndrs tyvars]
505 pp_condecls :: OccName -> IfaceConDecls -> SDoc
506 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
507 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
508 pp_condecls _ IfOpenDataTyCon = empty
509 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
510 (map (pprIfaceConDecl tc) cs))
512 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
514 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
515 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
516 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
517 ifConStricts = strs, ifConFields = fields })
519 if is_infix then ptext (sLit "Infix") else empty,
520 if has_wrap then ptext (sLit "HasWrapper") else empty,
521 ppUnless (null strs) $
522 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
523 ppUnless (null fields) $
524 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
526 main_payload = ppr name <+> dcolon <+>
527 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
529 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
530 | (tv,ty) <- eq_spec]
532 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
533 -- because we don't have a Name for the tycon, only an OccName
534 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
535 (t:ts) -> fsep (t : map (arrow <+>) ts)
536 [] -> panic "pp_con_taus"
538 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
540 instance Outputable IfaceRule where
541 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
542 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
543 = sep [hsep [doubleQuotes (ftext name), ppr act,
544 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
545 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
546 ptext (sLit "=") <+> ppr rhs])
549 instance Outputable IfaceInst where
550 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
551 ifInstCls = cls, ifInstTys = mb_tcs})
552 = hang (ptext (sLit "instance") <+> ppr flag
553 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
554 2 (equals <+> ppr dfun_id)
556 instance Outputable IfaceFamInst where
557 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
558 ifFamInstTyCon = tycon_id})
559 = hang (ptext (sLit "family instance") <+>
560 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
561 2 (equals <+> ppr tycon_id)
563 ppr_rough :: Maybe IfaceTyCon -> SDoc
564 ppr_rough Nothing = dot
565 ppr_rough (Just tc) = ppr tc
569 ----------------------------- Printing IfaceExpr ------------------------------------
572 instance Outputable IfaceExpr where
573 ppr e = pprIfaceExpr noParens e
575 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
576 -- The function adds parens in context that need
577 -- an atomic value (e.g. function args)
579 pprIfaceExpr _ (IfaceLcl v) = ppr v
580 pprIfaceExpr _ (IfaceExt v) = ppr v
581 pprIfaceExpr _ (IfaceLit l) = ppr l
582 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
583 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
584 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
586 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
587 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
589 pprIfaceExpr add_par e@(IfaceLam _ _)
590 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
591 pprIfaceExpr noParens body])
593 (bndrs,body) = collect [] e
594 collect bs (IfaceLam b e) = collect (b:bs) e
595 collect bs e = (reverse bs, e)
597 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
598 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
599 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
600 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
601 pprIfaceExpr noParens rhs <+> char '}'])
603 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
604 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
605 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
606 <+> ppr bndr <+> char '{',
607 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
609 pprIfaceExpr _ (IfaceCast expr co)
610 = sep [pprIfaceExpr parens expr,
611 nest 2 (ptext (sLit "`cast`")),
612 pprParendIfaceType co]
614 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
615 = add_par (sep [ptext (sLit "let {"),
616 nest 2 (ppr_bind (b, rhs)),
618 pprIfaceExpr noParens body])
620 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
621 = add_par (sep [ptext (sLit "letrec {"),
622 nest 2 (sep (map ppr_bind pairs)),
624 pprIfaceExpr noParens body])
626 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
628 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
629 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
630 arrow <+> pprIfaceExpr noParens rhs]
632 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
633 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
634 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
636 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
637 ppr_bind (IfLetBndr b ty info, rhs)
638 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
639 equals <+> pprIfaceExpr noParens rhs]
642 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
643 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
644 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
647 instance Outputable IfaceNote where
648 ppr (IfaceSCC cc) = pprCostCentreCore cc
649 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
652 instance Outputable IfaceConAlt where
653 ppr IfaceDefault = text "DEFAULT"
654 ppr (IfaceLitAlt l) = ppr l
655 ppr (IfaceDataAlt d) = ppr d
656 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
657 -- IfaceTupleAlt is handled by the case-alternative printer
660 instance Outputable IfaceIdDetails where
661 ppr IfVanillaId = empty
662 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
663 <+> if b then ptext (sLit "<naughty>") else empty
664 ppr IfDFunId = ptext (sLit "DFunId")
666 instance Outputable IfaceIdInfo where
668 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
670 instance Outputable IfaceInfoItem where
671 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
673 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
674 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
675 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
676 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
678 instance Outputable IfaceUnfolding where
679 ppr (IfCoreUnfold e) = parens (ppr e)
680 ppr (IfInlineRule a b e) = ptext (sLit "InlineRule:")
681 <+> parens (ptext (sLit "arity") <+> int a <+> ppr b)
683 ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
684 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:") <+> brackets (pprWithCommas (pprIfaceExpr parens) ns)
687 -- -----------------------------------------------------------------------------
688 -- Finding the Names in IfaceSyn
690 -- This is used for dependency analysis in MkIface, so that we
691 -- fingerprint a declaration before the things that depend on it. It
692 -- is specific to interface-file fingerprinting in the sense that we
693 -- don't collect *all* Names: for example, the DFun of an instance is
694 -- recorded textually rather than by its fingerprint when
695 -- fingerprinting the instance, so DFuns are not dependencies.
697 freeNamesIfDecl :: IfaceDecl -> NameSet
698 freeNamesIfDecl (IfaceId _s t d i) =
699 freeNamesIfType t &&&
700 freeNamesIfIdInfo i &&&
701 freeNamesIfIdDetails d
702 freeNamesIfDecl IfaceForeign{} =
704 freeNamesIfDecl d@IfaceData{} =
705 freeNamesIfTvBndrs (ifTyVars d) &&&
706 freeNamesIfTcFam (ifFamInst d) &&&
707 freeNamesIfContext (ifCtxt d) &&&
708 freeNamesIfConDecls (ifCons d)
709 freeNamesIfDecl d@IfaceSyn{} =
710 freeNamesIfTvBndrs (ifTyVars d) &&&
711 freeNamesIfSynRhs (ifSynRhs d) &&&
712 freeNamesIfTcFam (ifFamInst d)
713 freeNamesIfDecl d@IfaceClass{} =
714 freeNamesIfTvBndrs (ifTyVars d) &&&
715 freeNamesIfContext (ifCtxt d) &&&
716 freeNamesIfDecls (ifATs d) &&&
717 fnList freeNamesIfClsSig (ifSigs d)
719 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
720 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
721 freeNamesIfIdDetails _ = emptyNameSet
723 -- All other changes are handled via the version info on the tycon
724 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
725 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
726 freeNamesIfSynRhs Nothing = emptyNameSet
728 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
729 freeNamesIfTcFam (Just (tc,tys)) =
730 freeNamesIfTc tc &&& fnList freeNamesIfType tys
731 freeNamesIfTcFam Nothing =
734 freeNamesIfContext :: IfaceContext -> NameSet
735 freeNamesIfContext = fnList freeNamesIfPredType
737 freeNamesIfDecls :: [IfaceDecl] -> NameSet
738 freeNamesIfDecls = fnList freeNamesIfDecl
740 freeNamesIfClsSig :: IfaceClassOp -> NameSet
741 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
743 freeNamesIfConDecls :: IfaceConDecls -> NameSet
744 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
745 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
746 freeNamesIfConDecls _ = emptyNameSet
748 freeNamesIfConDecl :: IfaceConDecl -> NameSet
749 freeNamesIfConDecl c =
750 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
751 freeNamesIfTvBndrs (ifConExTvs c) &&&
752 freeNamesIfContext (ifConCtxt c) &&&
753 fnList freeNamesIfType (ifConArgTys c) &&&
754 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
756 freeNamesIfPredType :: IfacePredType -> NameSet
757 freeNamesIfPredType (IfaceClassP cl tys) =
758 unitNameSet cl &&& fnList freeNamesIfType tys
759 freeNamesIfPredType (IfaceIParam _n ty) =
761 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
762 freeNamesIfType ty1 &&& freeNamesIfType ty2
764 freeNamesIfType :: IfaceType -> NameSet
765 freeNamesIfType (IfaceTyVar _) = emptyNameSet
766 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
767 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
768 freeNamesIfType (IfaceTyConApp tc ts) =
769 freeNamesIfTc tc &&& fnList freeNamesIfType ts
770 freeNamesIfType (IfaceForAllTy tv t) =
771 freeNamesIfTvBndr tv &&& freeNamesIfType t
772 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
774 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
775 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
777 freeNamesIfBndr :: IfaceBndr -> NameSet
778 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
779 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
781 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
782 -- Remember IfaceLetBndr is used only for *nested* bindings
783 -- The cut-down IdInfo never contains any Names, but the type may!
784 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
786 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
787 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
788 -- kinds can have Names inside, when the Kind is an equality predicate
790 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
791 freeNamesIfIdBndr = freeNamesIfTvBndr
793 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
794 freeNamesIfIdInfo NoInfo = emptyNameSet
795 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
797 freeNamesItem :: IfaceInfoItem -> NameSet
798 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
799 freeNamesItem _ = emptyNameSet
801 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
802 freeNamesIfUnfold (IfCoreUnfold e) = freeNamesIfExpr e
803 freeNamesIfUnfold (IfInlineRule _ _ e) = freeNamesIfExpr e
804 freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
805 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
807 freeNamesIfExpr :: IfaceExpr -> NameSet
808 freeNamesIfExpr (IfaceExt v) = unitNameSet v
809 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
810 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
811 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
812 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
813 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
814 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
815 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
817 freeNamesIfExpr (IfaceCase s _ ty alts)
819 &&& fnList fn_alt alts &&& fn_cons alts
820 &&& freeNamesIfType ty
822 fn_alt (_con,_bs,r) = freeNamesIfExpr r
824 -- Depend on the data constructors. Just one will do!
825 -- Note [Tracking data constructors]
826 fn_cons [] = emptyNameSet
827 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
828 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
829 fn_cons (_ : _ ) = emptyNameSet
831 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
832 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
834 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
835 = fnList fn_pair as &&& freeNamesIfExpr x
837 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
839 freeNamesIfExpr _ = emptyNameSet
842 freeNamesIfTc :: IfaceTyCon -> NameSet
843 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
844 -- ToDo: shouldn't we include IfaceIntTc & co.?
845 freeNamesIfTc _ = emptyNameSet
847 freeNamesIfRule :: IfaceRule -> NameSet
848 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
850 fnList freeNamesIfBndr bs &&&
851 fnList freeNamesIfExpr es &&&
855 (&&&) :: NameSet -> NameSet -> NameSet
856 (&&&) = unionNameSets
858 fnList :: (a -> NameSet) -> [a] -> NameSet
859 fnList f = foldr (&&&) emptyNameSet . map f
862 Note [Tracking data constructors]
863 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
865 case e of { C a -> ...; ... }
866 You might think that we don't need to include the datacon C
867 in the free names, because its type will probably show up in
868 the free names of 'e'. But in rare circumstances this may
869 not happen. Here's the one that bit me:
871 module DynFlags where
872 import {-# SOURCE #-} Packages( PackageState )
873 data DynFlags = DF ... PackageState ...
875 module Packages where
877 data PackageState = PS ...
878 lookupModule (df :: DynFlags)
880 DF ...p... -> case p of
883 Now, lookupModule depends on DynFlags, but the transitive dependency
884 on the *locally-defined* type PackageState is not visible. We need
885 to take account of the use of the data constructor PS in the pattern match.