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 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
71 -- Just <=> instance of family
73 -- ifCons /= IfOpenDataTyCon
74 -- for family instances
77 | IfaceSyn { ifName :: OccName, -- Type constructor
78 ifTyVars :: [IfaceTvBndr], -- Type variables
79 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
80 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
81 -- Nothing for an open family
82 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
83 -- Just <=> instance of family
84 -- Invariant: ifOpenSyn == False
85 -- for family instances
88 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
89 ifName :: OccName, -- Name of the class
90 ifTyVars :: [IfaceTvBndr], -- Type variables
91 ifFDs :: [FunDep FastString], -- Functional dependencies
92 ifATs :: [IfaceDecl], -- Associated type families
93 ifSigs :: [IfaceClassOp], -- Method signatures
94 ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
97 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
99 ifExtName :: Maybe FastString }
101 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
102 -- Nothing => no default method
103 -- Just False => ordinary polymorphic default method
104 -- Just True => generic default method
107 = IfAbstractTyCon -- No info
108 | IfOpenDataTyCon -- Open data family
109 | IfDataTyCon [IfaceConDecl] -- data type decls
110 | IfNewTyCon IfaceConDecl -- newtype decls
112 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
113 visibleIfConDecls IfAbstractTyCon = []
114 visibleIfConDecls IfOpenDataTyCon = []
115 visibleIfConDecls (IfDataTyCon cs) = cs
116 visibleIfConDecls (IfNewTyCon c) = [c]
120 ifConOcc :: OccName, -- Constructor name
121 ifConWrapper :: Bool, -- True <=> has a wrapper
122 ifConInfix :: Bool, -- True <=> declared infix
123 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
124 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
125 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
126 ifConCtxt :: IfaceContext, -- Non-stupid context
127 ifConArgTys :: [IfaceType], -- Arg types
128 ifConFields :: [OccName], -- ...ditto... (field labels)
129 ifConStricts :: [HsBang]} -- Empty (meaning all lazy),
130 -- or 1-1 corresp with arg tys
133 = IfaceInst { ifInstCls :: IfExtName, -- See comments with
134 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
135 ifDFun :: IfExtName, -- The dfun
136 ifOFlag :: OverlapFlag, -- Overlap flag
137 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
138 -- There's always a separate IfaceDecl for the DFun, which gives
139 -- its IdInfo with its full type and version number.
140 -- The instance declarations taken together have a version number,
141 -- and we don't want that to wobble gratuitously
142 -- If this instance decl is *used*, we'll record a usage on the dfun;
143 -- and if the head does not change it won't be used if it wasn't before
146 = IfaceFamInst { ifFamInstFam :: IfExtName -- Family tycon
147 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
148 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
153 ifRuleName :: RuleName,
154 ifActivation :: Activation,
155 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
156 ifRuleHead :: IfExtName, -- Head of lhs
157 ifRuleArgs :: [IfaceExpr], -- Args of LHS
158 ifRuleRhs :: IfaceExpr,
160 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
165 ifAnnotatedTarget :: IfaceAnnTarget,
166 ifAnnotatedValue :: Serialized
169 type IfaceAnnTarget = AnnTarget OccName
171 -- We only serialise the IdDetails of top-level Ids, and even then
172 -- we only need a very limited selection. Notably, none of the
173 -- implicit ones are needed here, becuase they are not put it
178 | IfRecSelId IfaceTyCon Bool
179 | IfDFunId Int -- Number of silent args
182 = NoInfo -- When writing interface file without -O
183 | HasInfo [IfaceInfoItem] -- Has info, and here it is
185 -- Here's a tricky case:
186 -- * Compile with -O module A, and B which imports A.f
187 -- * Change function f in A, and recompile without -O
188 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
189 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
190 -- but we do not do that now. Instead it's discarded when the
191 -- ModIface is read into the various decl pools.)
192 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
193 -- and so gives a new version.
197 | HsStrictness StrictSig
198 | HsInline InlinePragma
199 | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
200 IfaceUnfolding -- See Note [Expose recursive functions]
203 -- NB: Specialisations and rules come in separately and are
204 -- only later attached to the Id. Partial reason: some are orphans.
207 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
208 -- Possibly could eliminate the Bool here, the information
209 -- is also in the InlinePragma.
211 | IfCompulsory IfaceExpr -- Only used for default methods, in fact
213 | IfInlineRule Arity -- INLINE pragmas
214 Bool -- OK to inline even if *un*-saturated
215 Bool -- OK to inline even if context is boring
218 | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName)
219 | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
222 | IfDFunUnfold [DFunArg IfaceExpr]
224 --------------------------------
228 | IfaceType IfaceType
229 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
230 | IfaceLam IfaceBndr IfaceExpr
231 | IfaceApp IfaceExpr IfaceExpr
232 | IfaceCase IfaceExpr IfLclName IfaceType [IfaceAlt]
233 | IfaceLet IfaceBinding IfaceExpr
234 | IfaceNote IfaceNote IfaceExpr
235 | IfaceCast IfaceExpr IfaceCoercion
237 | IfaceFCall ForeignCall IfaceType
238 | IfaceTick Module Int
240 data IfaceNote = IfaceSCC CostCentre
241 | IfaceCoreNote String
243 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
244 -- Note: IfLclName, not IfaceBndr (and same with the case binder)
245 -- We reconstruct the kind/type of the thing from the context
246 -- thus saving bulk in interface files
248 data IfaceConAlt = IfaceDefault
249 | IfaceDataAlt IfExtName
250 | IfaceTupleAlt Boxity
251 | IfaceLitAlt Literal
254 = IfaceNonRec IfaceLetBndr IfaceExpr
255 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
257 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
258 -- It's used for *non-top-level* let/rec binders
259 -- See Note [IdInfo on nested let-bindings]
260 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
263 Note [Expose recursive functions]
264 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
265 For supercompilation we want to put *all* unfoldings in the interface
266 file, even for functions that are recursive (or big). So we need to
267 know when an unfolding belongs to a loop-breaker so that we can refrain
268 from inlining it (except during supercompilation).
270 Note [IdInfo on nested let-bindings]
271 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
272 Occasionally we want to preserve IdInfo on nested let bindings. The one
273 that came up was a NOINLINE pragma on a let-binding inside an INLINE
274 function. The user (Duncan Coutts) really wanted the NOINLINE control
275 to cross the separate compilation boundary.
277 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
278 that is what is seen by importing module with --make
280 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
281 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
282 If a module contains any "orphans", then its interface file is read
283 regardless, so that its instances are not missed.
285 Roughly speaking, an instance is an orphan if its head (after the =>)
286 mentions nothing defined in this module. Functional dependencies
287 complicate the situation though. Consider
289 module M where { class C a b | a -> b }
291 and suppose we are compiling module X:
296 instance C Int T where ...
298 This instance is an orphan, because when compiling a third module Y we
299 might get a constraint (C Int v), and we'd want to improve v to T. So
300 we must make sure X's instances are loaded, even if we do not directly
303 More precisely, an instance is an orphan iff
305 If there are no fundeps, then at least of the names in
306 the instance head is locally defined.
308 If there are fundeps, then for every fundep, at least one of the
309 names free in a *non-determined* part of the instance head is
310 defined in this module.
312 (Note that these conditions hold trivially if the class is locally
315 Note [Versioning of instances]
316 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
317 Now consider versioning. If we *use* an instance decl in one compilation,
318 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
319 But suppose we *don't* (currently) use an instance! We must recompile if
320 the instance is changed in such a way that it becomes important. (This would
321 only matter with overlapping instances, else the importing module wouldn't have
322 compiled before and the recompilation check is irrelevant.)
324 The is_orph field is set to (Just n) if the instance is not an orphan.
325 The 'n' is *any* of the locally-defined names mentioned anywhere in the
326 instance head. This name is used for versioning; the instance decl is
327 considered part of the defn of this 'n'.
329 I'm worried about whether this works right if we pick a name from
330 a functionally-dependent part of the instance decl. E.g.
332 module M where { class C a b | a -> b }
334 and suppose we are compiling module X:
340 instance C S T where ...
342 If we base the instance verion on T, I'm worried that changing S to S'
343 would change T's version, but not S or S'. But an importing module might
344 not depend on T, and so might not be recompiled even though the new instance
345 (C S' T) might be relevant. I have not been able to make a concrete example,
346 and it seems deeply obscure, so I'm going to leave it for now.
349 Note [Versioning of rules]
350 ~~~~~~~~~~~~~~~~~~~~~~~~~~
351 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
352 n appears on the LHS of the rule; any change in the rule changes the version of n.
356 -- -----------------------------------------------------------------------------
359 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
360 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
361 -- Deeply revolting, because it has to predict what gets bound,
362 -- especially the question of whether there's a wrapper for a datacon
364 -- N.B. the set of names returned here *must* match the set of
365 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
366 -- TyThing.getOccName should define a bijection between the two lists.
367 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
368 -- The order of the list does not matter.
369 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
372 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
373 ifCons = IfNewTyCon (
374 IfCon { ifConOcc = con_occ }),
375 ifFamInst = famInst})
376 = -- implicit coerion and (possibly) family instance coercion
377 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
378 -- data constructor and worker (newtypes don't have a wrapper)
379 [con_occ, mkDataConWorkerOcc con_occ]
382 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
383 ifCons = IfDataTyCon cons,
384 ifFamInst = famInst})
385 = -- (possibly) family instance coercion;
386 -- there is no implicit coercion for non-newtypes
387 famInstCo famInst tc_occ
388 -- for each data constructor in order,
389 -- data constructor, worker, and (possibly) wrapper
390 ++ concatMap dc_occs cons
393 | has_wrapper = [con_occ, work_occ, wrap_occ]
394 | otherwise = [con_occ, work_occ]
396 con_occ = ifConOcc con_decl -- DataCon namespace
397 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
398 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
399 has_wrapper = ifConWrapper con_decl -- This is the reason for
400 -- having the ifConWrapper field!
402 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
403 ifSigs = sigs, ifATs = ats })
404 = -- dictionary datatype:
407 -- (possibly) newtype coercion
409 -- data constructor (DataCon namespace)
410 -- data worker (Id namespace)
411 -- no wrapper (class dictionaries never have a wrapper)
412 [dc_occ, dcww_occ] ++
414 [ifName at | at <- ats ] ++
415 -- superclass selectors
416 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
417 -- operation selectors
418 [op | IfaceClassOp op _ _ <- sigs]
420 n_ctxt = length sc_ctxt
422 tc_occ = mkClassTyConOcc cls_occ
423 dc_occ = mkClassDataConOcc cls_occ
424 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
426 dcww_occ = mkDataConWorkerOcc dc_occ
427 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
429 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
430 ifFamInst = famInst})
431 = famInstCo famInst tc_occ
433 ifaceDeclSubBndrs _ = []
435 -- coercion for data/newtype family instances
436 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
437 famInstCo Nothing _ = []
438 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
440 ----------------------------- Printing IfaceDecl ------------------------------
442 instance Outputable IfaceDecl where
445 pprIfaceDecl :: IfaceDecl -> SDoc
446 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
447 ifIdDetails = details, ifIdInfo = info})
448 = sep [ ppr var <+> dcolon <+> ppr ty,
449 nest 2 (ppr details),
452 pprIfaceDecl (IfaceForeign {ifName = tycon})
453 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
455 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
456 ifSynRhs = Just mono_ty,
457 ifFamInst = mbFamInst})
458 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
459 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
461 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
462 ifSynRhs = Nothing, ifSynKind = kind })
463 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
464 4 (dcolon <+> ppr kind)
466 pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
467 ifTyVars = tyvars, ifCons = condecls,
468 ifRec = isrec, ifFamInst = mbFamInst})
469 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
470 4 (vcat [pprRec isrec, pp_condecls tycon condecls,
471 pprFamily mbFamInst])
473 pp_nd = case condecls of
474 IfAbstractTyCon -> ptext (sLit "data")
475 IfOpenDataTyCon -> ptext (sLit "data family")
476 IfDataTyCon _ -> ptext (sLit "data")
477 IfNewTyCon _ -> ptext (sLit "newtype")
479 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
480 ifFDs = fds, ifATs = ats, ifSigs = sigs,
482 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
483 4 (vcat [pprRec isrec,
487 pprRec :: RecFlag -> SDoc
488 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
490 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
491 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
492 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
494 instance Outputable IfaceClassOp where
495 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
497 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
498 pprIfaceDeclHead context thing tyvars
499 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
500 pprIfaceTvBndrs tyvars]
502 pp_condecls :: OccName -> IfaceConDecls -> SDoc
503 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
504 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
505 pp_condecls _ IfOpenDataTyCon = empty
506 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
507 (map (pprIfaceConDecl tc) cs))
509 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
511 (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
512 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
513 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
514 ifConStricts = strs, ifConFields = fields })
516 if is_infix then ptext (sLit "Infix") else empty,
517 if has_wrap then ptext (sLit "HasWrapper") else empty,
518 ppUnless (null strs) $
519 nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
520 ppUnless (null fields) $
521 nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
523 ppr_bang HsNoBang = char '_' -- Want to see these
524 ppr_bang bang = ppr bang
526 main_payload = ppr name <+> dcolon <+>
527 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
529 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
530 | (tv,ty) <- eq_spec]
532 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
533 -- because we don't have a Name for the tycon, only an OccName
534 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
535 (t:ts) -> fsep (t : map (arrow <+>) ts)
536 [] -> panic "pp_con_taus"
538 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
540 instance Outputable IfaceRule where
541 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
542 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
543 = sep [hsep [doubleQuotes (ftext name), ppr act,
544 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
545 nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
546 ptext (sLit "=") <+> ppr rhs])
549 instance Outputable IfaceInst where
550 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
551 ifInstCls = cls, ifInstTys = mb_tcs})
552 = hang (ptext (sLit "instance") <+> ppr flag
553 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
554 2 (equals <+> ppr dfun_id)
556 instance Outputable IfaceFamInst where
557 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
558 ifFamInstTyCon = tycon_id})
559 = hang (ptext (sLit "family instance") <+>
560 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
561 2 (equals <+> ppr tycon_id)
563 ppr_rough :: Maybe IfaceTyCon -> SDoc
564 ppr_rough Nothing = dot
565 ppr_rough (Just tc) = ppr tc
569 ----------------------------- Printing IfaceExpr ------------------------------------
572 instance Outputable IfaceExpr where
573 ppr e = pprIfaceExpr noParens e
575 pprParendIfaceExpr :: IfaceExpr -> SDoc
576 pprParendIfaceExpr = pprIfaceExpr parens
578 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
579 -- The function adds parens in context that need
580 -- an atomic value (e.g. function args)
582 pprIfaceExpr _ (IfaceLcl v) = ppr v
583 pprIfaceExpr _ (IfaceExt v) = ppr v
584 pprIfaceExpr _ (IfaceLit l) = ppr l
585 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
586 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
587 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
589 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
590 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
592 pprIfaceExpr add_par e@(IfaceLam _ _)
593 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
594 pprIfaceExpr noParens body])
596 (bndrs,body) = collect [] e
597 collect bs (IfaceLam b e) = collect (b:bs) e
598 collect bs e = (reverse bs, e)
600 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
601 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
602 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
603 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
604 pprIfaceExpr noParens rhs <+> char '}'])
606 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
607 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
608 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
609 <+> ppr bndr <+> char '{',
610 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
612 pprIfaceExpr _ (IfaceCast expr co)
613 = sep [pprParendIfaceExpr expr,
614 nest 2 (ptext (sLit "`cast`")),
615 pprParendIfaceType co]
617 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
618 = add_par (sep [ptext (sLit "let {"),
619 nest 2 (ppr_bind (b, rhs)),
621 pprIfaceExpr noParens body])
623 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
624 = add_par (sep [ptext (sLit "letrec {"),
625 nest 2 (sep (map ppr_bind pairs)),
627 pprIfaceExpr noParens body])
629 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
631 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
632 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
633 arrow <+> pprIfaceExpr noParens rhs]
635 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
636 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
637 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
639 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
640 ppr_bind (IfLetBndr b ty info, rhs)
641 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
642 equals <+> pprIfaceExpr noParens rhs]
645 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
646 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
647 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
650 instance Outputable IfaceNote where
651 ppr (IfaceSCC cc) = pprCostCentreCore cc
652 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
655 instance Outputable IfaceConAlt where
656 ppr IfaceDefault = text "DEFAULT"
657 ppr (IfaceLitAlt l) = ppr l
658 ppr (IfaceDataAlt d) = ppr d
659 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
660 -- IfaceTupleAlt is handled by the case-alternative printer
663 instance Outputable IfaceIdDetails where
664 ppr IfVanillaId = empty
665 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
666 <+> if b then ptext (sLit "<naughty>") else empty
667 ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns)
669 instance Outputable IfaceIdInfo where
671 ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
673 instance Outputable IfaceInfoItem where
674 ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
676 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
677 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
678 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
679 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
681 instance Outputable IfaceUnfolding where
682 ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
683 ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
684 ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
685 pprParendIfaceExpr e]
686 ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
687 <+> parens (ptext (sLit "arity") <+> int a)
688 ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
689 <+> parens (ptext (sLit "arity") <+> int a)
690 ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
691 <+> brackets (pprWithCommas ppr ns)
693 -- -----------------------------------------------------------------------------
694 -- Finding the Names in IfaceSyn
696 -- This is used for dependency analysis in MkIface, so that we
697 -- fingerprint a declaration before the things that depend on it. It
698 -- is specific to interface-file fingerprinting in the sense that we
699 -- don't collect *all* Names: for example, the DFun of an instance is
700 -- recorded textually rather than by its fingerprint when
701 -- fingerprinting the instance, so DFuns are not dependencies.
703 freeNamesIfDecl :: IfaceDecl -> NameSet
704 freeNamesIfDecl (IfaceId _s t d i) =
705 freeNamesIfType t &&&
706 freeNamesIfIdInfo i &&&
707 freeNamesIfIdDetails d
708 freeNamesIfDecl IfaceForeign{} =
710 freeNamesIfDecl d@IfaceData{} =
711 freeNamesIfTvBndrs (ifTyVars d) &&&
712 freeNamesIfTcFam (ifFamInst d) &&&
713 freeNamesIfContext (ifCtxt d) &&&
714 freeNamesIfConDecls (ifCons d)
715 freeNamesIfDecl d@IfaceSyn{} =
716 freeNamesIfTvBndrs (ifTyVars d) &&&
717 freeNamesIfSynRhs (ifSynRhs d) &&&
718 freeNamesIfTcFam (ifFamInst d)
719 freeNamesIfDecl d@IfaceClass{} =
720 freeNamesIfTvBndrs (ifTyVars d) &&&
721 freeNamesIfContext (ifCtxt d) &&&
722 freeNamesIfDecls (ifATs d) &&&
723 fnList freeNamesIfClsSig (ifSigs d)
725 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
726 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
727 freeNamesIfIdDetails _ = emptyNameSet
729 -- All other changes are handled via the version info on the tycon
730 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
731 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
732 freeNamesIfSynRhs Nothing = emptyNameSet
734 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
735 freeNamesIfTcFam (Just (tc,tys)) =
736 freeNamesIfTc tc &&& fnList freeNamesIfType tys
737 freeNamesIfTcFam Nothing =
740 freeNamesIfContext :: IfaceContext -> NameSet
741 freeNamesIfContext = fnList freeNamesIfPredType
743 freeNamesIfDecls :: [IfaceDecl] -> NameSet
744 freeNamesIfDecls = fnList freeNamesIfDecl
746 freeNamesIfClsSig :: IfaceClassOp -> NameSet
747 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
749 freeNamesIfConDecls :: IfaceConDecls -> NameSet
750 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
751 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
752 freeNamesIfConDecls _ = emptyNameSet
754 freeNamesIfConDecl :: IfaceConDecl -> NameSet
755 freeNamesIfConDecl c =
756 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
757 freeNamesIfTvBndrs (ifConExTvs c) &&&
758 freeNamesIfContext (ifConCtxt c) &&&
759 fnList freeNamesIfType (ifConArgTys c) &&&
760 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
762 freeNamesIfPredType :: IfacePredType -> NameSet
763 freeNamesIfPredType (IfaceClassP cl tys) =
764 unitNameSet cl &&& fnList freeNamesIfType tys
765 freeNamesIfPredType (IfaceIParam _n ty) =
767 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
768 freeNamesIfType ty1 &&& freeNamesIfType ty2
770 freeNamesIfType :: IfaceType -> NameSet
771 freeNamesIfType (IfaceTyVar _) = emptyNameSet
772 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
773 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
774 freeNamesIfType (IfaceTyConApp tc ts) =
775 freeNamesIfTc tc &&& fnList freeNamesIfType ts
776 freeNamesIfType (IfaceForAllTy tv t) =
777 freeNamesIfTvBndr tv &&& freeNamesIfType t
778 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
780 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
781 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
783 freeNamesIfBndr :: IfaceBndr -> NameSet
784 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
785 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
787 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
788 -- Remember IfaceLetBndr is used only for *nested* bindings
789 -- The IdInfo can contain an unfolding (in the case of
790 -- local INLINE pragmas), so look there too
791 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
792 &&& freeNamesIfIdInfo info
794 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
795 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
796 -- kinds can have Names inside, when the Kind is an equality predicate
798 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
799 freeNamesIfIdBndr = freeNamesIfTvBndr
801 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
802 freeNamesIfIdInfo NoInfo = emptyNameSet
803 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
805 freeNamesItem :: IfaceInfoItem -> NameSet
806 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
807 freeNamesItem _ = emptyNameSet
809 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
810 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
811 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
812 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
813 freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
814 freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
815 freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
817 freeNamesIfExpr :: IfaceExpr -> NameSet
818 freeNamesIfExpr (IfaceExt v) = unitNameSet v
819 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
820 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
821 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
822 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
823 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
824 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
825 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
827 freeNamesIfExpr (IfaceCase s _ ty alts)
829 &&& fnList fn_alt alts &&& fn_cons alts
830 &&& freeNamesIfType ty
832 fn_alt (_con,_bs,r) = freeNamesIfExpr r
834 -- Depend on the data constructors. Just one will do!
835 -- Note [Tracking data constructors]
836 fn_cons [] = emptyNameSet
837 fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
838 fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
839 fn_cons (_ : _ ) = emptyNameSet
841 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
842 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
844 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
845 = fnList fn_pair as &&& freeNamesIfExpr x
847 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
849 freeNamesIfExpr _ = emptyNameSet
851 freeNamesIfTc :: IfaceTyCon -> NameSet
852 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
853 -- ToDo: shouldn't we include IfaceIntTc & co.?
854 freeNamesIfTc _ = emptyNameSet
856 freeNamesIfRule :: IfaceRule -> NameSet
857 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
858 , ifRuleArgs = es, ifRuleRhs = rhs })
860 fnList freeNamesIfBndr bs &&&
861 fnList freeNamesIfExpr es &&&
865 (&&&) :: NameSet -> NameSet -> NameSet
866 (&&&) = unionNameSets
868 fnList :: (a -> NameSet) -> [a] -> NameSet
869 fnList f = foldr (&&&) emptyNameSet . map f
872 Note [Tracking data constructors]
873 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
875 case e of { C a -> ...; ... }
876 You might think that we don't need to include the datacon C
877 in the free names, because its type will probably show up in
878 the free names of 'e'. But in rare circumstances this may
879 not happen. Here's the one that bit me:
881 module DynFlags where
882 import {-# SOURCE #-} Packages( PackageState )
883 data DynFlags = DF ... PackageState ...
885 module Packages where
887 data PackageState = PS ...
888 lookupModule (df :: DynFlags)
890 DF ...p... -> case p of
893 Now, lookupModule depends on DynFlags, but the transitive dependency
894 on the *locally-defined* type PackageState is not visible. We need
895 to take account of the use of the data constructor PS in the pattern match.