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
215 -- Possibly could eliminate the Bool here, the information
216 -- is also in the InlinePragma.
218 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
220 | IfInlineRule Arity -- INLINE pragmas
221 Bool -- OK to inline even if *un*-saturated
222 Bool -- OK to inline even if context is boring
225 | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
226 -- can simplify to a function in another module.
228 | IfDFunUnfold [IfaceExpr]
230 --------------------------------
232 = IfaceLcl FastString
234 | IfaceType IfaceType
235 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
236 | IfaceLam IfaceBndr IfaceExpr
237 | IfaceApp IfaceExpr IfaceExpr
238 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
239 | IfaceLet IfaceBinding IfaceExpr
240 | IfaceNote IfaceNote IfaceExpr
241 | IfaceCast IfaceExpr IfaceCoercion
243 | IfaceFCall ForeignCall IfaceType
244 | IfaceTick Module Int
246 data IfaceNote = IfaceSCC CostCentre
247 | IfaceCoreNote String
249 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
250 -- Note: FastString, not IfaceBndr (and same with the case binder)
251 -- We reconstruct the kind/type of the thing from the context
252 -- thus saving bulk in interface files
254 data IfaceConAlt = IfaceDefault
256 | IfaceTupleAlt Boxity
257 | IfaceLitAlt Literal
260 = IfaceNonRec IfaceLetBndr IfaceExpr
261 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
263 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
264 -- It's used for *non-top-level* let/rec binders
265 -- See Note [IdInfo on nested let-bindings]
266 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
269 Note [Expose recursive functions]
270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
271 For supercompilation we want to put *all* unfoldings in the interface
272 file, even for functions that are recursive (or big). So we need to
273 know when an unfolding belongs to a loop-breaker so that we can refrain
274 from inlining it (except during supercompilation).
276 Note [IdInfo on nested let-bindings]
277 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278 Occasionally we want to preserve IdInfo on nested let bindings. The one
279 that came up was a NOINLINE pragma on a let-binding inside an INLINE
280 function. The user (Duncan Coutts) really wanted the NOINLINE control
281 to cross the separate compilation boundary.
283 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
284 Currently we only actually retain InlinePragInfo, but in principle we could
288 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
289 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
290 If a module contains any "orphans", then its interface file is read
291 regardless, so that its instances are not missed.
293 Roughly speaking, an instance is an orphan if its head (after the =>)
294 mentions nothing defined in this module. Functional dependencies
295 complicate the situation though. Consider
297 module M where { class C a b | a -> b }
299 and suppose we are compiling module X:
304 instance C Int T where ...
306 This instance is an orphan, because when compiling a third module Y we
307 might get a constraint (C Int v), and we'd want to improve v to T. So
308 we must make sure X's instances are loaded, even if we do not directly
311 More precisely, an instance is an orphan iff
313 If there are no fundeps, then at least of the names in
314 the instance head is locally defined.
316 If there are fundeps, then for every fundep, at least one of the
317 names free in a *non-determined* part of the instance head is
318 defined in this module.
320 (Note that these conditions hold trivially if the class is locally
323 Note [Versioning of instances]
324 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
325 Now consider versioning. If we *use* an instance decl in one compilation,
326 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
327 But suppose we *don't* (currently) use an instance! We must recompile if
328 the instance is changed in such a way that it becomes important. (This would
329 only matter with overlapping instances, else the importing module wouldn't have
330 compiled before and the recompilation check is irrelevant.)
332 The is_orph field is set to (Just n) if the instance is not an orphan.
333 The 'n' is *any* of the locally-defined names mentioned anywhere in the
334 instance head. This name is used for versioning; the instance decl is
335 considered part of the defn of this 'n'.
337 I'm worried about whether this works right if we pick a name from
338 a functionally-dependent part of the instance decl. E.g.
340 module M where { class C a b | a -> b }
342 and suppose we are compiling module X:
348 instance C S T where ...
350 If we base the instance verion on T, I'm worried that changing S to S'
351 would change T's version, but not S or S'. But an importing module might
352 not depend on T, and so might not be recompiled even though the new instance
353 (C S' T) might be relevant. I have not been able to make a concrete example,
354 and it seems deeply obscure, so I'm going to leave it for now.
357 Note [Versioning of rules]
358 ~~~~~~~~~~~~~~~~~~~~~~~~~~
359 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
360 n appears on the LHS of the rule; any change in the rule changes the version of n.
364 -- -----------------------------------------------------------------------------
367 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
368 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
369 -- Deeply revolting, because it has to predict what gets bound,
370 -- especially the question of whether there's a wrapper for a datacon
372 -- N.B. the set of names returned here *must* match the set of
373 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
374 -- TyThing.getOccName should define a bijection between the two lists.
375 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
376 -- The order of the list does not matter.
377 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
380 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
381 ifCons = IfNewTyCon (
382 IfCon { ifConOcc = con_occ }),
383 ifFamInst = famInst})
384 = -- implicit coerion and (possibly) family instance coercion
385 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
386 -- data constructor and worker (newtypes don't have a wrapper)
387 [con_occ, mkDataConWorkerOcc con_occ]
390 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
391 ifCons = IfDataTyCon cons,
392 ifFamInst = famInst})
393 = -- (possibly) family instance coercion;
394 -- there is no implicit coercion for non-newtypes
395 famInstCo famInst tc_occ
396 -- for each data constructor in order,
397 -- data constructor, worker, and (possibly) wrapper
398 ++ concatMap dc_occs cons
401 | has_wrapper = [con_occ, work_occ, wrap_occ]
402 | otherwise = [con_occ, work_occ]
404 con_occ = ifConOcc con_decl -- DataCon namespace
405 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
406 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
407 has_wrapper = ifConWrapper con_decl -- This is the reason for
408 -- having the ifConWrapper field!
410 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
411 ifSigs = sigs, ifATs = ats })
412 = -- dictionary datatype:
415 -- (possibly) newtype coercion
417 -- data constructor (DataCon namespace)
418 -- data worker (Id namespace)
419 -- no wrapper (class dictionaries never have a wrapper)
420 [dc_occ, dcww_occ] ++
422 [ifName at | at <- ats ] ++
423 -- superclass selectors
424 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
425 -- operation selectors
426 [op | IfaceClassOp op _ _ <- sigs]
428 n_ctxt = length sc_ctxt
430 tc_occ = mkClassTyConOcc cls_occ
431 dc_occ = mkClassDataConOcc cls_occ
432 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
434 dcww_occ = mkDataConWorkerOcc dc_occ
435 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
437 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
438 ifFamInst = famInst})
439 = famInstCo famInst tc_occ
441 ifaceDeclSubBndrs _ = []
443 -- coercion for data/newtype family instances
444 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
445 famInstCo Nothing _ = []
446 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
448 ----------------------------- Printing IfaceDecl ------------------------------
450 instance Outputable IfaceDecl where
453 pprIfaceDecl :: IfaceDecl -> SDoc
454 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
455 ifIdDetails = details, ifIdInfo = info})
456 = sep [ ppr var <+> dcolon <+> ppr ty,
457 nest 2 (ppr details),
460 pprIfaceDecl (IfaceForeign {ifName = tycon})
461 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
463 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
464 ifSynRhs = Just mono_ty,
465 ifFamInst = mbFamInst})
466 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
467 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
469 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
470 ifSynRhs = Nothing, ifSynKind = kind })
471 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
472 4 (dcolon <+> ppr kind)
474 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
475 ifTyVars = tyvars, ifCons = condecls,
476 ifRec = isrec, ifFamInst = mbFamInst})
477 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
478 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
479 pprFamily mbFamInst])
481 pp_nd = case condecls of
482 IfAbstractTyCon -> ptext (sLit "data")
483 IfOpenDataTyCon -> ptext (sLit "data family")
484 IfDataTyCon _ -> ptext (sLit "data")
485 IfNewTyCon _ -> ptext (sLit "newtype")
487 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
488 ifFDs = fds, ifATs = ats, ifSigs = sigs,
490 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
491 4 (vcat [pprRec isrec,
495 pprRec :: RecFlag -> SDoc
496 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
498 pprGen :: Bool -> SDoc
499 pprGen True = ptext (sLit "Generics: yes")
500 pprGen False = ptext (sLit "Generics: no")
502 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
503 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
504 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
506 instance Outputable IfaceClassOp where
507 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
509 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
510 pprIfaceDeclHead context thing tyvars
511 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
512 pprIfaceTvBndrs tyvars]
514 pp_condecls :: OccName -> IfaceConDecls -> SDoc
515 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
516 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
517 pp_condecls _ IfOpenDataTyCon = empty
518 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
519 (map (pprIfaceConDecl tc) cs))
521 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
523 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
524 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
525 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
526 ifConStricts = strs, ifConFields = fields })
528 if is_infix then ptext (sLit "Infix") else empty,
529 if has_wrap then ptext (sLit "HasWrapper") else empty,
530 ppUnless (null strs) $
531 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
532 ppUnless (null fields) $
533 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
535 ppr_bang HsNoBang = char '_' -- Want to see these
536 ppr_bang bang = ppr bang
538 main_payload = ppr name <+> dcolon <+>
539 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
541 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
542 | (tv,ty) <- eq_spec]
544 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
545 -- because we don't have a Name for the tycon, only an OccName
546 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
547 (t:ts) -> fsep (t : map (arrow <+>) ts)
548 [] -> panic "pp_con_taus"
550 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
552 instance Outputable IfaceRule where
553 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
554 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
555 = sep [hsep [doubleQuotes (ftext name), ppr act,
556 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
557 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
558 ptext (sLit "=") <+> ppr rhs])
561 instance Outputable IfaceInst where
562 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
563 ifInstCls = cls, ifInstTys = mb_tcs})
564 = hang (ptext (sLit "instance") <+> ppr flag
565 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
566 2 (equals <+> ppr dfun_id)
568 instance Outputable IfaceFamInst where
569 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
570 ifFamInstTyCon = tycon_id})
571 = hang (ptext (sLit "family instance") <+>
572 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
573 2 (equals <+> ppr tycon_id)
575 ppr_rough :: Maybe IfaceTyCon -> SDoc
576 ppr_rough Nothing = dot
577 ppr_rough (Just tc) = ppr tc
581 ----------------------------- Printing IfaceExpr ------------------------------------
584 instance Outputable IfaceExpr where
585 ppr e = pprIfaceExpr noParens e
587 pprParendIfaceExpr :: IfaceExpr -> SDoc
588 pprParendIfaceExpr = pprIfaceExpr parens
590 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
591 -- The function adds parens in context that need
592 -- an atomic value (e.g. function args)
594 pprIfaceExpr _ (IfaceLcl v) = ppr v
595 pprIfaceExpr _ (IfaceExt v) = ppr v
596 pprIfaceExpr _ (IfaceLit l) = ppr l
597 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
598 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
599 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
601 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
602 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
604 pprIfaceExpr add_par e@(IfaceLam _ _)
605 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
606 pprIfaceExpr noParens body])
608 (bndrs,body) = collect [] e
609 collect bs (IfaceLam b e) = collect (b:bs) e
610 collect bs e = (reverse bs, e)
612 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
613 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
614 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
615 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
616 pprIfaceExpr noParens rhs <+> char '}'])
618 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
619 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
620 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
621 <+> ppr bndr <+> char '{',
622 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
624 pprIfaceExpr _ (IfaceCast expr co)
625 = sep [pprParendIfaceExpr expr,
626 nest 2 (ptext (sLit "`cast`")),
627 pprParendIfaceType co]
629 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
630 = add_par (sep [ptext (sLit "let {"),
631 nest 2 (ppr_bind (b, rhs)),
633 pprIfaceExpr noParens body])
635 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
636 = add_par (sep [ptext (sLit "letrec {"),
637 nest 2 (sep (map ppr_bind pairs)),
639 pprIfaceExpr noParens body])
641 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
643 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
644 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
645 arrow <+> pprIfaceExpr noParens rhs]
647 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
648 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
649 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
651 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
652 ppr_bind (IfLetBndr b ty info, rhs)
653 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
654 equals <+> pprIfaceExpr noParens rhs]
657 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
658 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
659 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
662 instance Outputable IfaceNote where
663 ppr (IfaceSCC cc) = pprCostCentreCore cc
664 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
667 instance Outputable IfaceConAlt where
668 ppr IfaceDefault = text "DEFAULT"
669 ppr (IfaceLitAlt l) = ppr l
670 ppr (IfaceDataAlt d) = ppr d
671 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
672 -- IfaceTupleAlt is handled by the case-alternative printer
675 instance Outputable IfaceIdDetails where
676 ppr IfVanillaId = empty
677 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
678 <+> if b then ptext (sLit "<naughty>") else empty
679 ppr IfDFunId = ptext (sLit "DFunId")
681 instance Outputable IfaceIdInfo where
683 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
685 instance Outputable IfaceInfoItem where
686 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
688 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
689 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
690 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
691 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
693 instance Outputable IfaceUnfolding where
694 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
695 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
696 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
697 pprParendIfaceExpr e]
698 ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr
699 <+> parens (ptext (sLit "arity") <+> int a)
700 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
701 <+> brackets (pprWithCommas pprParendIfaceExpr ns)
704 -- -----------------------------------------------------------------------------
705 -- Finding the Names in IfaceSyn
707 -- This is used for dependency analysis in MkIface, so that we
708 -- fingerprint a declaration before the things that depend on it. It
709 -- is specific to interface-file fingerprinting in the sense that we
710 -- don't collect *all* Names: for example, the DFun of an instance is
711 -- recorded textually rather than by its fingerprint when
712 -- fingerprinting the instance, so DFuns are not dependencies.
714 freeNamesIfDecl :: IfaceDecl -> NameSet
715 freeNamesIfDecl (IfaceId _s t d i) =
716 freeNamesIfType t &&&
717 freeNamesIfIdInfo i &&&
718 freeNamesIfIdDetails d
719 freeNamesIfDecl IfaceForeign{} =
721 freeNamesIfDecl d@IfaceData{} =
722 freeNamesIfTvBndrs (ifTyVars d) &&&
723 freeNamesIfTcFam (ifFamInst d) &&&
724 freeNamesIfContext (ifCtxt d) &&&
725 freeNamesIfConDecls (ifCons d)
726 freeNamesIfDecl d@IfaceSyn{} =
727 freeNamesIfTvBndrs (ifTyVars d) &&&
728 freeNamesIfSynRhs (ifSynRhs d) &&&
729 freeNamesIfTcFam (ifFamInst d)
730 freeNamesIfDecl d@IfaceClass{} =
731 freeNamesIfTvBndrs (ifTyVars d) &&&
732 freeNamesIfContext (ifCtxt d) &&&
733 freeNamesIfDecls (ifATs d) &&&
734 fnList freeNamesIfClsSig (ifSigs d)
736 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
737 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
738 freeNamesIfIdDetails _ = emptyNameSet
740 -- All other changes are handled via the version info on the tycon
741 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
742 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
743 freeNamesIfSynRhs Nothing = emptyNameSet
745 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
746 freeNamesIfTcFam (Just (tc,tys)) =
747 freeNamesIfTc tc &&& fnList freeNamesIfType tys
748 freeNamesIfTcFam Nothing =
751 freeNamesIfContext :: IfaceContext -> NameSet
752 freeNamesIfContext = fnList freeNamesIfPredType
754 freeNamesIfDecls :: [IfaceDecl] -> NameSet
755 freeNamesIfDecls = fnList freeNamesIfDecl
757 freeNamesIfClsSig :: IfaceClassOp -> NameSet
758 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
760 freeNamesIfConDecls :: IfaceConDecls -> NameSet
761 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
762 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
763 freeNamesIfConDecls _ = emptyNameSet
765 freeNamesIfConDecl :: IfaceConDecl -> NameSet
766 freeNamesIfConDecl c =
767 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
768 freeNamesIfTvBndrs (ifConExTvs c) &&&
769 freeNamesIfContext (ifConCtxt c) &&&
770 fnList freeNamesIfType (ifConArgTys c) &&&
771 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
773 freeNamesIfPredType :: IfacePredType -> NameSet
774 freeNamesIfPredType (IfaceClassP cl tys) =
775 unitNameSet cl &&& fnList freeNamesIfType tys
776 freeNamesIfPredType (IfaceIParam _n ty) =
778 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
779 freeNamesIfType ty1 &&& freeNamesIfType ty2
781 freeNamesIfType :: IfaceType -> NameSet
782 freeNamesIfType (IfaceTyVar _) = emptyNameSet
783 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
784 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
785 freeNamesIfType (IfaceTyConApp tc ts) =
786 freeNamesIfTc tc &&& fnList freeNamesIfType ts
787 freeNamesIfType (IfaceForAllTy tv t) =
788 freeNamesIfTvBndr tv &&& freeNamesIfType t
789 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
791 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
792 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
794 freeNamesIfBndr :: IfaceBndr -> NameSet
795 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
796 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
798 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
799 -- Remember IfaceLetBndr is used only for *nested* bindings
800 -- The cut-down IdInfo never contains any Names, but the type may!
801 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
803 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
804 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
805 -- kinds can have Names inside, when the Kind is an equality predicate
807 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
808 freeNamesIfIdBndr = freeNamesIfTvBndr
810 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
811 freeNamesIfIdInfo NoInfo = emptyNameSet
812 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
814 freeNamesItem :: IfaceInfoItem -> NameSet
815 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
816 freeNamesItem _ = emptyNameSet
818 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
819 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
820 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
821 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
822 freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
823 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
825 freeNamesIfExpr :: IfaceExpr -> NameSet
826 freeNamesIfExpr (IfaceExt v) = unitNameSet v
827 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
828 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
829 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
830 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
831 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
832 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
833 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
835 freeNamesIfExpr (IfaceCase s _ ty alts)
837 &&& fnList fn_alt alts &&& fn_cons alts
838 &&& freeNamesIfType ty
840 fn_alt (_con,_bs,r) = freeNamesIfExpr r
842 -- Depend on the data constructors. Just one will do!
843 -- Note [Tracking data constructors]
844 fn_cons [] = emptyNameSet
845 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
846 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
847 fn_cons (_ : _ ) = emptyNameSet
849 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
850 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
852 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
853 = fnList fn_pair as &&& freeNamesIfExpr x
855 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
857 freeNamesIfExpr _ = emptyNameSet
860 freeNamesIfTc :: IfaceTyCon -> NameSet
861 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
862 -- ToDo: shouldn't we include IfaceIntTc & co.?
863 freeNamesIfTc _ = emptyNameSet
865 freeNamesIfRule :: IfaceRule -> NameSet
866 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
867 , ifRuleArgs = es, ifRuleRhs = rhs })
869 fnList freeNamesIfBndr bs &&&
870 fnList freeNamesIfExpr es &&&
874 (&&&) :: NameSet -> NameSet -> NameSet
875 (&&&) = unionNameSets
877 fnList :: (a -> NameSet) -> [a] -> NameSet
878 fnList f = foldr (&&&) emptyNameSet . map f
881 Note [Tracking data constructors]
882 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
884 case e of { C a -> ...; ... }
885 You might think that we don't need to include the datacon C
886 in the free names, because its type will probably show up in
887 the free names of 'e'. But in rare circumstances this may
888 not happen. Here's the one that bit me:
890 module DynFlags where
891 import {-# SOURCE #-} Packages( PackageState )
892 data DynFlags = DF ... PackageState ...
894 module Packages where
896 data PackageState = PS ...
897 lookupModule (df :: DynFlags)
899 DF ...p... -> case p of
902 Now, lookupModule depends on DynFlags, but the transitive dependency
903 on the *locally-defined* type PackageState is not visible. We need
904 to take account of the use of the data constructor PS in the pattern match.