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,
166 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
171 ifAnnotatedTarget :: IfaceAnnTarget,
172 ifAnnotatedValue :: Serialized
175 type IfaceAnnTarget = AnnTarget OccName
177 -- We only serialise the IdDetails of top-level Ids, and even then
178 -- we only need a very limited selection. Notably, none of the
179 -- implicit ones are needed here, becuase they are not put it
184 | IfRecSelId IfaceTyCon Bool
188 = NoInfo -- When writing interface file without -O
189 | HasInfo [IfaceInfoItem] -- Has info, and here it is
191 -- Here's a tricky case:
192 -- * Compile with -O module A, and B which imports A.f
193 -- * Change function f in A, and recompile without -O
194 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
195 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
196 -- but we do not do that now. Instead it's discarded when the
197 -- ModIface is read into the various decl pools.)
198 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
199 -- and so gives a new version.
203 | HsStrictness StrictSig
204 | HsInline InlinePragma
205 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
206 IfaceUnfolding -- See Note [Expose recursive functions]
209 -- NB: Specialisations and rules come in separately and are
210 -- only later attached to the Id. Partial reason: some are orphans.
213 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
215 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
218 Bool -- OK to inline even if *un*-saturated
219 Bool -- OK to inline even if context is boring
222 | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
223 -- can simplify to a function in another module.
225 | IfDFunUnfold [IfaceExpr]
227 --------------------------------
229 = IfaceLcl FastString
231 | IfaceType IfaceType
232 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
233 | IfaceLam IfaceBndr IfaceExpr
234 | IfaceApp IfaceExpr IfaceExpr
235 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
236 | IfaceLet IfaceBinding IfaceExpr
237 | IfaceNote IfaceNote IfaceExpr
238 | IfaceCast IfaceExpr IfaceCoercion
240 | IfaceFCall ForeignCall IfaceType
241 | IfaceTick Module Int
243 data IfaceNote = IfaceSCC CostCentre
244 | IfaceCoreNote String
246 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
247 -- Note: FastString, not IfaceBndr (and same with the case binder)
248 -- We reconstruct the kind/type of the thing from the context
249 -- thus saving bulk in interface files
251 data IfaceConAlt = IfaceDefault
253 | IfaceTupleAlt Boxity
254 | IfaceLitAlt Literal
257 = IfaceNonRec IfaceLetBndr IfaceExpr
258 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
260 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
261 -- It's used for *non-top-level* let/rec binders
262 -- See Note [IdInfo on nested let-bindings]
263 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
266 Note [Expose recursive functions]
267 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
268 For supercompilation we want to put *all* unfoldings in the interface
269 file, even for functions that are recursive (or big). So we need to
270 know when an unfolding belongs to a loop-breaker so that we can refrain
271 from inlining it (except during supercompilation).
273 Note [IdInfo on nested let-bindings]
274 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
275 Occasionally we want to preserve IdInfo on nested let bindings. The one
276 that came up was a NOINLINE pragma on a let-binding inside an INLINE
277 function. The user (Duncan Coutts) really wanted the NOINLINE control
278 to cross the separate compilation boundary.
280 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
281 Currently we only actually retain InlinePragInfo, but in principle we could
285 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
286 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
287 If a module contains any "orphans", then its interface file is read
288 regardless, so that its instances are not missed.
290 Roughly speaking, an instance is an orphan if its head (after the =>)
291 mentions nothing defined in this module. Functional dependencies
292 complicate the situation though. Consider
294 module M where { class C a b | a -> b }
296 and suppose we are compiling module X:
301 instance C Int T where ...
303 This instance is an orphan, because when compiling a third module Y we
304 might get a constraint (C Int v), and we'd want to improve v to T. So
305 we must make sure X's instances are loaded, even if we do not directly
308 More precisely, an instance is an orphan iff
310 If there are no fundeps, then at least of the names in
311 the instance head is locally defined.
313 If there are fundeps, then for every fundep, at least one of the
314 names free in a *non-determined* part of the instance head is
315 defined in this module.
317 (Note that these conditions hold trivially if the class is locally
320 Note [Versioning of instances]
321 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
322 Now consider versioning. If we *use* an instance decl in one compilation,
323 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
324 But suppose we *don't* (currently) use an instance! We must recompile if
325 the instance is changed in such a way that it becomes important. (This would
326 only matter with overlapping instances, else the importing module wouldn't have
327 compiled before and the recompilation check is irrelevant.)
329 The is_orph field is set to (Just n) if the instance is not an orphan.
330 The 'n' is *any* of the locally-defined names mentioned anywhere in the
331 instance head. This name is used for versioning; the instance decl is
332 considered part of the defn of this 'n'.
334 I'm worried about whether this works right if we pick a name from
335 a functionally-dependent part of the instance decl. E.g.
337 module M where { class C a b | a -> b }
339 and suppose we are compiling module X:
345 instance C S T where ...
347 If we base the instance verion on T, I'm worried that changing S to S'
348 would change T's version, but not S or S'. But an importing module might
349 not depend on T, and so might not be recompiled even though the new instance
350 (C S' T) might be relevant. I have not been able to make a concrete example,
351 and it seems deeply obscure, so I'm going to leave it for now.
354 Note [Versioning of rules]
355 ~~~~~~~~~~~~~~~~~~~~~~~~~~
356 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
357 n appears on the LHS of the rule; any change in the rule changes the version of n.
361 -- -----------------------------------------------------------------------------
364 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
365 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
366 -- Deeply revolting, because it has to predict what gets bound,
367 -- especially the question of whether there's a wrapper for a datacon
369 -- N.B. the set of names returned here *must* match the set of
370 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
371 -- TyThing.getOccName should define a bijection between the two lists.
372 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
373 -- The order of the list does not matter.
374 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
377 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
378 ifCons = IfNewTyCon (
379 IfCon { ifConOcc = con_occ }),
380 ifFamInst = famInst})
381 = -- implicit coerion and (possibly) family instance coercion
382 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
383 -- data constructor and worker (newtypes don't have a wrapper)
384 [con_occ, mkDataConWorkerOcc con_occ]
387 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
388 ifCons = IfDataTyCon cons,
389 ifFamInst = famInst})
390 = -- (possibly) family instance coercion;
391 -- there is no implicit coercion for non-newtypes
392 famInstCo famInst tc_occ
393 -- for each data constructor in order,
394 -- data constructor, worker, and (possibly) wrapper
395 ++ concatMap dc_occs cons
398 | has_wrapper = [con_occ, work_occ, wrap_occ]
399 | otherwise = [con_occ, work_occ]
401 con_occ = ifConOcc con_decl -- DataCon namespace
402 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
403 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
404 has_wrapper = ifConWrapper con_decl -- This is the reason for
405 -- having the ifConWrapper field!
407 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
408 ifSigs = sigs, ifATs = ats })
409 = -- dictionary datatype:
412 -- (possibly) newtype coercion
414 -- data constructor (DataCon namespace)
415 -- data worker (Id namespace)
416 -- no wrapper (class dictionaries never have a wrapper)
417 [dc_occ, dcww_occ] ++
419 [ifName at | at <- ats ] ++
420 -- superclass selectors
421 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
422 -- operation selectors
423 [op | IfaceClassOp op _ _ <- sigs]
425 n_ctxt = length sc_ctxt
427 tc_occ = mkClassTyConOcc cls_occ
428 dc_occ = mkClassDataConOcc cls_occ
429 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
431 dcww_occ = mkDataConWorkerOcc dc_occ
432 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
434 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
435 ifFamInst = famInst})
436 = famInstCo famInst tc_occ
438 ifaceDeclSubBndrs _ = []
440 -- coercion for data/newtype family instances
441 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
442 famInstCo Nothing _ = []
443 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
445 ----------------------------- Printing IfaceDecl ------------------------------
447 instance Outputable IfaceDecl where
450 pprIfaceDecl :: IfaceDecl -> SDoc
451 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
452 ifIdDetails = details, ifIdInfo = info})
453 = sep [ ppr var <+> dcolon <+> ppr ty,
454 nest 2 (ppr details),
457 pprIfaceDecl (IfaceForeign {ifName = tycon})
458 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
460 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
461 ifSynRhs = Just mono_ty,
462 ifFamInst = mbFamInst})
463 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
464 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
466 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
467 ifSynRhs = Nothing, ifSynKind = kind })
468 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
469 4 (dcolon <+> ppr kind)
471 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
472 ifTyVars = tyvars, ifCons = condecls,
473 ifRec = isrec, ifFamInst = mbFamInst})
474 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
475 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
476 pprFamily mbFamInst])
478 pp_nd = case condecls of
479 IfAbstractTyCon -> ptext (sLit "data")
480 IfOpenDataTyCon -> ptext (sLit "data family")
481 IfDataTyCon _ -> ptext (sLit "data")
482 IfNewTyCon _ -> ptext (sLit "newtype")
484 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
485 ifFDs = fds, ifATs = ats, ifSigs = sigs,
487 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
488 4 (vcat [pprRec isrec,
492 pprRec :: RecFlag -> SDoc
493 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
495 pprGen :: Bool -> SDoc
496 pprGen True = ptext (sLit "Generics: yes")
497 pprGen False = ptext (sLit "Generics: no")
499 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
500 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
501 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
503 instance Outputable IfaceClassOp where
504 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
506 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
507 pprIfaceDeclHead context thing tyvars
508 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
509 pprIfaceTvBndrs tyvars]
511 pp_condecls :: OccName -> IfaceConDecls -> SDoc
512 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
513 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
514 pp_condecls _ IfOpenDataTyCon = empty
515 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
516 (map (pprIfaceConDecl tc) cs))
518 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
520 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
521 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
522 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
523 ifConStricts = strs, ifConFields = fields })
525 if is_infix then ptext (sLit "Infix") else empty,
526 if has_wrap then ptext (sLit "HasWrapper") else empty,
527 ppUnless (null strs) $
528 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
529 ppUnless (null fields) $
530 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
532 ppr_bang HsNoBang = char '_' -- Want to see these
533 ppr_bang bang = ppr bang
535 main_payload = ppr name <+> dcolon <+>
536 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
538 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
539 | (tv,ty) <- eq_spec]
541 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
542 -- because we don't have a Name for the tycon, only an OccName
543 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
544 (t:ts) -> fsep (t : map (arrow <+>) ts)
545 [] -> panic "pp_con_taus"
547 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
549 instance Outputable IfaceRule where
550 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
551 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
552 = sep [hsep [doubleQuotes (ftext name), ppr act,
553 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
554 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
555 ptext (sLit "=") <+> ppr rhs])
558 instance Outputable IfaceInst where
559 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
560 ifInstCls = cls, ifInstTys = mb_tcs})
561 = hang (ptext (sLit "instance") <+> ppr flag
562 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
563 2 (equals <+> ppr dfun_id)
565 instance Outputable IfaceFamInst where
566 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
567 ifFamInstTyCon = tycon_id})
568 = hang (ptext (sLit "family instance") <+>
569 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
570 2 (equals <+> ppr tycon_id)
572 ppr_rough :: Maybe IfaceTyCon -> SDoc
573 ppr_rough Nothing = dot
574 ppr_rough (Just tc) = ppr tc
578 ----------------------------- Printing IfaceExpr ------------------------------------
581 instance Outputable IfaceExpr where
582 ppr e = pprIfaceExpr noParens e
584 pprParendIfaceExpr :: IfaceExpr -> SDoc
585 pprParendIfaceExpr = pprIfaceExpr parens
587 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
588 -- The function adds parens in context that need
589 -- an atomic value (e.g. function args)
591 pprIfaceExpr _ (IfaceLcl v) = ppr v
592 pprIfaceExpr _ (IfaceExt v) = ppr v
593 pprIfaceExpr _ (IfaceLit l) = ppr l
594 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
595 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
596 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
598 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
599 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
601 pprIfaceExpr add_par e@(IfaceLam _ _)
602 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
603 pprIfaceExpr noParens body])
605 (bndrs,body) = collect [] e
606 collect bs (IfaceLam b e) = collect (b:bs) e
607 collect bs e = (reverse bs, e)
609 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
610 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
611 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
612 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
613 pprIfaceExpr noParens rhs <+> char '}'])
615 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
616 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
617 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
618 <+> ppr bndr <+> char '{',
619 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
621 pprIfaceExpr _ (IfaceCast expr co)
622 = sep [pprParendIfaceExpr expr,
623 nest 2 (ptext (sLit "`cast`")),
624 pprParendIfaceType co]
626 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
627 = add_par (sep [ptext (sLit "let {"),
628 nest 2 (ppr_bind (b, rhs)),
630 pprIfaceExpr noParens body])
632 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
633 = add_par (sep [ptext (sLit "letrec {"),
634 nest 2 (sep (map ppr_bind pairs)),
636 pprIfaceExpr noParens body])
638 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
640 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
641 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
642 arrow <+> pprIfaceExpr noParens rhs]
644 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
645 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
646 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
648 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
649 ppr_bind (IfLetBndr b ty info, rhs)
650 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
651 equals <+> pprIfaceExpr noParens rhs]
654 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
655 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
656 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
659 instance Outputable IfaceNote where
660 ppr (IfaceSCC cc) = pprCostCentreCore cc
661 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
664 instance Outputable IfaceConAlt where
665 ppr IfaceDefault = text "DEFAULT"
666 ppr (IfaceLitAlt l) = ppr l
667 ppr (IfaceDataAlt d) = ppr d
668 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
669 -- IfaceTupleAlt is handled by the case-alternative printer
672 instance Outputable IfaceIdDetails where
673 ppr IfVanillaId = empty
674 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
675 <+> if b then ptext (sLit "<naughty>") else empty
676 ppr IfDFunId = ptext (sLit "DFunId")
678 instance Outputable IfaceIdInfo where
680 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
682 instance Outputable IfaceInfoItem where
683 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
685 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
686 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
687 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
688 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
690 instance Outputable IfaceUnfolding where
691 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
692 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
693 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
694 pprParendIfaceExpr e]
695 ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr
696 <+> parens (ptext (sLit "arity") <+> int a)
697 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
698 <+> brackets (pprWithCommas pprParendIfaceExpr ns)
701 -- -----------------------------------------------------------------------------
702 -- Finding the Names in IfaceSyn
704 -- This is used for dependency analysis in MkIface, so that we
705 -- fingerprint a declaration before the things that depend on it. It
706 -- is specific to interface-file fingerprinting in the sense that we
707 -- don't collect *all* Names: for example, the DFun of an instance is
708 -- recorded textually rather than by its fingerprint when
709 -- fingerprinting the instance, so DFuns are not dependencies.
711 freeNamesIfDecl :: IfaceDecl -> NameSet
712 freeNamesIfDecl (IfaceId _s t d i) =
713 freeNamesIfType t &&&
714 freeNamesIfIdInfo i &&&
715 freeNamesIfIdDetails d
716 freeNamesIfDecl IfaceForeign{} =
718 freeNamesIfDecl d@IfaceData{} =
719 freeNamesIfTvBndrs (ifTyVars d) &&&
720 freeNamesIfTcFam (ifFamInst d) &&&
721 freeNamesIfContext (ifCtxt d) &&&
722 freeNamesIfConDecls (ifCons d)
723 freeNamesIfDecl d@IfaceSyn{} =
724 freeNamesIfTvBndrs (ifTyVars d) &&&
725 freeNamesIfSynRhs (ifSynRhs d) &&&
726 freeNamesIfTcFam (ifFamInst d)
727 freeNamesIfDecl d@IfaceClass{} =
728 freeNamesIfTvBndrs (ifTyVars d) &&&
729 freeNamesIfContext (ifCtxt d) &&&
730 freeNamesIfDecls (ifATs d) &&&
731 fnList freeNamesIfClsSig (ifSigs d)
733 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
734 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
735 freeNamesIfIdDetails _ = emptyNameSet
737 -- All other changes are handled via the version info on the tycon
738 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
739 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
740 freeNamesIfSynRhs Nothing = emptyNameSet
742 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
743 freeNamesIfTcFam (Just (tc,tys)) =
744 freeNamesIfTc tc &&& fnList freeNamesIfType tys
745 freeNamesIfTcFam Nothing =
748 freeNamesIfContext :: IfaceContext -> NameSet
749 freeNamesIfContext = fnList freeNamesIfPredType
751 freeNamesIfDecls :: [IfaceDecl] -> NameSet
752 freeNamesIfDecls = fnList freeNamesIfDecl
754 freeNamesIfClsSig :: IfaceClassOp -> NameSet
755 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
757 freeNamesIfConDecls :: IfaceConDecls -> NameSet
758 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
759 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
760 freeNamesIfConDecls _ = emptyNameSet
762 freeNamesIfConDecl :: IfaceConDecl -> NameSet
763 freeNamesIfConDecl c =
764 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
765 freeNamesIfTvBndrs (ifConExTvs c) &&&
766 freeNamesIfContext (ifConCtxt c) &&&
767 fnList freeNamesIfType (ifConArgTys c) &&&
768 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
770 freeNamesIfPredType :: IfacePredType -> NameSet
771 freeNamesIfPredType (IfaceClassP cl tys) =
772 unitNameSet cl &&& fnList freeNamesIfType tys
773 freeNamesIfPredType (IfaceIParam _n ty) =
775 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
776 freeNamesIfType ty1 &&& freeNamesIfType ty2
778 freeNamesIfType :: IfaceType -> NameSet
779 freeNamesIfType (IfaceTyVar _) = emptyNameSet
780 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
781 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
782 freeNamesIfType (IfaceTyConApp tc ts) =
783 freeNamesIfTc tc &&& fnList freeNamesIfType ts
784 freeNamesIfType (IfaceForAllTy tv t) =
785 freeNamesIfTvBndr tv &&& freeNamesIfType t
786 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
788 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
789 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
791 freeNamesIfBndr :: IfaceBndr -> NameSet
792 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
793 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
795 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
796 -- Remember IfaceLetBndr is used only for *nested* bindings
797 -- The cut-down IdInfo never contains any Names, but the type may!
798 freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
800 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
801 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
802 -- kinds can have Names inside, when the Kind is an equality predicate
804 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
805 freeNamesIfIdBndr = freeNamesIfTvBndr
807 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
808 freeNamesIfIdInfo NoInfo = emptyNameSet
809 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
811 freeNamesItem :: IfaceInfoItem -> NameSet
812 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
813 freeNamesItem _ = emptyNameSet
815 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
816 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
817 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
818 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
819 freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
820 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
822 freeNamesIfExpr :: IfaceExpr -> NameSet
823 freeNamesIfExpr (IfaceExt v) = unitNameSet v
824 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
825 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
826 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
827 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
828 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
829 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
830 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
832 freeNamesIfExpr (IfaceCase s _ ty alts)
834 &&& fnList fn_alt alts &&& fn_cons alts
835 &&& freeNamesIfType ty
837 fn_alt (_con,_bs,r) = freeNamesIfExpr r
839 -- Depend on the data constructors. Just one will do!
840 -- Note [Tracking data constructors]
841 fn_cons [] = emptyNameSet
842 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
843 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
844 fn_cons (_ : _ ) = emptyNameSet
846 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
847 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
849 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
850 = fnList fn_pair as &&& freeNamesIfExpr x
852 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
854 freeNamesIfExpr _ = emptyNameSet
857 freeNamesIfTc :: IfaceTyCon -> NameSet
858 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
859 -- ToDo: shouldn't we include IfaceIntTc & co.?
860 freeNamesIfTc _ = emptyNameSet
862 freeNamesIfRule :: IfaceRule -> NameSet
863 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
865 fnList freeNamesIfBndr bs &&&
866 fnList freeNamesIfExpr es &&&
870 (&&&) :: NameSet -> NameSet -> NameSet
871 (&&&) = unionNameSets
873 fnList :: (a -> NameSet) -> [a] -> NameSet
874 fnList f = foldr (&&&) emptyNameSet . map f
877 Note [Tracking data constructors]
878 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
880 case e of { C a -> ...; ... }
881 You might think that we don't need to include the datacon C
882 in the free names, because its type will probably show up in
883 the free names of 'e'. But in rare circumstances this may
884 not happen. Here's the one that bit me:
886 module DynFlags where
887 import {-# SOURCE #-} Packages( PackageState )
888 data DynFlags = DF ... PackageState ...
890 module Packages where
892 data PackageState = PS ...
893 lookupModule (df :: DynFlags)
895 DF ...p... -> case p of
898 Now, lookupModule depends on DynFlags, but the transitive dependency
899 on the *locally-defined* type PackageState is not visible. We need
900 to take account of the use of the data constructor PS in the pattern match.