2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
10 IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
11 IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
12 IfaceBinding(..), IfaceConAlt(..),
13 IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
14 IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
15 IfaceInst(..), IfaceFamInst(..),
18 ifaceDeclSubBndrs, visibleIfConDecls,
21 freeNamesIfDecl, freeNamesIfRule,
24 pprIfaceExpr, pprIfaceDeclHead
27 #include "HsVersions.h"
30 import CoreSyn( DFunArg, dfunArgExprs )
31 import PprCore() -- Printing DFunArgs
50 %************************************************************************
52 Data type declarations
54 %************************************************************************
58 = IfaceId { ifName :: OccName,
60 ifIdDetails :: IfaceIdDetails,
61 ifIdInfo :: IfaceIdInfo }
63 | IfaceData { ifName :: OccName, -- Type constructor
64 ifTyVars :: [IfaceTvBndr], -- Type variables
65 ifCtxt :: IfaceContext, -- The "stupid theta"
66 ifCons :: IfaceConDecls, -- Includes new/data info
67 ifRec :: RecFlag, -- Recursive or not?
68 ifGadtSyntax :: Bool, -- True <=> declared using
70 ifGeneric :: Bool, -- True <=> generic converter
71 -- functions available
72 -- We need this for imported
73 -- data decls, since the
74 -- imported modules may have
76 -- different flags to the
77 -- current compilation unit
78 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
79 -- Just <=> instance of family
81 -- ifCons /= IfOpenDataTyCon
82 -- for family instances
85 | IfaceSyn { ifName :: OccName, -- Type constructor
86 ifTyVars :: [IfaceTvBndr], -- Type variables
87 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
88 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
89 -- Nothing for an open family
90 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
91 -- Just <=> instance of family
92 -- Invariant: ifOpenSyn == False
93 -- for family instances
96 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
97 ifName :: OccName, -- Name of the class
98 ifTyVars :: [IfaceTvBndr], -- Type variables
99 ifFDs :: [FunDep FastString], -- Functional dependencies
100 ifATs :: [IfaceDecl], -- Associated type families
101 ifSigs :: [IfaceClassOp], -- Method signatures
102 ifRec :: RecFlag -- Is newtype/datatype associated
103 -- with the class recursive?
106 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
108 ifExtName :: Maybe FastString }
110 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
111 -- Nothing => no default method
112 -- Just False => ordinary polymorphic default method
113 -- Just True => generic default method
116 = IfAbstractTyCon -- No info
117 | IfOpenDataTyCon -- Open data family
118 | IfDataTyCon [IfaceConDecl] -- data type decls
119 | IfNewTyCon IfaceConDecl -- newtype decls
121 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
122 visibleIfConDecls IfAbstractTyCon = []
123 visibleIfConDecls IfOpenDataTyCon = []
124 visibleIfConDecls (IfDataTyCon cs) = cs
125 visibleIfConDecls (IfNewTyCon c) = [c]
129 ifConOcc :: OccName, -- Constructor name
130 ifConWrapper :: Bool, -- True <=> has a wrapper
131 ifConInfix :: Bool, -- True <=> declared infix
132 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
133 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
134 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
135 ifConCtxt :: IfaceContext, -- Non-stupid context
136 ifConArgTys :: [IfaceType], -- Arg types
137 ifConFields :: [OccName], -- ...ditto... (field labels)
138 ifConStricts :: [HsBang]} -- Empty (meaning all lazy),
139 -- or 1-1 corresp with arg tys
142 = IfaceInst { ifInstCls :: IfExtName, -- See comments with
143 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
144 ifDFun :: IfExtName, -- The dfun
145 ifOFlag :: OverlapFlag, -- Overlap flag
146 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
147 -- There's always a separate IfaceDecl for the DFun, which gives
148 -- its IdInfo with its full type and version number.
149 -- The instance declarations taken together have a version number,
150 -- and we don't want that to wobble gratuitously
151 -- If this instance decl is *used*, we'll record a usage on the dfun;
152 -- and if the head does not change it won't be used if it wasn't before
155 = IfaceFamInst { ifFamInstFam :: IfExtName -- Family tycon
156 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
157 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
162 ifRuleName :: RuleName,
163 ifActivation :: Activation,
164 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
165 ifRuleHead :: IfExtName, -- Head of lhs
166 ifRuleArgs :: [IfaceExpr], -- Args of LHS
167 ifRuleRhs :: IfaceExpr,
169 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
174 ifAnnotatedTarget :: IfaceAnnTarget,
175 ifAnnotatedValue :: Serialized
178 type IfaceAnnTarget = AnnTarget OccName
180 -- We only serialise the IdDetails of top-level Ids, and even then
181 -- we only need a very limited selection. Notably, none of the
182 -- implicit ones are needed here, becuase they are not put it
187 | IfRecSelId IfaceTyCon Bool
188 | IfDFunId Int -- Number of silent args
191 = NoInfo -- When writing interface file without -O
192 | HasInfo [IfaceInfoItem] -- Has info, and here it is
194 -- Here's a tricky case:
195 -- * Compile with -O module A, and B which imports A.f
196 -- * Change function f in A, and recompile without -O
197 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
198 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
199 -- but we do not do that now. Instead it's discarded when the
200 -- ModIface is read into the various decl pools.)
201 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
202 -- and so gives a new version.
206 | HsStrictness StrictSig
207 | HsInline InlinePragma
208 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
209 IfaceUnfolding -- See Note [Expose recursive functions]
212 -- NB: Specialisations and rules come in separately and are
213 -- only later attached to the Id. Partial reason: some are orphans.
216 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
217 -- Possibly could eliminate the Bool here, the information
218 -- is also in the InlinePragma.
220 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
222 | IfInlineRule Arity -- INLINE pragmas
223 Bool -- OK to inline even if *un*-saturated
224 Bool -- OK to inline even if context is boring
227 | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName)
228 | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
231 | IfDFunUnfold [DFunArg IfaceExpr]
233 --------------------------------
237 | IfaceType IfaceType
238 | IfaceCo IfaceType -- We re-use IfaceType for coercions
239 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
240 | IfaceLam IfaceBndr IfaceExpr
241 | IfaceApp IfaceExpr IfaceExpr
242 | IfaceCase IfaceExpr IfLclName [IfaceAlt]
243 | IfaceLet IfaceBinding IfaceExpr
244 | IfaceNote IfaceNote IfaceExpr
245 | IfaceCast IfaceExpr IfaceCoercion
247 | IfaceFCall ForeignCall IfaceType
248 | IfaceTick Module Int
250 data IfaceNote = IfaceSCC CostCentre
251 | IfaceCoreNote String
253 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
254 -- Note: IfLclName, not IfaceBndr (and same with the case binder)
255 -- We reconstruct the kind/type of the thing from the context
256 -- thus saving bulk in interface files
258 data IfaceConAlt = IfaceDefault
259 | IfaceDataAlt IfExtName
260 | IfaceTupleAlt Boxity
261 | IfaceLitAlt Literal
264 = IfaceNonRec IfaceLetBndr IfaceExpr
265 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
267 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
268 -- It's used for *non-top-level* let/rec binders
269 -- See Note [IdInfo on nested let-bindings]
270 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
273 Note [Expose recursive functions]
274 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
275 For supercompilation we want to put *all* unfoldings in the interface
276 file, even for functions that are recursive (or big). So we need to
277 know when an unfolding belongs to a loop-breaker so that we can refrain
278 from inlining it (except during supercompilation).
280 Note [IdInfo on nested let-bindings]
281 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
282 Occasionally we want to preserve IdInfo on nested let bindings. The one
283 that came up was a NOINLINE pragma on a let-binding inside an INLINE
284 function. The user (Duncan Coutts) really wanted the NOINLINE control
285 to cross the separate compilation boundary.
287 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
288 that is what is seen by importing module with --make
290 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
291 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
292 If a module contains any "orphans", then its interface file is read
293 regardless, so that its instances are not missed.
295 Roughly speaking, an instance is an orphan if its head (after the =>)
296 mentions nothing defined in this module. Functional dependencies
297 complicate the situation though. Consider
299 module M where { class C a b | a -> b }
301 and suppose we are compiling module X:
306 instance C Int T where ...
308 This instance is an orphan, because when compiling a third module Y we
309 might get a constraint (C Int v), and we'd want to improve v to T. So
310 we must make sure X's instances are loaded, even if we do not directly
313 More precisely, an instance is an orphan iff
315 If there are no fundeps, then at least of the names in
316 the instance head is locally defined.
318 If there are fundeps, then for every fundep, at least one of the
319 names free in a *non-determined* part of the instance head is
320 defined in this module.
322 (Note that these conditions hold trivially if the class is locally
325 Note [Versioning of instances]
326 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
327 Now consider versioning. If we *use* an instance decl in one compilation,
328 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
329 But suppose we *don't* (currently) use an instance! We must recompile if
330 the instance is changed in such a way that it becomes important. (This would
331 only matter with overlapping instances, else the importing module wouldn't have
332 compiled before and the recompilation check is irrelevant.)
334 The is_orph field is set to (Just n) if the instance is not an orphan.
335 The 'n' is *any* of the locally-defined names mentioned anywhere in the
336 instance head. This name is used for versioning; the instance decl is
337 considered part of the defn of this 'n'.
339 I'm worried about whether this works right if we pick a name from
340 a functionally-dependent part of the instance decl. E.g.
342 module M where { class C a b | a -> b }
344 and suppose we are compiling module X:
350 instance C S T where ...
352 If we base the instance verion on T, I'm worried that changing S to S'
353 would change T's version, but not S or S'. But an importing module might
354 not depend on T, and so might not be recompiled even though the new instance
355 (C S' T) might be relevant. I have not been able to make a concrete example,
356 and it seems deeply obscure, so I'm going to leave it for now.
359 Note [Versioning of rules]
360 ~~~~~~~~~~~~~~~~~~~~~~~~~~
361 A rule that is not an orphan has an ifRuleOrph field of (Just n), where n
362 appears on the LHS of the rule; any change in the rule changes the version of n.
366 -- -----------------------------------------------------------------------------
369 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
370 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
371 -- Deeply revolting, because it has to predict what gets bound,
372 -- especially the question of whether there's a wrapper for a datacon
374 -- N.B. the set of names returned here *must* match the set of
375 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
376 -- TyThing.getOccName should define a bijection between the two lists.
377 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
378 -- The order of the list does not matter.
379 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
382 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
383 ifCons = IfNewTyCon (
384 IfCon { ifConOcc = con_occ }),
385 ifFamInst = famInst})
386 = -- implicit coerion and (possibly) family instance coercion
387 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
388 -- data constructor and worker (newtypes don't have a wrapper)
389 [con_occ, mkDataConWorkerOcc con_occ]
392 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
393 ifCons = IfDataTyCon cons,
394 ifFamInst = famInst})
395 = -- (possibly) family instance coercion;
396 -- there is no implicit coercion for non-newtypes
397 famInstCo famInst tc_occ
398 -- for each data constructor in order,
399 -- data constructor, worker, and (possibly) wrapper
400 ++ concatMap dc_occs cons
403 | has_wrapper = [con_occ, work_occ, wrap_occ]
404 | otherwise = [con_occ, work_occ]
406 con_occ = ifConOcc con_decl -- DataCon namespace
407 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
408 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
409 has_wrapper = ifConWrapper con_decl -- This is the reason for
410 -- having the ifConWrapper field!
412 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
413 ifSigs = sigs, ifATs = ats })
414 = -- dictionary datatype:
417 -- (possibly) newtype coercion
419 -- data constructor (DataCon namespace)
420 -- data worker (Id namespace)
421 -- no wrapper (class dictionaries never have a wrapper)
422 [dc_occ, dcww_occ] ++
424 [ifName at | at <- ats ] ++
425 -- superclass selectors
426 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
427 -- operation selectors
428 [op | IfaceClassOp op _ _ <- sigs]
430 n_ctxt = length sc_ctxt
432 tc_occ = mkClassTyConOcc cls_occ
433 dc_occ = mkClassDataConOcc cls_occ
434 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
436 dcww_occ = mkDataConWorkerOcc dc_occ
437 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
439 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
440 ifFamInst = famInst})
441 = famInstCo famInst tc_occ
443 ifaceDeclSubBndrs _ = []
445 -- coercion for data/newtype family instances
446 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
447 famInstCo Nothing _ = []
448 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
450 ----------------------------- Printing IfaceDecl ------------------------------
452 instance Outputable IfaceDecl where
455 pprIfaceDecl :: IfaceDecl -> SDoc
456 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
457 ifIdDetails = details, ifIdInfo = info})
458 = sep [ ppr var <+> dcolon <+> ppr ty,
459 nest 2 (ppr details),
462 pprIfaceDecl (IfaceForeign {ifName = tycon})
463 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
465 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
466 ifSynRhs = Just mono_ty,
467 ifFamInst = mbFamInst})
468 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
469 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
471 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
472 ifSynRhs = Nothing, ifSynKind = kind })
473 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
474 4 (dcolon <+> ppr kind)
476 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
477 ifTyVars = tyvars, ifCons = condecls,
478 ifRec = isrec, ifFamInst = mbFamInst})
479 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
480 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
481 pprFamily mbFamInst])
483 pp_nd = case condecls of
484 IfAbstractTyCon -> ptext (sLit "data")
485 IfOpenDataTyCon -> ptext (sLit "data family")
486 IfDataTyCon _ -> ptext (sLit "data")
487 IfNewTyCon _ -> ptext (sLit "newtype")
489 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
490 ifFDs = fds, ifATs = ats, ifSigs = sigs,
492 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
493 4 (vcat [pprRec isrec,
497 pprRec :: RecFlag -> SDoc
498 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
500 pprGen :: Bool -> SDoc
501 pprGen True = ptext (sLit "Generics: yes")
502 pprGen False = ptext (sLit "Generics: no")
504 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
505 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
506 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
508 instance Outputable IfaceClassOp where
509 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
511 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
512 pprIfaceDeclHead context thing tyvars
513 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
514 pprIfaceTvBndrs tyvars]
516 pp_condecls :: OccName -> IfaceConDecls -> SDoc
517 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
518 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
519 pp_condecls _ IfOpenDataTyCon = empty
520 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
521 (map (pprIfaceConDecl tc) cs))
523 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
525 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
526 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
527 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
528 ifConStricts = strs, ifConFields = fields })
530 if is_infix then ptext (sLit "Infix") else empty,
531 if has_wrap then ptext (sLit "HasWrapper") else empty,
532 ppUnless (null strs) $
533 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
534 ppUnless (null fields) $
535 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
537 ppr_bang HsNoBang = char '_' -- Want to see these
538 ppr_bang bang = ppr bang
540 main_payload = ppr name <+> dcolon <+>
541 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
543 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
544 | (tv,ty) <- eq_spec]
546 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
547 -- because we don't have a Name for the tycon, only an OccName
548 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
549 (t:ts) -> fsep (t : map (arrow <+>) ts)
550 [] -> panic "pp_con_taus"
552 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
554 instance Outputable IfaceRule where
555 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
556 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
557 = sep [hsep [doubleQuotes (ftext name), ppr act,
558 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
559 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
560 ptext (sLit "=") <+> ppr rhs])
563 instance Outputable IfaceInst where
564 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
565 ifInstCls = cls, ifInstTys = mb_tcs})
566 = hang (ptext (sLit "instance") <+> ppr flag
567 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
568 2 (equals <+> ppr dfun_id)
570 instance Outputable IfaceFamInst where
571 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
572 ifFamInstTyCon = tycon_id})
573 = hang (ptext (sLit "family instance") <+>
574 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
575 2 (equals <+> ppr tycon_id)
577 ppr_rough :: Maybe IfaceTyCon -> SDoc
578 ppr_rough Nothing = dot
579 ppr_rough (Just tc) = ppr tc
583 ----------------------------- Printing IfaceExpr ------------------------------------
586 instance Outputable IfaceExpr where
587 ppr e = pprIfaceExpr noParens e
589 pprParendIfaceExpr :: IfaceExpr -> SDoc
590 pprParendIfaceExpr = pprIfaceExpr parens
592 -- | Pretty Print an IfaceExpre
594 -- The first argument should be a function that adds parens in context that need
595 -- an atomic value (e.g. function args)
596 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
598 pprIfaceExpr _ (IfaceLcl v) = ppr v
599 pprIfaceExpr _ (IfaceExt v) = ppr v
600 pprIfaceExpr _ (IfaceLit l) = ppr l
601 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
602 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
603 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
604 pprIfaceExpr _ (IfaceCo co) = text "@~" <+> pprParendIfaceType co
606 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
607 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
609 pprIfaceExpr add_par i@(IfaceLam _ _)
610 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
611 pprIfaceExpr noParens body])
613 (bndrs,body) = collect [] i
614 collect bs (IfaceLam b e) = collect (b:bs) e
615 collect bs e = (reverse bs, e)
617 pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
618 = add_par (sep [ptext (sLit "case")
619 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
620 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
621 pprIfaceExpr noParens rhs <+> char '}'])
623 pprIfaceExpr add_par (IfaceCase scrut bndr alts)
624 = add_par (sep [ptext (sLit "case")
625 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
626 <+> ppr bndr <+> char '{',
627 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
629 pprIfaceExpr _ (IfaceCast expr co)
630 = sep [pprParendIfaceExpr expr,
631 nest 2 (ptext (sLit "`cast`")),
632 pprParendIfaceType co]
634 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
635 = add_par (sep [ptext (sLit "let {"),
636 nest 2 (ppr_bind (b, rhs)),
638 pprIfaceExpr noParens body])
640 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
641 = add_par (sep [ptext (sLit "letrec {"),
642 nest 2 (sep (map ppr_bind pairs)),
644 pprIfaceExpr noParens body])
646 pprIfaceExpr add_par (IfaceNote note body) = add_par $ ppr note
647 <+> pprParendIfaceExpr body
649 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
650 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
651 arrow <+> pprIfaceExpr noParens rhs]
653 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
654 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
655 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
657 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
658 ppr_bind (IfLetBndr b ty info, rhs)
659 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
660 equals <+> pprIfaceExpr noParens rhs]
663 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
664 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
665 nest 2 (pprParendIfaceExpr arg) : args
666 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
669 instance Outputable IfaceNote where
670 ppr (IfaceSCC cc) = pprCostCentreCore cc
671 ppr (IfaceCoreNote s) = ptext (sLit "__core_note")
672 <+> pprHsString (mkFastString s)
675 instance Outputable IfaceConAlt where
676 ppr IfaceDefault = text "DEFAULT"
677 ppr (IfaceLitAlt l) = ppr l
678 ppr (IfaceDataAlt d) = ppr d
679 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
680 -- IfaceTupleAlt is handled by the case-alternative printer
683 instance Outputable IfaceIdDetails where
684 ppr IfVanillaId = empty
685 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
686 <+> if b then ptext (sLit "<naughty>") else empty
687 ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns)
689 instance Outputable IfaceIdInfo where
691 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
692 <+> ptext (sLit "-}")
694 instance Outputable IfaceInfoItem where
695 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding")
696 <> ppWhen lb (ptext (sLit "(loop-breaker)"))
698 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
699 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
700 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
701 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
703 instance Outputable IfaceUnfolding where
704 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
705 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty)
707 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
709 pprParendIfaceExpr e]
710 ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
711 <+> parens (ptext (sLit "arity") <+> int a)
712 ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
713 <+> parens (ptext (sLit "arity") <+> int a)
714 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
715 <+> brackets (pprWithCommas ppr ns)
717 -- -----------------------------------------------------------------------------
718 -- | Finding the Names in IfaceSyn
720 -- This is used for dependency analysis in MkIface, so that we
721 -- fingerprint a declaration before the things that depend on it. It
722 -- is specific to interface-file fingerprinting in the sense that we
723 -- don't collect *all* Names: for example, the DFun of an instance is
724 -- recorded textually rather than by its fingerprint when
725 -- fingerprinting the instance, so DFuns are not dependencies.
727 freeNamesIfDecl :: IfaceDecl -> NameSet
728 freeNamesIfDecl (IfaceId _s t d i) =
729 freeNamesIfType t &&&
730 freeNamesIfIdInfo i &&&
731 freeNamesIfIdDetails d
732 freeNamesIfDecl IfaceForeign{} =
734 freeNamesIfDecl d@IfaceData{} =
735 freeNamesIfTvBndrs (ifTyVars d) &&&
736 freeNamesIfTcFam (ifFamInst d) &&&
737 freeNamesIfContext (ifCtxt d) &&&
738 freeNamesIfConDecls (ifCons d)
739 freeNamesIfDecl d@IfaceSyn{} =
740 freeNamesIfTvBndrs (ifTyVars d) &&&
741 freeNamesIfSynRhs (ifSynRhs d) &&&
742 freeNamesIfTcFam (ifFamInst d)
743 freeNamesIfDecl d@IfaceClass{} =
744 freeNamesIfTvBndrs (ifTyVars d) &&&
745 freeNamesIfContext (ifCtxt d) &&&
746 freeNamesIfDecls (ifATs d) &&&
747 fnList freeNamesIfClsSig (ifSigs d)
749 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
750 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
751 freeNamesIfIdDetails _ = emptyNameSet
753 -- All other changes are handled via the version info on the tycon
754 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
755 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
756 freeNamesIfSynRhs Nothing = emptyNameSet
758 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
759 freeNamesIfTcFam (Just (tc,tys)) =
760 freeNamesIfTc tc &&& fnList freeNamesIfType tys
761 freeNamesIfTcFam Nothing =
764 freeNamesIfContext :: IfaceContext -> NameSet
765 freeNamesIfContext = fnList freeNamesIfPredType
767 freeNamesIfDecls :: [IfaceDecl] -> NameSet
768 freeNamesIfDecls = fnList freeNamesIfDecl
770 freeNamesIfClsSig :: IfaceClassOp -> NameSet
771 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
773 freeNamesIfConDecls :: IfaceConDecls -> NameSet
774 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
775 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
776 freeNamesIfConDecls _ = emptyNameSet
778 freeNamesIfConDecl :: IfaceConDecl -> NameSet
779 freeNamesIfConDecl c =
780 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
781 freeNamesIfTvBndrs (ifConExTvs c) &&&
782 freeNamesIfContext (ifConCtxt c) &&&
783 fnList freeNamesIfType (ifConArgTys c) &&&
784 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
786 freeNamesIfPredType :: IfacePredType -> NameSet
787 freeNamesIfPredType (IfaceClassP cl tys) =
788 unitNameSet cl &&& fnList freeNamesIfType tys
789 freeNamesIfPredType (IfaceIParam _n ty) =
791 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
792 freeNamesIfType ty1 &&& freeNamesIfType ty2
794 freeNamesIfType :: IfaceType -> NameSet
795 freeNamesIfType (IfaceTyVar _) = emptyNameSet
796 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
797 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
798 freeNamesIfType (IfaceTyConApp tc ts) =
799 freeNamesIfTc tc &&& fnList freeNamesIfType ts
800 freeNamesIfType (IfaceForAllTy tv t) =
801 freeNamesIfTvBndr tv &&& freeNamesIfType t
802 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
803 freeNamesIfType (IfaceCoConApp tc ts) =
804 freeNamesIfCo tc &&& fnList freeNamesIfType ts
806 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
807 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
809 freeNamesIfBndr :: IfaceBndr -> NameSet
810 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
811 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
813 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
814 -- Remember IfaceLetBndr is used only for *nested* bindings
815 -- The IdInfo can contain an unfolding (in the case of
816 -- local INLINE pragmas), so look there too
817 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
818 &&& freeNamesIfIdInfo info
820 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
821 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
822 -- kinds can have Names inside, when the Kind is an equality predicate
824 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
825 freeNamesIfIdBndr = freeNamesIfTvBndr
827 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
828 freeNamesIfIdInfo NoInfo = emptyNameSet
829 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
831 freeNamesItem :: IfaceInfoItem -> NameSet
832 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
833 freeNamesItem _ = emptyNameSet
835 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
836 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
837 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
838 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
839 freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
840 freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
841 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
843 freeNamesIfExpr :: IfaceExpr -> NameSet
844 freeNamesIfExpr (IfaceExt v) = unitNameSet v
845 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
846 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
847 freeNamesIfExpr (IfaceCo co) = freeNamesIfType co
848 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
849 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
850 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
851 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
852 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
854 freeNamesIfExpr (IfaceCase s _ alts)
856 &&& fnList fn_alt alts &&& fn_cons alts
858 fn_alt (_con,_bs,r) = freeNamesIfExpr r
860 -- Depend on the data constructors. Just one will do!
861 -- Note [Tracking data constructors]
862 fn_cons [] = emptyNameSet
863 fn_cons ((IfaceDefault ,_,_) : xs) = fn_cons xs
864 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
865 fn_cons (_ : _ ) = emptyNameSet
867 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
868 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
870 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
871 = fnList fn_pair as &&& freeNamesIfExpr x
873 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
875 freeNamesIfExpr _ = emptyNameSet
877 freeNamesIfTc :: IfaceTyCon -> NameSet
878 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
879 -- ToDo: shouldn't we include IfaceIntTc & co.?
880 freeNamesIfTc _ = emptyNameSet
882 freeNamesIfCo :: IfaceCoCon -> NameSet
883 freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
884 freeNamesIfCo _ = emptyNameSet
886 freeNamesIfRule :: IfaceRule -> NameSet
887 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
888 , ifRuleArgs = es, ifRuleRhs = rhs })
890 fnList freeNamesIfBndr bs &&&
891 fnList freeNamesIfExpr es &&&
895 (&&&) :: NameSet -> NameSet -> NameSet
896 (&&&) = unionNameSets
898 fnList :: (a -> NameSet) -> [a] -> NameSet
899 fnList f = foldr (&&&) emptyNameSet . map f
902 Note [Tracking data constructors]
903 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
905 case e of { C a -> ...; ... }
906 You might think that we don't need to include the datacon C
907 in the free names, because its type will probably show up in
908 the free names of 'e'. But in rare circumstances this may
909 not happen. Here's the one that bit me:
911 module DynFlags where
912 import {-# SOURCE #-} Packages( PackageState )
913 data DynFlags = DF ... PackageState ...
915 module Packages where
917 data PackageState = PS ...
918 lookupModule (df :: DynFlags)
920 DF ...p... -> case p of
923 Now, lookupModule depends on DynFlags, but the transitive dependency
924 on the *locally-defined* type PackageState is not visible. We need
925 to take account of the use of the data constructor PS in the pattern match.