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(..), IfaceIdInfo(..),
13 IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
14 IfaceInst(..), IfaceFamInst(..),
17 ifaceDeclSubBndrs, visibleIfConDecls,
20 freeNamesIfDecl, freeNamesIfRule,
23 pprIfaceExpr, pprIfaceDeclHead
26 #include "HsVersions.h"
51 %************************************************************************
53 Data type declarations
55 %************************************************************************
59 = IfaceId { ifName :: OccName,
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 DefMeth 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 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 :: [StrictnessMark]} -- 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
178 = NoInfo -- When writing interface file without -O
179 | HasInfo [IfaceInfoItem] -- Has info, and here it is
181 -- Here's a tricky case:
182 -- * Compile with -O module A, and B which imports A.f
183 -- * Change function f in A, and recompile without -O
184 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
185 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
186 -- but we do not do that now. Instead it's discarded when the
187 -- ModIface is read into the various decl pools.)
188 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
189 -- and so gives a new version.
193 | HsStrictness StrictSig
194 | HsInline Activation
197 | HsWorker Name Arity -- Worker, if any see IdInfo.WorkerInfo
198 -- for why we want arity here.
199 -- NB: we need IfaceExtName (not just OccName) because the worker
200 -- can simplify to a function in another module.
201 -- NB: Specialisations and rules come in separately and are
202 -- only later attached to the Id. Partial reason: some are orphans.
204 --------------------------------
206 = IfaceLcl FastString
208 | IfaceType IfaceType
209 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
210 | IfaceLam IfaceBndr IfaceExpr
211 | IfaceApp IfaceExpr IfaceExpr
212 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
213 | IfaceLet IfaceBinding IfaceExpr
214 | IfaceNote IfaceNote IfaceExpr
215 | IfaceCast IfaceExpr IfaceCoercion
217 | IfaceFCall ForeignCall IfaceType
218 | IfaceTick Module Int
220 data IfaceNote = IfaceSCC CostCentre
222 | IfaceCoreNote String
224 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
225 -- Note: FastString, not IfaceBndr (and same with the case binder)
226 -- We reconstruct the kind/type of the thing from the context
227 -- thus saving bulk in interface files
229 data IfaceConAlt = IfaceDefault
231 | IfaceTupleAlt Boxity
232 | IfaceLitAlt Literal
235 = IfaceNonRec IfaceLetBndr IfaceExpr
236 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
238 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
239 -- It's used for *non-top-level* let/rec binders
240 -- See Note [IdInfo on nested let-bindings]
241 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
244 Note [IdInfo on nested let-bindings]
245 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
246 Occasionally we want to preserve IdInfo on nested let bindings. The one
247 that came up was a NOINLINE pragma on a let-binding inside an INLINE
248 function. The user (Duncan Coutts) really wanted the NOINLINE control
249 to cross the separate compilation boundary.
251 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
252 Currently we only actually retain InlinePragInfo, but in principle we could
256 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
257 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
258 If a module contains any "orphans", then its interface file is read
259 regardless, so that its instances are not missed.
261 Roughly speaking, an instance is an orphan if its head (after the =>)
262 mentions nothing defined in this module. Functional dependencies
263 complicate the situation though. Consider
265 module M where { class C a b | a -> b }
267 and suppose we are compiling module X:
272 instance C Int T where ...
274 This instance is an orphan, because when compiling a third module Y we
275 might get a constraint (C Int v), and we'd want to improve v to T. So
276 we must make sure X's instances are loaded, even if we do not directly
279 More precisely, an instance is an orphan iff
281 If there are no fundeps, then at least of the names in
282 the instance head is locally defined.
284 If there are fundeps, then for every fundep, at least one of the
285 names free in a *non-determined* part of the instance head is
286 defined in this module.
288 (Note that these conditions hold trivially if the class is locally
291 Note [Versioning of instances]
292 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
293 Now consider versioning. If we *use* an instance decl in one compilation,
294 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
295 But suppose we *don't* (currently) use an instance! We must recompile if
296 the instance is changed in such a way that it becomes important. (This would
297 only matter with overlapping instances, else the importing module wouldn't have
298 compiled before and the recompilation check is irrelevant.)
300 The is_orph field is set to (Just n) if the instance is not an orphan.
301 The 'n' is *any* of the locally-defined names mentioned anywhere in the
302 instance head. This name is used for versioning; the instance decl is
303 considered part of the defn of this 'n'.
305 I'm worried about whether this works right if we pick a name from
306 a functionally-dependent part of the instance decl. E.g.
308 module M where { class C a b | a -> b }
310 and suppose we are compiling module X:
316 instance C S T where ...
318 If we base the instance verion on T, I'm worried that changing S to S'
319 would change T's version, but not S or S'. But an importing module might
320 not depend on T, and so might not be recompiled even though the new instance
321 (C S' T) might be relevant. I have not been able to make a concrete example,
322 and it seems deeply obscure, so I'm going to leave it for now.
325 Note [Versioning of rules]
326 ~~~~~~~~~~~~~~~~~~~~~~~~~~
327 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
328 n appears on the LHS of the rule; any change in the rule changes the version of n.
332 -- -----------------------------------------------------------------------------
335 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
336 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
337 -- Deeply revolting, because it has to predict what gets bound,
338 -- especially the question of whether there's a wrapper for a datacon
340 -- N.B. the set of names returned here *must* match the set of
341 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
342 -- TyThing.getOccName should define a bijection between the two lists.
343 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
344 -- The order of the list does not matter.
345 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
348 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
349 ifCons = IfNewTyCon (
350 IfCon { ifConOcc = con_occ,
353 ifFamInst = famInst})
354 = -- fields (names of selectors)
356 -- implicit coerion and (possibly) family instance coercion
357 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
358 -- data constructor and worker (newtypes don't have a wrapper)
359 [con_occ, mkDataConWorkerOcc con_occ]
362 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
363 ifCons = IfDataTyCon cons,
364 ifFamInst = famInst})
365 = -- fields (names of selectors)
366 nub (concatMap ifConFields cons) -- Eliminate duplicate fields
367 -- (possibly) family instance coercion;
368 -- there is no implicit coercion for non-newtypes
369 ++ famInstCo famInst tc_occ
370 -- for each data constructor in order,
371 -- data constructor, worker, and (possibly) wrapper
372 ++ concatMap dc_occs cons
375 | has_wrapper = [con_occ, work_occ, wrap_occ]
376 | otherwise = [con_occ, work_occ]
378 con_occ = ifConOcc con_decl -- DataCon namespace
379 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
380 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
381 strs = ifConStricts con_decl
382 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
383 || not (null . ifConEqSpec $ con_decl)
385 -- ToDo: may miss strictness in existential dicts
387 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
388 ifSigs = sigs, ifATs = ats })
389 = -- dictionary datatype:
392 -- (possibly) newtype coercion
394 -- data constructor (DataCon namespace)
395 -- data worker (Id namespace)
396 -- no wrapper (class dictionaries never have a wrapper)
397 [dc_occ, dcww_occ] ++
399 [ifName at | at <- ats ] ++
400 -- superclass selectors
401 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
402 -- operation selectors
403 [op | IfaceClassOp op _ _ <- sigs]
405 n_ctxt = length sc_ctxt
407 tc_occ = mkClassTyConOcc cls_occ
408 dc_occ = mkClassDataConOcc cls_occ
409 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
411 dcww_occ = mkDataConWorkerOcc dc_occ
412 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
414 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
415 ifFamInst = famInst})
416 = famInstCo famInst tc_occ
418 ifaceDeclSubBndrs _ = []
420 -- coercion for data/newtype family instances
421 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
422 famInstCo Nothing _ = []
423 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
425 ----------------------------- Printing IfaceDecl ------------------------------
427 instance Outputable IfaceDecl where
430 pprIfaceDecl :: IfaceDecl -> SDoc
431 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
432 = sep [ ppr var <+> dcolon <+> ppr ty,
435 pprIfaceDecl (IfaceForeign {ifName = tycon})
436 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
438 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
439 ifSynRhs = Just mono_ty,
440 ifFamInst = mbFamInst})
441 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
442 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
444 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
445 ifSynRhs = Nothing, ifSynKind = kind })
446 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
447 4 (dcolon <+> ppr kind)
449 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
450 ifTyVars = tyvars, ifCons = condecls,
451 ifRec = isrec, ifFamInst = mbFamInst})
452 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
453 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
454 pprFamily mbFamInst])
456 pp_nd = case condecls of
457 IfAbstractTyCon -> ptext (sLit "data")
458 IfOpenDataTyCon -> ptext (sLit "data family")
459 IfDataTyCon _ -> ptext (sLit "data")
460 IfNewTyCon _ -> ptext (sLit "newtype")
462 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
463 ifFDs = fds, ifATs = ats, ifSigs = sigs,
465 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
466 4 (vcat [pprRec isrec,
470 pprRec :: RecFlag -> SDoc
471 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
473 pprGen :: Bool -> SDoc
474 pprGen True = ptext (sLit "Generics: yes")
475 pprGen False = ptext (sLit "Generics: no")
477 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
478 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
479 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
481 instance Outputable IfaceClassOp where
482 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
484 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
485 pprIfaceDeclHead context thing tyvars
486 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
487 pprIfaceTvBndrs tyvars]
489 pp_condecls :: OccName -> IfaceConDecls -> SDoc
490 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
491 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
492 pp_condecls _ IfOpenDataTyCon = empty
493 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
494 (map (pprIfaceConDecl tc) cs))
496 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
498 (IfCon { ifConOcc = name, ifConInfix = is_infix,
499 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
500 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
501 ifConStricts = strs, ifConFields = fields })
503 if is_infix then ptext (sLit "Infix") else empty,
504 if null strs then empty
505 else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
506 if null fields then empty
507 else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
509 main_payload = ppr name <+> dcolon <+>
510 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
512 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
513 | (tv,ty) <- eq_spec]
515 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
516 -- because we don't have a Name for the tycon, only an OccName
517 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
518 (t:ts) -> fsep (t : map (arrow <+>) ts)
519 [] -> panic "pp_con_taus"
521 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
523 instance Outputable IfaceRule where
524 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
525 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
526 = sep [hsep [doubleQuotes (ftext name), ppr act,
527 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
528 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
529 ptext (sLit "=") <+> ppr rhs])
532 instance Outputable IfaceInst where
533 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
534 ifInstCls = cls, ifInstTys = mb_tcs})
535 = hang (ptext (sLit "instance") <+> ppr flag
536 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
537 2 (equals <+> ppr dfun_id)
539 instance Outputable IfaceFamInst where
540 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
541 ifFamInstTyCon = tycon_id})
542 = hang (ptext (sLit "family instance") <+>
543 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
544 2 (equals <+> ppr tycon_id)
546 ppr_rough :: Maybe IfaceTyCon -> SDoc
547 ppr_rough Nothing = dot
548 ppr_rough (Just tc) = ppr tc
552 ----------------------------- Printing IfaceExpr ------------------------------------
555 instance Outputable IfaceExpr where
556 ppr e = pprIfaceExpr noParens e
558 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
559 -- The function adds parens in context that need
560 -- an atomic value (e.g. function args)
562 pprIfaceExpr _ (IfaceLcl v) = ppr v
563 pprIfaceExpr _ (IfaceExt v) = ppr v
564 pprIfaceExpr _ (IfaceLit l) = ppr l
565 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
566 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
567 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
569 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
570 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
572 pprIfaceExpr add_par e@(IfaceLam _ _)
573 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
574 pprIfaceExpr noParens body])
576 (bndrs,body) = collect [] e
577 collect bs (IfaceLam b e) = collect (b:bs) e
578 collect bs e = (reverse bs, e)
580 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
581 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
582 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
583 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
584 pprIfaceExpr noParens rhs <+> char '}'])
586 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
587 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
588 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
589 <+> ppr bndr <+> char '{',
590 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
592 pprIfaceExpr _ (IfaceCast expr co)
593 = sep [pprIfaceExpr parens expr,
594 nest 2 (ptext (sLit "`cast`")),
595 pprParendIfaceType co]
597 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
598 = add_par (sep [ptext (sLit "let {"),
599 nest 2 (ppr_bind (b, rhs)),
601 pprIfaceExpr noParens body])
603 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
604 = add_par (sep [ptext (sLit "letrec {"),
605 nest 2 (sep (map ppr_bind pairs)),
607 pprIfaceExpr noParens body])
609 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
611 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
612 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
613 arrow <+> pprIfaceExpr noParens rhs]
615 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
616 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
617 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
619 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
620 ppr_bind (IfLetBndr b ty info, rhs)
621 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
622 equals <+> pprIfaceExpr noParens rhs]
625 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
626 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
627 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
630 instance Outputable IfaceNote where
631 ppr (IfaceSCC cc) = pprCostCentreCore cc
632 ppr IfaceInlineMe = ptext (sLit "__inline_me")
633 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
636 instance Outputable IfaceConAlt where
637 ppr IfaceDefault = text "DEFAULT"
638 ppr (IfaceLitAlt l) = ppr l
639 ppr (IfaceDataAlt d) = ppr d
640 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
641 -- IfaceTupleAlt is handled by the case-alternative printer
644 instance Outputable IfaceIdInfo where
646 ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
648 instance Outputable IfaceInfoItem where
649 ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+>
650 parens (pprIfaceExpr noParens unf)
651 ppr (HsInline act) = ptext (sLit "Inline:") <+> ppr act
652 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
653 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
654 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
655 ppr (HsWorker w a) = ptext (sLit "Worker:") <+> ppr w <+> int a
658 -- -----------------------------------------------------------------------------
659 -- Finding the Names in IfaceSyn
661 -- This is used for dependency analysis in MkIface, so that we
662 -- fingerprint a declaration before the things that depend on it. It
663 -- is specific to interface-file fingerprinting in the sense that we
664 -- don't collect *all* Names: for example, the DFun of an instance is
665 -- recorded textually rather than by its fingerprint when
666 -- fingerprinting the instance, so DFuns are not dependencies.
668 freeNamesIfDecl :: IfaceDecl -> NameSet
669 freeNamesIfDecl (IfaceId _s t i) =
670 freeNamesIfType t &&&
672 freeNamesIfDecl IfaceForeign{} =
674 freeNamesIfDecl d@IfaceData{} =
675 freeNamesIfTvBndrs (ifTyVars d) &&&
676 freeNamesIfTcFam (ifFamInst d) &&&
677 freeNamesIfContext (ifCtxt d) &&&
678 freeNamesIfConDecls (ifCons d)
679 freeNamesIfDecl d@IfaceSyn{} =
680 freeNamesIfTvBndrs (ifTyVars d) &&&
681 freeNamesIfSynRhs (ifSynRhs d) &&&
682 freeNamesIfTcFam (ifFamInst d)
683 freeNamesIfDecl d@IfaceClass{} =
684 freeNamesIfTvBndrs (ifTyVars d) &&&
685 freeNamesIfContext (ifCtxt d) &&&
686 freeNamesIfDecls (ifATs d) &&&
687 fnList freeNamesIfClsSig (ifSigs d)
689 -- All other changes are handled via the version info on the tycon
690 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
691 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
692 freeNamesIfSynRhs Nothing = emptyNameSet
694 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
695 freeNamesIfTcFam (Just (tc,tys)) =
696 freeNamesIfTc tc &&& fnList freeNamesIfType tys
697 freeNamesIfTcFam Nothing =
700 freeNamesIfContext :: IfaceContext -> NameSet
701 freeNamesIfContext = fnList freeNamesIfPredType
703 freeNamesIfDecls :: [IfaceDecl] -> NameSet
704 freeNamesIfDecls = fnList freeNamesIfDecl
706 freeNamesIfClsSig :: IfaceClassOp -> NameSet
707 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
709 freeNamesIfConDecls :: IfaceConDecls -> NameSet
710 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
711 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
712 freeNamesIfConDecls _ = emptyNameSet
714 freeNamesIfConDecl :: IfaceConDecl -> NameSet
715 freeNamesIfConDecl c =
716 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
717 freeNamesIfTvBndrs (ifConExTvs c) &&&
718 freeNamesIfContext (ifConCtxt c) &&&
719 fnList freeNamesIfType (ifConArgTys c) &&&
720 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
722 freeNamesIfPredType :: IfacePredType -> NameSet
723 freeNamesIfPredType (IfaceClassP cl tys) =
724 unitNameSet cl &&& fnList freeNamesIfType tys
725 freeNamesIfPredType (IfaceIParam _n ty) =
727 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
728 freeNamesIfType ty1 &&& freeNamesIfType ty2
730 freeNamesIfType :: IfaceType -> NameSet
731 freeNamesIfType (IfaceTyVar _) = emptyNameSet
732 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
733 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
734 freeNamesIfType (IfaceTyConApp tc ts) =
735 freeNamesIfTc tc &&& fnList freeNamesIfType ts
736 freeNamesIfType (IfaceForAllTy tv t) =
737 freeNamesIfTvBndr tv &&& freeNamesIfType t
738 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
740 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
741 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
743 freeNamesIfBndr :: IfaceBndr -> NameSet
744 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
745 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
747 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
748 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
749 -- kinds can have Names inside, when the Kind is an equality predicate
751 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
752 freeNamesIfIdBndr = freeNamesIfTvBndr
754 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
755 freeNamesIfIdInfo NoInfo = emptyNameSet
756 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
758 freeNamesItem :: IfaceInfoItem -> NameSet
759 freeNamesItem (HsUnfold u) = freeNamesIfExpr u
760 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
761 freeNamesItem _ = emptyNameSet
763 freeNamesIfExpr :: IfaceExpr -> NameSet
764 freeNamesIfExpr (IfaceExt v) = unitNameSet v
765 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
766 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
767 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
768 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
769 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
770 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
771 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
773 freeNamesIfExpr (IfaceCase s _ ty alts)
774 = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
776 -- no need to look at the constructor, because we'll already have its
777 -- parent recorded by the type on the case expression.
778 freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
780 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
781 = freeNamesIfExpr r &&& freeNamesIfExpr x
783 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
784 = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
786 freeNamesIfExpr _ = emptyNameSet
789 freeNamesIfTc :: IfaceTyCon -> NameSet
790 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
791 -- ToDo: shouldn't we include IfaceIntTc & co.?
792 freeNamesIfTc _ = emptyNameSet
794 freeNamesIfRule :: IfaceRule -> NameSet
795 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
797 fnList freeNamesIfBndr bs &&&
798 fnList freeNamesIfExpr es &&&
802 (&&&) :: NameSet -> NameSet -> NameSet
803 (&&&) = unionNameSets
805 fnList :: (a -> NameSet) -> [a] -> NameSet
806 fnList f = foldr (&&&) emptyNameSet . map f