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"
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 with the class recursive?
105 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
107 ifExtName :: Maybe FastString }
109 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
110 -- Nothing => no default method
111 -- Just False => ordinary polymorphic default method
112 -- Just True => generic default method
115 = IfAbstractTyCon -- No info
116 | IfOpenDataTyCon -- Open data family
117 | IfDataTyCon [IfaceConDecl] -- data type decls
118 | IfNewTyCon IfaceConDecl -- newtype decls
120 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
121 visibleIfConDecls IfAbstractTyCon = []
122 visibleIfConDecls IfOpenDataTyCon = []
123 visibleIfConDecls (IfDataTyCon cs) = cs
124 visibleIfConDecls (IfNewTyCon c) = [c]
128 ifConOcc :: OccName, -- Constructor name
129 ifConWrapper :: Bool, -- True <=> has a wrapper
130 ifConInfix :: Bool, -- True <=> declared infix
131 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
132 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
133 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
134 ifConCtxt :: IfaceContext, -- Non-stupid context
135 ifConArgTys :: [IfaceType], -- Arg types
136 ifConFields :: [OccName], -- ...ditto... (field labels)
137 ifConStricts :: [HsBang]} -- Empty (meaning all lazy),
138 -- or 1-1 corresp with arg tys
141 = IfaceInst { ifInstCls :: IfExtName, -- See comments with
142 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
143 ifDFun :: IfExtName, -- The dfun
144 ifOFlag :: OverlapFlag, -- Overlap flag
145 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
146 -- There's always a separate IfaceDecl for the DFun, which gives
147 -- its IdInfo with its full type and version number.
148 -- The instance declarations taken together have a version number,
149 -- and we don't want that to wobble gratuitously
150 -- If this instance decl is *used*, we'll record a usage on the dfun;
151 -- and if the head does not change it won't be used if it wasn't before
154 = IfaceFamInst { ifFamInstFam :: IfExtName -- Family tycon
155 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
156 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
161 ifRuleName :: RuleName,
162 ifActivation :: Activation,
163 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
164 ifRuleHead :: IfExtName, -- Head of lhs
165 ifRuleArgs :: [IfaceExpr], -- Args of LHS
166 ifRuleRhs :: IfaceExpr,
168 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
173 ifAnnotatedTarget :: IfaceAnnTarget,
174 ifAnnotatedValue :: Serialized
177 type IfaceAnnTarget = AnnTarget OccName
179 -- We only serialise the IdDetails of top-level Ids, and even then
180 -- we only need a very limited selection. Notably, none of the
181 -- implicit ones are needed here, becuase they are not put it
186 | IfRecSelId IfaceTyCon Bool
187 | IfDFunId Int -- Number of silent args
190 = NoInfo -- When writing interface file without -O
191 | HasInfo [IfaceInfoItem] -- Has info, and here it is
193 -- Here's a tricky case:
194 -- * Compile with -O module A, and B which imports A.f
195 -- * Change function f in A, and recompile without -O
196 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
197 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
198 -- but we do not do that now. Instead it's discarded when the
199 -- ModIface is read into the various decl pools.)
200 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
201 -- and so gives a new version.
205 | HsStrictness StrictSig
206 | HsInline InlinePragma
207 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
208 IfaceUnfolding -- See Note [Expose recursive functions]
211 -- NB: Specialisations and rules come in separately and are
212 -- only later attached to the Id. Partial reason: some are orphans.
215 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
216 -- Possibly could eliminate the Bool here, the information
217 -- is also in the InlinePragma.
219 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
221 | IfInlineRule Arity -- INLINE pragmas
222 Bool -- OK to inline even if *un*-saturated
223 Bool -- OK to inline even if context is boring
226 | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName)
227 | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
230 | IfDFunUnfold [DFunArg IfaceExpr]
232 --------------------------------
236 | IfaceType IfaceType
237 | IfaceCo IfaceType -- We re-use IfaceType for coercions
238 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
239 | IfaceLam IfaceBndr IfaceExpr
240 | IfaceApp IfaceExpr IfaceExpr
241 | IfaceCase IfaceExpr IfLclName [IfaceAlt]
242 | IfaceLet IfaceBinding IfaceExpr
243 | IfaceNote IfaceNote IfaceExpr
244 | IfaceCast IfaceExpr IfaceCoercion
246 | IfaceFCall ForeignCall IfaceType
247 | IfaceTick Module Int
249 data IfaceNote = IfaceSCC CostCentre
250 | IfaceCoreNote String
252 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
253 -- Note: IfLclName, not IfaceBndr (and same with the case binder)
254 -- We reconstruct the kind/type of the thing from the context
255 -- thus saving bulk in interface files
257 data IfaceConAlt = IfaceDefault
258 | IfaceDataAlt IfExtName
259 | IfaceTupleAlt Boxity
260 | IfaceLitAlt Literal
263 = IfaceNonRec IfaceLetBndr IfaceExpr
264 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
266 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
267 -- It's used for *non-top-level* let/rec binders
268 -- See Note [IdInfo on nested let-bindings]
269 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
272 Note [Expose recursive functions]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
274 For supercompilation we want to put *all* unfoldings in the interface
275 file, even for functions that are recursive (or big). So we need to
276 know when an unfolding belongs to a loop-breaker so that we can refrain
277 from inlining it (except during supercompilation).
279 Note [IdInfo on nested let-bindings]
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281 Occasionally we want to preserve IdInfo on nested let bindings. The one
282 that came up was a NOINLINE pragma on a let-binding inside an INLINE
283 function. The user (Duncan Coutts) really wanted the NOINLINE control
284 to cross the separate compilation boundary.
286 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
287 that is what is seen by importing module with --make
289 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
290 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
291 If a module contains any "orphans", then its interface file is read
292 regardless, so that its instances are not missed.
294 Roughly speaking, an instance is an orphan if its head (after the =>)
295 mentions nothing defined in this module. Functional dependencies
296 complicate the situation though. Consider
298 module M where { class C a b | a -> b }
300 and suppose we are compiling module X:
305 instance C Int T where ...
307 This instance is an orphan, because when compiling a third module Y we
308 might get a constraint (C Int v), and we'd want to improve v to T. So
309 we must make sure X's instances are loaded, even if we do not directly
312 More precisely, an instance is an orphan iff
314 If there are no fundeps, then at least of the names in
315 the instance head is locally defined.
317 If there are fundeps, then for every fundep, at least one of the
318 names free in a *non-determined* part of the instance head is
319 defined in this module.
321 (Note that these conditions hold trivially if the class is locally
324 Note [Versioning of instances]
325 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
326 Now consider versioning. If we *use* an instance decl in one compilation,
327 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
328 But suppose we *don't* (currently) use an instance! We must recompile if
329 the instance is changed in such a way that it becomes important. (This would
330 only matter with overlapping instances, else the importing module wouldn't have
331 compiled before and the recompilation check is irrelevant.)
333 The is_orph field is set to (Just n) if the instance is not an orphan.
334 The 'n' is *any* of the locally-defined names mentioned anywhere in the
335 instance head. This name is used for versioning; the instance decl is
336 considered part of the defn of this 'n'.
338 I'm worried about whether this works right if we pick a name from
339 a functionally-dependent part of the instance decl. E.g.
341 module M where { class C a b | a -> b }
343 and suppose we are compiling module X:
349 instance C S T where ...
351 If we base the instance verion on T, I'm worried that changing S to S'
352 would change T's version, but not S or S'. But an importing module might
353 not depend on T, and so might not be recompiled even though the new instance
354 (C S' T) might be relevant. I have not been able to make a concrete example,
355 and it seems deeply obscure, so I'm going to leave it for now.
358 Note [Versioning of rules]
359 ~~~~~~~~~~~~~~~~~~~~~~~~~~
360 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
361 n appears on the LHS of the rule; any change in the rule changes the version of n.
365 -- -----------------------------------------------------------------------------
368 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
369 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
370 -- Deeply revolting, because it has to predict what gets bound,
371 -- especially the question of whether there's a wrapper for a datacon
373 -- N.B. the set of names returned here *must* match the set of
374 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
375 -- TyThing.getOccName should define a bijection between the two lists.
376 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
377 -- The order of the list does not matter.
378 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
381 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
382 ifCons = IfNewTyCon (
383 IfCon { ifConOcc = con_occ }),
384 ifFamInst = famInst})
385 = -- implicit coerion and (possibly) family instance coercion
386 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
387 -- data constructor and worker (newtypes don't have a wrapper)
388 [con_occ, mkDataConWorkerOcc con_occ]
391 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
392 ifCons = IfDataTyCon cons,
393 ifFamInst = famInst})
394 = -- (possibly) family instance coercion;
395 -- there is no implicit coercion for non-newtypes
396 famInstCo famInst tc_occ
397 -- for each data constructor in order,
398 -- data constructor, worker, and (possibly) wrapper
399 ++ concatMap dc_occs cons
402 | has_wrapper = [con_occ, work_occ, wrap_occ]
403 | otherwise = [con_occ, work_occ]
405 con_occ = ifConOcc con_decl -- DataCon namespace
406 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
407 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
408 has_wrapper = ifConWrapper con_decl -- This is the reason for
409 -- having the ifConWrapper field!
411 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
412 ifSigs = sigs, ifATs = ats })
413 = -- dictionary datatype:
416 -- (possibly) newtype coercion
418 -- data constructor (DataCon namespace)
419 -- data worker (Id namespace)
420 -- no wrapper (class dictionaries never have a wrapper)
421 [dc_occ, dcww_occ] ++
423 [ifName at | at <- ats ] ++
424 -- superclass selectors
425 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
426 -- operation selectors
427 [op | IfaceClassOp op _ _ <- sigs]
429 n_ctxt = length sc_ctxt
431 tc_occ = mkClassTyConOcc cls_occ
432 dc_occ = mkClassDataConOcc cls_occ
433 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
435 dcww_occ = mkDataConWorkerOcc dc_occ
436 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
438 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
439 ifFamInst = famInst})
440 = famInstCo famInst tc_occ
442 ifaceDeclSubBndrs _ = []
444 -- coercion for data/newtype family instances
445 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
446 famInstCo Nothing _ = []
447 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
449 ----------------------------- Printing IfaceDecl ------------------------------
451 instance Outputable IfaceDecl where
454 pprIfaceDecl :: IfaceDecl -> SDoc
455 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
456 ifIdDetails = details, ifIdInfo = info})
457 = sep [ ppr var <+> dcolon <+> ppr ty,
458 nest 2 (ppr details),
461 pprIfaceDecl (IfaceForeign {ifName = tycon})
462 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
464 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
465 ifSynRhs = Just mono_ty,
466 ifFamInst = mbFamInst})
467 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
468 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
470 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
471 ifSynRhs = Nothing, ifSynKind = kind })
472 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
473 4 (dcolon <+> ppr kind)
475 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
476 ifTyVars = tyvars, ifCons = condecls,
477 ifRec = isrec, ifFamInst = mbFamInst})
478 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
479 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
480 pprFamily mbFamInst])
482 pp_nd = case condecls of
483 IfAbstractTyCon -> ptext (sLit "data")
484 IfOpenDataTyCon -> ptext (sLit "data family")
485 IfDataTyCon _ -> ptext (sLit "data")
486 IfNewTyCon _ -> ptext (sLit "newtype")
488 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
489 ifFDs = fds, ifATs = ats, ifSigs = sigs,
491 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
492 4 (vcat [pprRec isrec,
496 pprRec :: RecFlag -> SDoc
497 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
499 pprGen :: Bool -> SDoc
500 pprGen True = ptext (sLit "Generics: yes")
501 pprGen False = ptext (sLit "Generics: no")
503 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
504 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
505 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
507 instance Outputable IfaceClassOp where
508 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
510 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
511 pprIfaceDeclHead context thing tyvars
512 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
513 pprIfaceTvBndrs tyvars]
515 pp_condecls :: OccName -> IfaceConDecls -> SDoc
516 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
517 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
518 pp_condecls _ IfOpenDataTyCon = empty
519 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
520 (map (pprIfaceConDecl tc) cs))
522 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
524 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
525 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
526 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
527 ifConStricts = strs, ifConFields = fields })
529 if is_infix then ptext (sLit "Infix") else empty,
530 if has_wrap then ptext (sLit "HasWrapper") else empty,
531 ppUnless (null strs) $
532 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
533 ppUnless (null fields) $
534 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
536 ppr_bang HsNoBang = char '_' -- Want to see these
537 ppr_bang bang = ppr bang
539 main_payload = ppr name <+> dcolon <+>
540 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
542 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
543 | (tv,ty) <- eq_spec]
545 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
546 -- because we don't have a Name for the tycon, only an OccName
547 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
548 (t:ts) -> fsep (t : map (arrow <+>) ts)
549 [] -> panic "pp_con_taus"
551 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
553 instance Outputable IfaceRule where
554 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
555 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
556 = sep [hsep [doubleQuotes (ftext name), ppr act,
557 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
558 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
559 ptext (sLit "=") <+> ppr rhs])
562 instance Outputable IfaceInst where
563 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
564 ifInstCls = cls, ifInstTys = mb_tcs})
565 = hang (ptext (sLit "instance") <+> ppr flag
566 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
567 2 (equals <+> ppr dfun_id)
569 instance Outputable IfaceFamInst where
570 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
571 ifFamInstTyCon = tycon_id})
572 = hang (ptext (sLit "family instance") <+>
573 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
574 2 (equals <+> ppr tycon_id)
576 ppr_rough :: Maybe IfaceTyCon -> SDoc
577 ppr_rough Nothing = dot
578 ppr_rough (Just tc) = ppr tc
582 ----------------------------- Printing IfaceExpr ------------------------------------
585 instance Outputable IfaceExpr where
586 ppr e = pprIfaceExpr noParens e
588 pprParendIfaceExpr :: IfaceExpr -> SDoc
589 pprParendIfaceExpr = pprIfaceExpr parens
591 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
592 -- The function adds parens in context that need
593 -- an atomic value (e.g. function args)
595 pprIfaceExpr _ (IfaceLcl v) = ppr v
596 pprIfaceExpr _ (IfaceExt v) = ppr v
597 pprIfaceExpr _ (IfaceLit l) = ppr l
598 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
599 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
600 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
601 pprIfaceExpr _ (IfaceCo co) = text "@~" <+> pprParendIfaceType co
603 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
604 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
606 pprIfaceExpr add_par e@(IfaceLam _ _)
607 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
608 pprIfaceExpr noParens body])
610 (bndrs,body) = collect [] e
611 collect bs (IfaceLam b e) = collect (b:bs) e
612 collect bs e = (reverse bs, e)
614 pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
615 = add_par (sep [ptext (sLit "case")
616 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
617 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
618 pprIfaceExpr noParens rhs <+> char '}'])
620 pprIfaceExpr add_par (IfaceCase scrut bndr alts)
621 = add_par (sep [ptext (sLit "case")
622 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
623 <+> ppr bndr <+> char '{',
624 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
626 pprIfaceExpr _ (IfaceCast expr co)
627 = sep [pprParendIfaceExpr expr,
628 nest 2 (ptext (sLit "`cast`")),
629 pprParendIfaceType co]
631 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
632 = add_par (sep [ptext (sLit "let {"),
633 nest 2 (ppr_bind (b, rhs)),
635 pprIfaceExpr noParens body])
637 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
638 = add_par (sep [ptext (sLit "letrec {"),
639 nest 2 (sep (map ppr_bind pairs)),
641 pprIfaceExpr noParens body])
643 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
645 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
646 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
647 arrow <+> pprIfaceExpr noParens rhs]
649 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
650 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
651 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
653 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
654 ppr_bind (IfLetBndr b ty info, rhs)
655 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
656 equals <+> pprIfaceExpr noParens rhs]
659 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
660 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
661 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
664 instance Outputable IfaceNote where
665 ppr (IfaceSCC cc) = pprCostCentreCore cc
666 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
669 instance Outputable IfaceConAlt where
670 ppr IfaceDefault = text "DEFAULT"
671 ppr (IfaceLitAlt l) = ppr l
672 ppr (IfaceDataAlt d) = ppr d
673 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
674 -- IfaceTupleAlt is handled by the case-alternative printer
677 instance Outputable IfaceIdDetails where
678 ppr IfVanillaId = empty
679 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
680 <+> if b then ptext (sLit "<naughty>") else empty
681 ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns)
683 instance Outputable IfaceIdInfo where
685 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
687 instance Outputable IfaceInfoItem where
688 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
690 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
691 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
692 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
693 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
695 instance Outputable IfaceUnfolding where
696 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
697 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
698 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
699 pprParendIfaceExpr e]
700 ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
701 <+> parens (ptext (sLit "arity") <+> int a)
702 ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
703 <+> parens (ptext (sLit "arity") <+> int a)
704 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
705 <+> brackets (pprWithCommas ppr ns)
707 -- -----------------------------------------------------------------------------
708 -- Finding the Names in IfaceSyn
710 -- This is used for dependency analysis in MkIface, so that we
711 -- fingerprint a declaration before the things that depend on it. It
712 -- is specific to interface-file fingerprinting in the sense that we
713 -- don't collect *all* Names: for example, the DFun of an instance is
714 -- recorded textually rather than by its fingerprint when
715 -- fingerprinting the instance, so DFuns are not dependencies.
717 freeNamesIfDecl :: IfaceDecl -> NameSet
718 freeNamesIfDecl (IfaceId _s t d i) =
719 freeNamesIfType t &&&
720 freeNamesIfIdInfo i &&&
721 freeNamesIfIdDetails d
722 freeNamesIfDecl IfaceForeign{} =
724 freeNamesIfDecl d@IfaceData{} =
725 freeNamesIfTvBndrs (ifTyVars d) &&&
726 freeNamesIfTcFam (ifFamInst d) &&&
727 freeNamesIfContext (ifCtxt d) &&&
728 freeNamesIfConDecls (ifCons d)
729 freeNamesIfDecl d@IfaceSyn{} =
730 freeNamesIfTvBndrs (ifTyVars d) &&&
731 freeNamesIfSynRhs (ifSynRhs d) &&&
732 freeNamesIfTcFam (ifFamInst d)
733 freeNamesIfDecl d@IfaceClass{} =
734 freeNamesIfTvBndrs (ifTyVars d) &&&
735 freeNamesIfContext (ifCtxt d) &&&
736 freeNamesIfDecls (ifATs d) &&&
737 fnList freeNamesIfClsSig (ifSigs d)
739 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
740 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
741 freeNamesIfIdDetails _ = emptyNameSet
743 -- All other changes are handled via the version info on the tycon
744 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
745 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
746 freeNamesIfSynRhs Nothing = emptyNameSet
748 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
749 freeNamesIfTcFam (Just (tc,tys)) =
750 freeNamesIfTc tc &&& fnList freeNamesIfType tys
751 freeNamesIfTcFam Nothing =
754 freeNamesIfContext :: IfaceContext -> NameSet
755 freeNamesIfContext = fnList freeNamesIfPredType
757 freeNamesIfDecls :: [IfaceDecl] -> NameSet
758 freeNamesIfDecls = fnList freeNamesIfDecl
760 freeNamesIfClsSig :: IfaceClassOp -> NameSet
761 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
763 freeNamesIfConDecls :: IfaceConDecls -> NameSet
764 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
765 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
766 freeNamesIfConDecls _ = emptyNameSet
768 freeNamesIfConDecl :: IfaceConDecl -> NameSet
769 freeNamesIfConDecl c =
770 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
771 freeNamesIfTvBndrs (ifConExTvs c) &&&
772 freeNamesIfContext (ifConCtxt c) &&&
773 fnList freeNamesIfType (ifConArgTys c) &&&
774 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
776 freeNamesIfPredType :: IfacePredType -> NameSet
777 freeNamesIfPredType (IfaceClassP cl tys) =
778 unitNameSet cl &&& fnList freeNamesIfType tys
779 freeNamesIfPredType (IfaceIParam _n ty) =
781 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
782 freeNamesIfType ty1 &&& freeNamesIfType ty2
784 freeNamesIfType :: IfaceType -> NameSet
785 freeNamesIfType (IfaceTyVar _) = emptyNameSet
786 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
787 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
788 freeNamesIfType (IfaceTyConApp tc ts) =
789 freeNamesIfTc tc &&& fnList freeNamesIfType ts
790 freeNamesIfType (IfaceForAllTy tv t) =
791 freeNamesIfTvBndr tv &&& freeNamesIfType t
792 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
793 freeNamesIfType (IfaceCoConApp tc ts) =
794 freeNamesIfCo tc &&& fnList freeNamesIfType ts
796 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
797 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
799 freeNamesIfBndr :: IfaceBndr -> NameSet
800 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
801 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
803 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
804 -- Remember IfaceLetBndr is used only for *nested* bindings
805 -- The IdInfo can contain an unfolding (in the case of
806 -- local INLINE pragmas), so look there too
807 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
808 &&& freeNamesIfIdInfo info
810 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
811 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
812 -- kinds can have Names inside, when the Kind is an equality predicate
814 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
815 freeNamesIfIdBndr = freeNamesIfTvBndr
817 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
818 freeNamesIfIdInfo NoInfo = emptyNameSet
819 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
821 freeNamesItem :: IfaceInfoItem -> NameSet
822 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
823 freeNamesItem _ = emptyNameSet
825 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
826 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
827 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
828 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
829 freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
830 freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
831 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
833 freeNamesIfExpr :: IfaceExpr -> NameSet
834 freeNamesIfExpr (IfaceExt v) = unitNameSet v
835 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
836 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
837 freeNamesIfExpr (IfaceCo co) = freeNamesIfType co
838 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
839 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
840 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
841 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
842 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
844 freeNamesIfExpr (IfaceCase s _ alts)
846 &&& fnList fn_alt alts &&& fn_cons alts
848 fn_alt (_con,_bs,r) = freeNamesIfExpr r
850 -- Depend on the data constructors. Just one will do!
851 -- Note [Tracking data constructors]
852 fn_cons [] = emptyNameSet
853 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
854 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
855 fn_cons (_ : _ ) = emptyNameSet
857 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
858 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
860 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
861 = fnList fn_pair as &&& freeNamesIfExpr x
863 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
865 freeNamesIfExpr _ = emptyNameSet
867 freeNamesIfTc :: IfaceTyCon -> NameSet
868 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
869 -- ToDo: shouldn't we include IfaceIntTc & co.?
870 freeNamesIfTc _ = emptyNameSet
872 freeNamesIfCo :: IfaceCoCon -> NameSet
873 freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
874 freeNamesIfCo _ = emptyNameSet
876 freeNamesIfRule :: IfaceRule -> NameSet
877 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
878 , ifRuleArgs = es, ifRuleRhs = rhs })
880 fnList freeNamesIfBndr bs &&&
881 fnList freeNamesIfExpr es &&&
885 (&&&) :: NameSet -> NameSet -> NameSet
886 (&&&) = unionNameSets
888 fnList :: (a -> NameSet) -> [a] -> NameSet
889 fnList f = foldr (&&&) emptyNameSet . map f
892 Note [Tracking data constructors]
893 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
895 case e of { C a -> ...; ... }
896 You might think that we don't need to include the datacon C
897 in the free names, because its type will probably show up in
898 the free names of 'e'. But in rare circumstances this may
899 not happen. Here's the one that bit me:
901 module DynFlags where
902 import {-# SOURCE #-} Packages( PackageState )
903 data DynFlags = DF ... PackageState ...
905 module Packages where
907 data PackageState = PS ...
908 lookupModule (df :: DynFlags)
910 DF ...p... -> case p of
913 Now, lookupModule depends on DynFlags, but the transitive dependency
914 on the *locally-defined* type PackageState is not visible. We need
915 to take account of the use of the data constructor PS in the pattern match.