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 :: IfExtName, -- See comments with
141 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
142 ifDFun :: IfExtName, -- 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 :: IfExtName -- 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 :: IfExtName, -- 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 | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName)
226 | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
229 | IfDFunUnfold [IfaceExpr]
231 --------------------------------
235 | IfaceType IfaceType
236 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
237 | IfaceLam IfaceBndr IfaceExpr
238 | IfaceApp IfaceExpr IfaceExpr
239 | IfaceCase IfaceExpr IfLclName IfaceType [IfaceAlt]
240 | IfaceLet IfaceBinding IfaceExpr
241 | IfaceNote IfaceNote IfaceExpr
242 | IfaceCast IfaceExpr IfaceCoercion
244 | IfaceFCall ForeignCall IfaceType
245 | IfaceTick Module Int
247 data IfaceNote = IfaceSCC CostCentre
248 | IfaceCoreNote String
250 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
251 -- Note: IfLclName, not IfaceBndr (and same with the case binder)
252 -- We reconstruct the kind/type of the thing from the context
253 -- thus saving bulk in interface files
255 data IfaceConAlt = IfaceDefault
256 | IfaceDataAlt IfExtName
257 | IfaceTupleAlt Boxity
258 | IfaceLitAlt Literal
261 = IfaceNonRec IfaceLetBndr IfaceExpr
262 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
264 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
265 -- It's used for *non-top-level* let/rec binders
266 -- See Note [IdInfo on nested let-bindings]
267 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
270 Note [Expose recursive functions]
271 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
272 For supercompilation we want to put *all* unfoldings in the interface
273 file, even for functions that are recursive (or big). So we need to
274 know when an unfolding belongs to a loop-breaker so that we can refrain
275 from inlining it (except during supercompilation).
277 Note [IdInfo on nested let-bindings]
278 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
279 Occasionally we want to preserve IdInfo on nested let bindings. The one
280 that came up was a NOINLINE pragma on a let-binding inside an INLINE
281 function. The user (Duncan Coutts) really wanted the NOINLINE control
282 to cross the separate compilation boundary.
284 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
285 that is what is seen by importing module with --make
287 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
288 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
289 If a module contains any "orphans", then its interface file is read
290 regardless, so that its instances are not missed.
292 Roughly speaking, an instance is an orphan if its head (after the =>)
293 mentions nothing defined in this module. Functional dependencies
294 complicate the situation though. Consider
296 module M where { class C a b | a -> b }
298 and suppose we are compiling module X:
303 instance C Int T where ...
305 This instance is an orphan, because when compiling a third module Y we
306 might get a constraint (C Int v), and we'd want to improve v to T. So
307 we must make sure X's instances are loaded, even if we do not directly
310 More precisely, an instance is an orphan iff
312 If there are no fundeps, then at least of the names in
313 the instance head is locally defined.
315 If there are fundeps, then for every fundep, at least one of the
316 names free in a *non-determined* part of the instance head is
317 defined in this module.
319 (Note that these conditions hold trivially if the class is locally
322 Note [Versioning of instances]
323 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
324 Now consider versioning. If we *use* an instance decl in one compilation,
325 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
326 But suppose we *don't* (currently) use an instance! We must recompile if
327 the instance is changed in such a way that it becomes important. (This would
328 only matter with overlapping instances, else the importing module wouldn't have
329 compiled before and the recompilation check is irrelevant.)
331 The is_orph field is set to (Just n) if the instance is not an orphan.
332 The 'n' is *any* of the locally-defined names mentioned anywhere in the
333 instance head. This name is used for versioning; the instance decl is
334 considered part of the defn of this 'n'.
336 I'm worried about whether this works right if we pick a name from
337 a functionally-dependent part of the instance decl. E.g.
339 module M where { class C a b | a -> b }
341 and suppose we are compiling module X:
347 instance C S T where ...
349 If we base the instance verion on T, I'm worried that changing S to S'
350 would change T's version, but not S or S'. But an importing module might
351 not depend on T, and so might not be recompiled even though the new instance
352 (C S' T) might be relevant. I have not been able to make a concrete example,
353 and it seems deeply obscure, so I'm going to leave it for now.
356 Note [Versioning of rules]
357 ~~~~~~~~~~~~~~~~~~~~~~~~~~
358 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
359 n appears on the LHS of the rule; any change in the rule changes the version of n.
363 -- -----------------------------------------------------------------------------
366 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
367 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
368 -- Deeply revolting, because it has to predict what gets bound,
369 -- especially the question of whether there's a wrapper for a datacon
371 -- N.B. the set of names returned here *must* match the set of
372 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
373 -- TyThing.getOccName should define a bijection between the two lists.
374 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
375 -- The order of the list does not matter.
376 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
379 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
380 ifCons = IfNewTyCon (
381 IfCon { ifConOcc = con_occ }),
382 ifFamInst = famInst})
383 = -- implicit coerion and (possibly) family instance coercion
384 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
385 -- data constructor and worker (newtypes don't have a wrapper)
386 [con_occ, mkDataConWorkerOcc con_occ]
389 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
390 ifCons = IfDataTyCon cons,
391 ifFamInst = famInst})
392 = -- (possibly) family instance coercion;
393 -- there is no implicit coercion for non-newtypes
394 famInstCo famInst tc_occ
395 -- for each data constructor in order,
396 -- data constructor, worker, and (possibly) wrapper
397 ++ concatMap dc_occs cons
400 | has_wrapper = [con_occ, work_occ, wrap_occ]
401 | otherwise = [con_occ, work_occ]
403 con_occ = ifConOcc con_decl -- DataCon namespace
404 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
405 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
406 has_wrapper = ifConWrapper con_decl -- This is the reason for
407 -- having the ifConWrapper field!
409 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
410 ifSigs = sigs, ifATs = ats })
411 = -- dictionary datatype:
414 -- (possibly) newtype coercion
416 -- data constructor (DataCon namespace)
417 -- data worker (Id namespace)
418 -- no wrapper (class dictionaries never have a wrapper)
419 [dc_occ, dcww_occ] ++
421 [ifName at | at <- ats ] ++
422 -- superclass selectors
423 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
424 -- operation selectors
425 [op | IfaceClassOp op _ _ <- sigs]
427 n_ctxt = length sc_ctxt
429 tc_occ = mkClassTyConOcc cls_occ
430 dc_occ = mkClassDataConOcc cls_occ
431 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
433 dcww_occ = mkDataConWorkerOcc dc_occ
434 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
436 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
437 ifFamInst = famInst})
438 = famInstCo famInst tc_occ
440 ifaceDeclSubBndrs _ = []
442 -- coercion for data/newtype family instances
443 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
444 famInstCo Nothing _ = []
445 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
447 ----------------------------- Printing IfaceDecl ------------------------------
449 instance Outputable IfaceDecl where
452 pprIfaceDecl :: IfaceDecl -> SDoc
453 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
454 ifIdDetails = details, ifIdInfo = info})
455 = sep [ ppr var <+> dcolon <+> ppr ty,
456 nest 2 (ppr details),
459 pprIfaceDecl (IfaceForeign {ifName = tycon})
460 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
462 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
463 ifSynRhs = Just mono_ty,
464 ifFamInst = mbFamInst})
465 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
466 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
468 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
469 ifSynRhs = Nothing, ifSynKind = kind })
470 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
471 4 (dcolon <+> ppr kind)
473 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
474 ifTyVars = tyvars, ifCons = condecls,
475 ifRec = isrec, ifFamInst = mbFamInst})
476 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
477 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
478 pprFamily mbFamInst])
480 pp_nd = case condecls of
481 IfAbstractTyCon -> ptext (sLit "data")
482 IfOpenDataTyCon -> ptext (sLit "data family")
483 IfDataTyCon _ -> ptext (sLit "data")
484 IfNewTyCon _ -> ptext (sLit "newtype")
486 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
487 ifFDs = fds, ifATs = ats, ifSigs = sigs,
489 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
490 4 (vcat [pprRec isrec,
494 pprRec :: RecFlag -> SDoc
495 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
497 pprGen :: Bool -> SDoc
498 pprGen True = ptext (sLit "Generics: yes")
499 pprGen False = ptext (sLit "Generics: no")
501 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
502 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
503 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
505 instance Outputable IfaceClassOp where
506 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
508 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
509 pprIfaceDeclHead context thing tyvars
510 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
511 pprIfaceTvBndrs tyvars]
513 pp_condecls :: OccName -> IfaceConDecls -> SDoc
514 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
515 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
516 pp_condecls _ IfOpenDataTyCon = empty
517 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
518 (map (pprIfaceConDecl tc) cs))
520 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
522 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
523 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
524 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
525 ifConStricts = strs, ifConFields = fields })
527 if is_infix then ptext (sLit "Infix") else empty,
528 if has_wrap then ptext (sLit "HasWrapper") else empty,
529 ppUnless (null strs) $
530 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
531 ppUnless (null fields) $
532 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
534 ppr_bang HsNoBang = char '_' -- Want to see these
535 ppr_bang bang = ppr bang
537 main_payload = ppr name <+> dcolon <+>
538 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
540 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
541 | (tv,ty) <- eq_spec]
543 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
544 -- because we don't have a Name for the tycon, only an OccName
545 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
546 (t:ts) -> fsep (t : map (arrow <+>) ts)
547 [] -> panic "pp_con_taus"
549 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
551 instance Outputable IfaceRule where
552 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
553 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
554 = sep [hsep [doubleQuotes (ftext name), ppr act,
555 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
556 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
557 ptext (sLit "=") <+> ppr rhs])
560 instance Outputable IfaceInst where
561 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
562 ifInstCls = cls, ifInstTys = mb_tcs})
563 = hang (ptext (sLit "instance") <+> ppr flag
564 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
565 2 (equals <+> ppr dfun_id)
567 instance Outputable IfaceFamInst where
568 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
569 ifFamInstTyCon = tycon_id})
570 = hang (ptext (sLit "family instance") <+>
571 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
572 2 (equals <+> ppr tycon_id)
574 ppr_rough :: Maybe IfaceTyCon -> SDoc
575 ppr_rough Nothing = dot
576 ppr_rough (Just tc) = ppr tc
580 ----------------------------- Printing IfaceExpr ------------------------------------
583 instance Outputable IfaceExpr where
584 ppr e = pprIfaceExpr noParens e
586 pprParendIfaceExpr :: IfaceExpr -> SDoc
587 pprParendIfaceExpr = pprIfaceExpr parens
589 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
590 -- The function adds parens in context that need
591 -- an atomic value (e.g. function args)
593 pprIfaceExpr _ (IfaceLcl v) = ppr v
594 pprIfaceExpr _ (IfaceExt v) = ppr v
595 pprIfaceExpr _ (IfaceLit l) = ppr l
596 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
597 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
598 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
600 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
601 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
603 pprIfaceExpr add_par e@(IfaceLam _ _)
604 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
605 pprIfaceExpr noParens body])
607 (bndrs,body) = collect [] e
608 collect bs (IfaceLam b e) = collect (b:bs) e
609 collect bs e = (reverse bs, e)
611 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
612 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
613 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
614 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
615 pprIfaceExpr noParens rhs <+> char '}'])
617 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
618 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
619 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
620 <+> ppr bndr <+> char '{',
621 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
623 pprIfaceExpr _ (IfaceCast expr co)
624 = sep [pprParendIfaceExpr expr,
625 nest 2 (ptext (sLit "`cast`")),
626 pprParendIfaceType co]
628 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
629 = add_par (sep [ptext (sLit "let {"),
630 nest 2 (ppr_bind (b, rhs)),
632 pprIfaceExpr noParens body])
634 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
635 = add_par (sep [ptext (sLit "letrec {"),
636 nest 2 (sep (map ppr_bind pairs)),
638 pprIfaceExpr noParens body])
640 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
642 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
643 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
644 arrow <+> pprIfaceExpr noParens rhs]
646 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
647 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
648 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
650 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
651 ppr_bind (IfLetBndr b ty info, rhs)
652 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
653 equals <+> pprIfaceExpr noParens rhs]
656 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
657 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
658 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
661 instance Outputable IfaceNote where
662 ppr (IfaceSCC cc) = pprCostCentreCore cc
663 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
666 instance Outputable IfaceConAlt where
667 ppr IfaceDefault = text "DEFAULT"
668 ppr (IfaceLitAlt l) = ppr l
669 ppr (IfaceDataAlt d) = ppr d
670 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
671 -- IfaceTupleAlt is handled by the case-alternative printer
674 instance Outputable IfaceIdDetails where
675 ppr IfVanillaId = empty
676 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
677 <+> if b then ptext (sLit "<naughty>") else empty
678 ppr IfDFunId = ptext (sLit "DFunId")
680 instance Outputable IfaceIdInfo where
682 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
684 instance Outputable IfaceInfoItem where
685 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
687 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
688 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
689 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
690 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
692 instance Outputable IfaceUnfolding where
693 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
694 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
695 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
696 pprParendIfaceExpr e]
697 ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
698 <+> parens (ptext (sLit "arity") <+> int a)
699 ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
700 <+> parens (ptext (sLit "arity") <+> int a)
701 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
702 <+> brackets (pprWithCommas pprParendIfaceExpr ns)
705 -- -----------------------------------------------------------------------------
706 -- Finding the Names in IfaceSyn
708 -- This is used for dependency analysis in MkIface, so that we
709 -- fingerprint a declaration before the things that depend on it. It
710 -- is specific to interface-file fingerprinting in the sense that we
711 -- don't collect *all* Names: for example, the DFun of an instance is
712 -- recorded textually rather than by its fingerprint when
713 -- fingerprinting the instance, so DFuns are not dependencies.
715 freeNamesIfDecl :: IfaceDecl -> NameSet
716 freeNamesIfDecl (IfaceId _s t d i) =
717 freeNamesIfType t &&&
718 freeNamesIfIdInfo i &&&
719 freeNamesIfIdDetails d
720 freeNamesIfDecl IfaceForeign{} =
722 freeNamesIfDecl d@IfaceData{} =
723 freeNamesIfTvBndrs (ifTyVars d) &&&
724 freeNamesIfTcFam (ifFamInst d) &&&
725 freeNamesIfContext (ifCtxt d) &&&
726 freeNamesIfConDecls (ifCons d)
727 freeNamesIfDecl d@IfaceSyn{} =
728 freeNamesIfTvBndrs (ifTyVars d) &&&
729 freeNamesIfSynRhs (ifSynRhs d) &&&
730 freeNamesIfTcFam (ifFamInst d)
731 freeNamesIfDecl d@IfaceClass{} =
732 freeNamesIfTvBndrs (ifTyVars d) &&&
733 freeNamesIfContext (ifCtxt d) &&&
734 freeNamesIfDecls (ifATs d) &&&
735 fnList freeNamesIfClsSig (ifSigs d)
737 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
738 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
739 freeNamesIfIdDetails _ = emptyNameSet
741 -- All other changes are handled via the version info on the tycon
742 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
743 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
744 freeNamesIfSynRhs Nothing = emptyNameSet
746 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
747 freeNamesIfTcFam (Just (tc,tys)) =
748 freeNamesIfTc tc &&& fnList freeNamesIfType tys
749 freeNamesIfTcFam Nothing =
752 freeNamesIfContext :: IfaceContext -> NameSet
753 freeNamesIfContext = fnList freeNamesIfPredType
755 freeNamesIfDecls :: [IfaceDecl] -> NameSet
756 freeNamesIfDecls = fnList freeNamesIfDecl
758 freeNamesIfClsSig :: IfaceClassOp -> NameSet
759 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
761 freeNamesIfConDecls :: IfaceConDecls -> NameSet
762 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
763 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
764 freeNamesIfConDecls _ = emptyNameSet
766 freeNamesIfConDecl :: IfaceConDecl -> NameSet
767 freeNamesIfConDecl c =
768 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
769 freeNamesIfTvBndrs (ifConExTvs c) &&&
770 freeNamesIfContext (ifConCtxt c) &&&
771 fnList freeNamesIfType (ifConArgTys c) &&&
772 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
774 freeNamesIfPredType :: IfacePredType -> NameSet
775 freeNamesIfPredType (IfaceClassP cl tys) =
776 unitNameSet cl &&& fnList freeNamesIfType tys
777 freeNamesIfPredType (IfaceIParam _n ty) =
779 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
780 freeNamesIfType ty1 &&& freeNamesIfType ty2
782 freeNamesIfType :: IfaceType -> NameSet
783 freeNamesIfType (IfaceTyVar _) = emptyNameSet
784 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
785 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
786 freeNamesIfType (IfaceTyConApp tc ts) =
787 freeNamesIfTc tc &&& fnList freeNamesIfType ts
788 freeNamesIfType (IfaceForAllTy tv t) =
789 freeNamesIfTvBndr tv &&& freeNamesIfType t
790 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
792 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
793 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
795 freeNamesIfBndr :: IfaceBndr -> NameSet
796 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
797 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
799 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
800 -- Remember IfaceLetBndr is used only for *nested* bindings
801 -- The cut-down IdInfo never contains any Names, but the type may!
802 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
804 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
805 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
806 -- kinds can have Names inside, when the Kind is an equality predicate
808 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
809 freeNamesIfIdBndr = freeNamesIfTvBndr
811 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
812 freeNamesIfIdInfo NoInfo = emptyNameSet
813 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
815 freeNamesItem :: IfaceInfoItem -> NameSet
816 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
817 freeNamesItem _ = emptyNameSet
819 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
820 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
821 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
822 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
823 freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
824 freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
825 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
827 freeNamesIfExpr :: IfaceExpr -> NameSet
828 freeNamesIfExpr (IfaceExt v) = unitNameSet v
829 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
830 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
831 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
832 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
833 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
834 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
835 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
837 freeNamesIfExpr (IfaceCase s _ ty alts)
839 &&& fnList fn_alt alts &&& fn_cons alts
840 &&& freeNamesIfType ty
842 fn_alt (_con,_bs,r) = freeNamesIfExpr r
844 -- Depend on the data constructors. Just one will do!
845 -- Note [Tracking data constructors]
846 fn_cons [] = emptyNameSet
847 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
848 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
849 fn_cons (_ : _ ) = emptyNameSet
851 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
852 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
854 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
855 = fnList fn_pair as &&& freeNamesIfExpr x
857 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
859 freeNamesIfExpr _ = emptyNameSet
862 freeNamesIfTc :: IfaceTyCon -> NameSet
863 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
864 -- ToDo: shouldn't we include IfaceIntTc & co.?
865 freeNamesIfTc _ = emptyNameSet
867 freeNamesIfRule :: IfaceRule -> NameSet
868 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
869 , ifRuleArgs = es, ifRuleRhs = rhs })
871 fnList freeNamesIfBndr bs &&&
872 fnList freeNamesIfExpr es &&&
876 (&&&) :: NameSet -> NameSet -> NameSet
877 (&&&) = unionNameSets
879 fnList :: (a -> NameSet) -> [a] -> NameSet
880 fnList f = foldr (&&&) emptyNameSet . map f
883 Note [Tracking data constructors]
884 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
886 case e of { C a -> ...; ... }
887 You might think that we don't need to include the datacon C
888 in the free names, because its type will probably show up in
889 the free names of 'e'. But in rare circumstances this may
890 not happen. Here's the one that bit me:
892 module DynFlags where
893 import {-# SOURCE #-} Packages( PackageState )
894 data DynFlags = DF ... PackageState ...
896 module Packages where
898 data PackageState = PS ...
899 lookupModule (df :: DynFlags)
901 DF ...p... -> case p of
904 Now, lookupModule depends on DynFlags, but the transitive dependency
905 on the *locally-defined* type PackageState is not visible. We need
906 to take account of the use of the data constructor PS in the pattern match.