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,
167 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
172 ifAnnotatedTarget :: IfaceAnnTarget,
173 ifAnnotatedValue :: Serialized
176 type IfaceAnnTarget = AnnTarget OccName
178 -- We only serialise the IdDetails of top-level Ids, and even then
179 -- we only need a very limited selection. Notably, none of the
180 -- implicit ones are needed here, becuase they are not put it
185 | IfRecSelId IfaceTyCon Bool
189 = NoInfo -- When writing interface file without -O
190 | HasInfo [IfaceInfoItem] -- Has info, and here it is
192 -- Here's a tricky case:
193 -- * Compile with -O module A, and B which imports A.f
194 -- * Change function f in A, and recompile without -O
195 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
196 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
197 -- but we do not do that now. Instead it's discarded when the
198 -- ModIface is read into the various decl pools.)
199 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
200 -- and so gives a new version.
204 | HsStrictness StrictSig
205 | HsInline InlinePragma
206 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
207 IfaceUnfolding -- See Note [Expose recursive functions]
210 -- NB: Specialisations and rules come in separately and are
211 -- only later attached to the Id. Partial reason: some are orphans.
214 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
216 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
219 Bool -- OK to inline even if *un*-saturated
220 Bool -- OK to inline even if context is boring
223 | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
224 -- can simplify to a function in another module.
226 | IfDFunUnfold [IfaceExpr]
228 --------------------------------
230 = IfaceLcl FastString
232 | IfaceType IfaceType
233 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
234 | IfaceLam IfaceBndr IfaceExpr
235 | IfaceApp IfaceExpr IfaceExpr
236 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
237 | IfaceLet IfaceBinding IfaceExpr
238 | IfaceNote IfaceNote IfaceExpr
239 | IfaceCast IfaceExpr IfaceCoercion
241 | IfaceFCall ForeignCall IfaceType
242 | IfaceTick Module Int
244 data IfaceNote = IfaceSCC CostCentre
245 | IfaceCoreNote String
247 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
248 -- Note: FastString, not IfaceBndr (and same with the case binder)
249 -- We reconstruct the kind/type of the thing from the context
250 -- thus saving bulk in interface files
252 data IfaceConAlt = IfaceDefault
254 | IfaceTupleAlt Boxity
255 | IfaceLitAlt Literal
258 = IfaceNonRec IfaceLetBndr IfaceExpr
259 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
261 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
262 -- It's used for *non-top-level* let/rec binders
263 -- See Note [IdInfo on nested let-bindings]
264 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
267 Note [Expose recursive functions]
268 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
269 For supercompilation we want to put *all* unfoldings in the interface
270 file, even for functions that are recursive (or big). So we need to
271 know when an unfolding belongs to a loop-breaker so that we can refrain
272 from inlining it (except during supercompilation).
274 Note [IdInfo on nested let-bindings]
275 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
276 Occasionally we want to preserve IdInfo on nested let bindings. The one
277 that came up was a NOINLINE pragma on a let-binding inside an INLINE
278 function. The user (Duncan Coutts) really wanted the NOINLINE control
279 to cross the separate compilation boundary.
281 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
282 Currently we only actually retain InlinePragInfo, but in principle we could
286 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
287 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
288 If a module contains any "orphans", then its interface file is read
289 regardless, so that its instances are not missed.
291 Roughly speaking, an instance is an orphan if its head (after the =>)
292 mentions nothing defined in this module. Functional dependencies
293 complicate the situation though. Consider
295 module M where { class C a b | a -> b }
297 and suppose we are compiling module X:
302 instance C Int T where ...
304 This instance is an orphan, because when compiling a third module Y we
305 might get a constraint (C Int v), and we'd want to improve v to T. So
306 we must make sure X's instances are loaded, even if we do not directly
309 More precisely, an instance is an orphan iff
311 If there are no fundeps, then at least of the names in
312 the instance head is locally defined.
314 If there are fundeps, then for every fundep, at least one of the
315 names free in a *non-determined* part of the instance head is
316 defined in this module.
318 (Note that these conditions hold trivially if the class is locally
321 Note [Versioning of instances]
322 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
323 Now consider versioning. If we *use* an instance decl in one compilation,
324 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
325 But suppose we *don't* (currently) use an instance! We must recompile if
326 the instance is changed in such a way that it becomes important. (This would
327 only matter with overlapping instances, else the importing module wouldn't have
328 compiled before and the recompilation check is irrelevant.)
330 The is_orph field is set to (Just n) if the instance is not an orphan.
331 The 'n' is *any* of the locally-defined names mentioned anywhere in the
332 instance head. This name is used for versioning; the instance decl is
333 considered part of the defn of this 'n'.
335 I'm worried about whether this works right if we pick a name from
336 a functionally-dependent part of the instance decl. E.g.
338 module M where { class C a b | a -> b }
340 and suppose we are compiling module X:
346 instance C S T where ...
348 If we base the instance verion on T, I'm worried that changing S to S'
349 would change T's version, but not S or S'. But an importing module might
350 not depend on T, and so might not be recompiled even though the new instance
351 (C S' T) might be relevant. I have not been able to make a concrete example,
352 and it seems deeply obscure, so I'm going to leave it for now.
355 Note [Versioning of rules]
356 ~~~~~~~~~~~~~~~~~~~~~~~~~~
357 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
358 n appears on the LHS of the rule; any change in the rule changes the version of n.
362 -- -----------------------------------------------------------------------------
365 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
366 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
367 -- Deeply revolting, because it has to predict what gets bound,
368 -- especially the question of whether there's a wrapper for a datacon
370 -- N.B. the set of names returned here *must* match the set of
371 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
372 -- TyThing.getOccName should define a bijection between the two lists.
373 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
374 -- The order of the list does not matter.
375 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
378 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
379 ifCons = IfNewTyCon (
380 IfCon { ifConOcc = con_occ }),
381 ifFamInst = famInst})
382 = -- implicit coerion and (possibly) family instance coercion
383 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
384 -- data constructor and worker (newtypes don't have a wrapper)
385 [con_occ, mkDataConWorkerOcc con_occ]
388 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
389 ifCons = IfDataTyCon cons,
390 ifFamInst = famInst})
391 = -- (possibly) family instance coercion;
392 -- there is no implicit coercion for non-newtypes
393 famInstCo famInst tc_occ
394 -- for each data constructor in order,
395 -- data constructor, worker, and (possibly) wrapper
396 ++ concatMap dc_occs cons
399 | has_wrapper = [con_occ, work_occ, wrap_occ]
400 | otherwise = [con_occ, work_occ]
402 con_occ = ifConOcc con_decl -- DataCon namespace
403 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
404 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
405 has_wrapper = ifConWrapper con_decl -- This is the reason for
406 -- having the ifConWrapper field!
408 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
409 ifSigs = sigs, ifATs = ats })
410 = -- dictionary datatype:
413 -- (possibly) newtype coercion
415 -- data constructor (DataCon namespace)
416 -- data worker (Id namespace)
417 -- no wrapper (class dictionaries never have a wrapper)
418 [dc_occ, dcww_occ] ++
420 [ifName at | at <- ats ] ++
421 -- superclass selectors
422 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
423 -- operation selectors
424 [op | IfaceClassOp op _ _ <- sigs]
426 n_ctxt = length sc_ctxt
428 tc_occ = mkClassTyConOcc cls_occ
429 dc_occ = mkClassDataConOcc cls_occ
430 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
432 dcww_occ = mkDataConWorkerOcc dc_occ
433 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
435 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
436 ifFamInst = famInst})
437 = famInstCo famInst tc_occ
439 ifaceDeclSubBndrs _ = []
441 -- coercion for data/newtype family instances
442 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
443 famInstCo Nothing _ = []
444 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
446 ----------------------------- Printing IfaceDecl ------------------------------
448 instance Outputable IfaceDecl where
451 pprIfaceDecl :: IfaceDecl -> SDoc
452 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
453 ifIdDetails = details, ifIdInfo = info})
454 = sep [ ppr var <+> dcolon <+> ppr ty,
455 nest 2 (ppr details),
458 pprIfaceDecl (IfaceForeign {ifName = tycon})
459 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
461 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
462 ifSynRhs = Just mono_ty,
463 ifFamInst = mbFamInst})
464 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
465 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
467 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
468 ifSynRhs = Nothing, ifSynKind = kind })
469 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
470 4 (dcolon <+> ppr kind)
472 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
473 ifTyVars = tyvars, ifCons = condecls,
474 ifRec = isrec, ifFamInst = mbFamInst})
475 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
476 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
477 pprFamily mbFamInst])
479 pp_nd = case condecls of
480 IfAbstractTyCon -> ptext (sLit "data")
481 IfOpenDataTyCon -> ptext (sLit "data family")
482 IfDataTyCon _ -> ptext (sLit "data")
483 IfNewTyCon _ -> ptext (sLit "newtype")
485 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
486 ifFDs = fds, ifATs = ats, ifSigs = sigs,
488 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
489 4 (vcat [pprRec isrec,
493 pprRec :: RecFlag -> SDoc
494 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
496 pprGen :: Bool -> SDoc
497 pprGen True = ptext (sLit "Generics: yes")
498 pprGen False = ptext (sLit "Generics: no")
500 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
501 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
502 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
504 instance Outputable IfaceClassOp where
505 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
507 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
508 pprIfaceDeclHead context thing tyvars
509 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
510 pprIfaceTvBndrs tyvars]
512 pp_condecls :: OccName -> IfaceConDecls -> SDoc
513 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
514 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
515 pp_condecls _ IfOpenDataTyCon = empty
516 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
517 (map (pprIfaceConDecl tc) cs))
519 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
521 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
522 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
523 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
524 ifConStricts = strs, ifConFields = fields })
526 if is_infix then ptext (sLit "Infix") else empty,
527 if has_wrap then ptext (sLit "HasWrapper") else empty,
528 ppUnless (null strs) $
529 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
530 ppUnless (null fields) $
531 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
533 ppr_bang HsNoBang = char '_' -- Want to see these
534 ppr_bang bang = ppr bang
536 main_payload = ppr name <+> dcolon <+>
537 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
539 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
540 | (tv,ty) <- eq_spec]
542 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
543 -- because we don't have a Name for the tycon, only an OccName
544 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
545 (t:ts) -> fsep (t : map (arrow <+>) ts)
546 [] -> panic "pp_con_taus"
548 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
550 instance Outputable IfaceRule where
551 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
552 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
553 = sep [hsep [doubleQuotes (ftext name), ppr act,
554 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
555 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
556 ptext (sLit "=") <+> ppr rhs])
559 instance Outputable IfaceInst where
560 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
561 ifInstCls = cls, ifInstTys = mb_tcs})
562 = hang (ptext (sLit "instance") <+> ppr flag
563 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
564 2 (equals <+> ppr dfun_id)
566 instance Outputable IfaceFamInst where
567 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
568 ifFamInstTyCon = tycon_id})
569 = hang (ptext (sLit "family instance") <+>
570 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
571 2 (equals <+> ppr tycon_id)
573 ppr_rough :: Maybe IfaceTyCon -> SDoc
574 ppr_rough Nothing = dot
575 ppr_rough (Just tc) = ppr tc
579 ----------------------------- Printing IfaceExpr ------------------------------------
582 instance Outputable IfaceExpr where
583 ppr e = pprIfaceExpr noParens e
585 pprParendIfaceExpr :: IfaceExpr -> SDoc
586 pprParendIfaceExpr = pprIfaceExpr parens
588 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
589 -- The function adds parens in context that need
590 -- an atomic value (e.g. function args)
592 pprIfaceExpr _ (IfaceLcl v) = ppr v
593 pprIfaceExpr _ (IfaceExt v) = ppr v
594 pprIfaceExpr _ (IfaceLit l) = ppr l
595 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
596 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
597 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
599 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
600 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
602 pprIfaceExpr add_par e@(IfaceLam _ _)
603 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
604 pprIfaceExpr noParens body])
606 (bndrs,body) = collect [] e
607 collect bs (IfaceLam b e) = collect (b:bs) e
608 collect bs e = (reverse bs, e)
610 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
611 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
612 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
613 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
614 pprIfaceExpr noParens rhs <+> char '}'])
616 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
617 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
618 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
619 <+> ppr bndr <+> char '{',
620 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
622 pprIfaceExpr _ (IfaceCast expr co)
623 = sep [pprParendIfaceExpr expr,
624 nest 2 (ptext (sLit "`cast`")),
625 pprParendIfaceType co]
627 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
628 = add_par (sep [ptext (sLit "let {"),
629 nest 2 (ppr_bind (b, rhs)),
631 pprIfaceExpr noParens body])
633 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
634 = add_par (sep [ptext (sLit "letrec {"),
635 nest 2 (sep (map ppr_bind pairs)),
637 pprIfaceExpr noParens body])
639 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
641 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
642 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
643 arrow <+> pprIfaceExpr noParens rhs]
645 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
646 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
647 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
649 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
650 ppr_bind (IfLetBndr b ty info, rhs)
651 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
652 equals <+> pprIfaceExpr noParens rhs]
655 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
656 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
657 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
660 instance Outputable IfaceNote where
661 ppr (IfaceSCC cc) = pprCostCentreCore cc
662 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
665 instance Outputable IfaceConAlt where
666 ppr IfaceDefault = text "DEFAULT"
667 ppr (IfaceLitAlt l) = ppr l
668 ppr (IfaceDataAlt d) = ppr d
669 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
670 -- IfaceTupleAlt is handled by the case-alternative printer
673 instance Outputable IfaceIdDetails where
674 ppr IfVanillaId = empty
675 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
676 <+> if b then ptext (sLit "<naughty>") else empty
677 ppr IfDFunId = ptext (sLit "DFunId")
679 instance Outputable IfaceIdInfo where
681 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
683 instance Outputable IfaceInfoItem where
684 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
686 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
687 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
688 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
689 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
691 instance Outputable IfaceUnfolding where
692 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
693 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
694 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
695 pprParendIfaceExpr e]
696 ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr
697 <+> parens (ptext (sLit "arity") <+> int a)
698 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
699 <+> brackets (pprWithCommas pprParendIfaceExpr ns)
702 -- -----------------------------------------------------------------------------
703 -- Finding the Names in IfaceSyn
705 -- This is used for dependency analysis in MkIface, so that we
706 -- fingerprint a declaration before the things that depend on it. It
707 -- is specific to interface-file fingerprinting in the sense that we
708 -- don't collect *all* Names: for example, the DFun of an instance is
709 -- recorded textually rather than by its fingerprint when
710 -- fingerprinting the instance, so DFuns are not dependencies.
712 freeNamesIfDecl :: IfaceDecl -> NameSet
713 freeNamesIfDecl (IfaceId _s t d i) =
714 freeNamesIfType t &&&
715 freeNamesIfIdInfo i &&&
716 freeNamesIfIdDetails d
717 freeNamesIfDecl IfaceForeign{} =
719 freeNamesIfDecl d@IfaceData{} =
720 freeNamesIfTvBndrs (ifTyVars d) &&&
721 freeNamesIfTcFam (ifFamInst d) &&&
722 freeNamesIfContext (ifCtxt d) &&&
723 freeNamesIfConDecls (ifCons d)
724 freeNamesIfDecl d@IfaceSyn{} =
725 freeNamesIfTvBndrs (ifTyVars d) &&&
726 freeNamesIfSynRhs (ifSynRhs d) &&&
727 freeNamesIfTcFam (ifFamInst d)
728 freeNamesIfDecl d@IfaceClass{} =
729 freeNamesIfTvBndrs (ifTyVars d) &&&
730 freeNamesIfContext (ifCtxt d) &&&
731 freeNamesIfDecls (ifATs d) &&&
732 fnList freeNamesIfClsSig (ifSigs d)
734 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
735 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
736 freeNamesIfIdDetails _ = emptyNameSet
738 -- All other changes are handled via the version info on the tycon
739 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
740 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
741 freeNamesIfSynRhs Nothing = emptyNameSet
743 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
744 freeNamesIfTcFam (Just (tc,tys)) =
745 freeNamesIfTc tc &&& fnList freeNamesIfType tys
746 freeNamesIfTcFam Nothing =
749 freeNamesIfContext :: IfaceContext -> NameSet
750 freeNamesIfContext = fnList freeNamesIfPredType
752 freeNamesIfDecls :: [IfaceDecl] -> NameSet
753 freeNamesIfDecls = fnList freeNamesIfDecl
755 freeNamesIfClsSig :: IfaceClassOp -> NameSet
756 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
758 freeNamesIfConDecls :: IfaceConDecls -> NameSet
759 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
760 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
761 freeNamesIfConDecls _ = emptyNameSet
763 freeNamesIfConDecl :: IfaceConDecl -> NameSet
764 freeNamesIfConDecl c =
765 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
766 freeNamesIfTvBndrs (ifConExTvs c) &&&
767 freeNamesIfContext (ifConCtxt c) &&&
768 fnList freeNamesIfType (ifConArgTys c) &&&
769 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
771 freeNamesIfPredType :: IfacePredType -> NameSet
772 freeNamesIfPredType (IfaceClassP cl tys) =
773 unitNameSet cl &&& fnList freeNamesIfType tys
774 freeNamesIfPredType (IfaceIParam _n ty) =
776 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
777 freeNamesIfType ty1 &&& freeNamesIfType ty2
779 freeNamesIfType :: IfaceType -> NameSet
780 freeNamesIfType (IfaceTyVar _) = emptyNameSet
781 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
782 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
783 freeNamesIfType (IfaceTyConApp tc ts) =
784 freeNamesIfTc tc &&& fnList freeNamesIfType ts
785 freeNamesIfType (IfaceForAllTy tv t) =
786 freeNamesIfTvBndr tv &&& freeNamesIfType t
787 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
789 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
790 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
792 freeNamesIfBndr :: IfaceBndr -> NameSet
793 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
794 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
796 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
797 -- Remember IfaceLetBndr is used only for *nested* bindings
798 -- The cut-down IdInfo never contains any Names, but the type may!
799 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
801 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
802 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
803 -- kinds can have Names inside, when the Kind is an equality predicate
805 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
806 freeNamesIfIdBndr = freeNamesIfTvBndr
808 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
809 freeNamesIfIdInfo NoInfo = emptyNameSet
810 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
812 freeNamesItem :: IfaceInfoItem -> NameSet
813 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
814 freeNamesItem _ = emptyNameSet
816 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
817 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
818 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
819 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
820 freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
821 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
823 freeNamesIfExpr :: IfaceExpr -> NameSet
824 freeNamesIfExpr (IfaceExt v) = unitNameSet v
825 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
826 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
827 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
828 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
829 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
830 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
831 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
833 freeNamesIfExpr (IfaceCase s _ ty alts)
835 &&& fnList fn_alt alts &&& fn_cons alts
836 &&& freeNamesIfType ty
838 fn_alt (_con,_bs,r) = freeNamesIfExpr r
840 -- Depend on the data constructors. Just one will do!
841 -- Note [Tracking data constructors]
842 fn_cons [] = emptyNameSet
843 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
844 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
845 fn_cons (_ : _ ) = emptyNameSet
847 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
848 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
850 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
851 = fnList fn_pair as &&& freeNamesIfExpr x
853 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
855 freeNamesIfExpr _ = emptyNameSet
858 freeNamesIfTc :: IfaceTyCon -> NameSet
859 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
860 -- ToDo: shouldn't we include IfaceIntTc & co.?
861 freeNamesIfTc _ = emptyNameSet
863 freeNamesIfRule :: IfaceRule -> NameSet
864 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
865 , ifRuleArgs = es, ifRuleRhs = rhs })
867 fnList freeNamesIfBndr bs &&&
868 fnList freeNamesIfExpr es &&&
872 (&&&) :: NameSet -> NameSet -> NameSet
873 (&&&) = unionNameSets
875 fnList :: (a -> NameSet) -> [a] -> NameSet
876 fnList f = foldr (&&&) emptyNameSet . map f
879 Note [Tracking data constructors]
880 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
882 case e of { C a -> ...; ... }
883 You might think that we don't need to include the datacon C
884 in the free names, because its type will probably show up in
885 the free names of 'e'. But in rare circumstances this may
886 not happen. Here's the one that bit me:
888 module DynFlags where
889 import {-# SOURCE #-} Packages( PackageState )
890 data DynFlags = DF ... PackageState ...
892 module Packages where
894 data PackageState = PS ...
895 lookupModule (df :: DynFlags)
897 DF ...p... -> case p of
900 Now, lookupModule depends on DynFlags, but the transitive dependency
901 on the *locally-defined* type PackageState is not visible. We need
902 to take account of the use of the data constructor PS in the pattern match.