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(..), IfaceInst(..), IfaceFamInst(..),
16 ifaceDeclSubBndrs, visibleIfConDecls,
19 freeNamesIfDecl, freeNamesIfRule,
22 pprIfaceExpr, pprIfaceDeclHead
25 #include "HsVersions.h"
49 %************************************************************************
51 Data type declarations
53 %************************************************************************
57 = IfaceId { ifName :: OccName,
59 ifIdInfo :: IfaceIdInfo }
61 | IfaceData { ifName :: OccName, -- Type constructor
62 ifTyVars :: [IfaceTvBndr], -- Type variables
63 ifCtxt :: IfaceContext, -- The "stupid theta"
64 ifCons :: IfaceConDecls, -- Includes new/data info
65 ifRec :: RecFlag, -- Recursive or not?
66 ifGadtSyntax :: Bool, -- True <=> declared using
68 ifGeneric :: Bool, -- True <=> generic converter
69 -- functions available
70 -- We need this for imported
71 -- data decls, since the
72 -- imported modules may have
74 -- different flags to the
75 -- current compilation unit
76 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
77 -- Just <=> instance of family
79 -- ifCons /= IfOpenDataTyCon
80 -- for family instances
83 | IfaceSyn { ifName :: OccName, -- Type constructor
84 ifTyVars :: [IfaceTvBndr], -- Type variables
85 ifOpenSyn :: Bool, -- Is an open family?
86 ifSynRhs :: IfaceType, -- Type for an ordinary
87 -- synonym and kind for an
89 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
90 -- Just <=> instance of family
91 -- Invariant: ifOpenSyn == False
92 -- for family instances
95 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
96 ifName :: OccName, -- Name of the class
97 ifTyVars :: [IfaceTvBndr], -- Type variables
98 ifFDs :: [FunDep FastString], -- Functional dependencies
99 ifATs :: [IfaceDecl], -- Associated type families
100 ifSigs :: [IfaceClassOp], -- Method signatures
101 ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
104 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
106 ifExtName :: Maybe FastString }
108 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
109 -- Nothing => no default method
110 -- Just False => ordinary polymorphic default method
111 -- Just True => generic default method
114 = IfAbstractTyCon -- No info
115 | IfOpenDataTyCon -- Open data family
116 | IfDataTyCon [IfaceConDecl] -- data type decls
117 | IfNewTyCon IfaceConDecl -- newtype decls
119 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
120 visibleIfConDecls IfAbstractTyCon = []
121 visibleIfConDecls IfOpenDataTyCon = []
122 visibleIfConDecls (IfDataTyCon cs) = cs
123 visibleIfConDecls (IfNewTyCon c) = [c]
127 ifConOcc :: OccName, -- Constructor name
128 ifConInfix :: Bool, -- True <=> declared infix
129 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
130 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
131 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
132 ifConCtxt :: IfaceContext, -- Non-stupid context
133 ifConArgTys :: [IfaceType], -- Arg types
134 ifConFields :: [OccName], -- ...ditto... (field labels)
135 ifConStricts :: [StrictnessMark]} -- Empty (meaning all lazy),
136 -- or 1-1 corresp with arg tys
139 = IfaceInst { ifInstCls :: Name, -- See comments with
140 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
141 ifDFun :: Name, -- The dfun
142 ifOFlag :: OverlapFlag, -- Overlap flag
143 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
144 -- There's always a separate IfaceDecl for the DFun, which gives
145 -- its IdInfo with its full type and version number.
146 -- The instance declarations taken together have a version number,
147 -- and we don't want that to wobble gratuitously
148 -- If this instance decl is *used*, we'll record a usage on the dfun;
149 -- and if the head does not change it won't be used if it wasn't before
152 = IfaceFamInst { ifFamInstFam :: Name -- Family tycon
153 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
154 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
159 ifRuleName :: RuleName,
160 ifActivation :: Activation,
161 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
162 ifRuleHead :: Name, -- Head of lhs
163 ifRuleArgs :: [IfaceExpr], -- Args of LHS
164 ifRuleRhs :: IfaceExpr,
165 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
169 = NoInfo -- When writing interface file without -O
170 | HasInfo [IfaceInfoItem] -- Has info, and here it is
172 -- Here's a tricky case:
173 -- * Compile with -O module A, and B which imports A.f
174 -- * Change function f in A, and recompile without -O
175 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
176 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
177 -- but we do not do that now. Instead it's discarded when the
178 -- ModIface is read into the various decl pools.)
179 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
180 -- and so gives a new version.
184 | HsStrictness StrictSig
185 | HsInline Activation
188 | HsWorker Name Arity -- Worker, if any see IdInfo.WorkerInfo
189 -- for why we want arity here.
190 -- NB: we need IfaceExtName (not just OccName) because the worker
191 -- can simplify to a function in another module.
192 -- NB: Specialisations and rules come in separately and are
193 -- only later attached to the Id. Partial reason: some are orphans.
195 --------------------------------
197 = IfaceLcl FastString
199 | IfaceType IfaceType
200 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
201 | IfaceLam IfaceBndr IfaceExpr
202 | IfaceApp IfaceExpr IfaceExpr
203 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
204 | IfaceLet IfaceBinding IfaceExpr
205 | IfaceNote IfaceNote IfaceExpr
206 | IfaceCast IfaceExpr IfaceCoercion
208 | IfaceFCall ForeignCall IfaceType
209 | IfaceTick Module Int
211 data IfaceNote = IfaceSCC CostCentre
213 | IfaceCoreNote String
215 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
216 -- Note: FastString, not IfaceBndr (and same with the case binder)
217 -- We reconstruct the kind/type of the thing from the context
218 -- thus saving bulk in interface files
220 data IfaceConAlt = IfaceDefault
222 | IfaceTupleAlt Boxity
223 | IfaceLitAlt Literal
226 = IfaceNonRec IfaceLetBndr IfaceExpr
227 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
229 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
230 -- It's used for *non-top-level* let/rec binders
231 -- See Note [IdInfo on nested let-bindings]
232 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
235 Note [IdInfo on nested let-bindings]
236 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
237 Occasionally we want to preserve IdInfo on nested let bindings. The one
238 that came up was a NOINLINE pragma on a let-binding inside an INLINE
239 function. The user (Duncan Coutts) really wanted the NOINLINE control
240 to cross the separate compilation boundary.
242 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
243 Currently we only actually retain InlinePragInfo, but in principle we could
247 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
248 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
249 If a module contains any "orphans", then its interface file is read
250 regardless, so that its instances are not missed.
252 Roughly speaking, an instance is an orphan if its head (after the =>)
253 mentions nothing defined in this module. Functional dependencies
254 complicate the situation though. Consider
256 module M where { class C a b | a -> b }
258 and suppose we are compiling module X:
263 instance C Int T where ...
265 This instance is an orphan, because when compiling a third module Y we
266 might get a constraint (C Int v), and we'd want to improve v to T. So
267 we must make sure X's instances are loaded, even if we do not directly
270 More precisely, an instance is an orphan iff
272 If there are no fundeps, then at least of the names in
273 the instance head is locally defined.
275 If there are fundeps, then for every fundep, at least one of the
276 names free in a *non-determined* part of the instance head is
277 defined in this module.
279 (Note that these conditions hold trivially if the class is locally
282 Note [Versioning of instances]
283 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
284 Now consider versioning. If we *use* an instance decl in one compilation,
285 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
286 But suppose we *don't* (currently) use an instance! We must recompile if
287 the instance is changed in such a way that it becomes important. (This would
288 only matter with overlapping instances, else the importing module wouldn't have
289 compiled before and the recompilation check is irrelevant.)
291 The is_orph field is set to (Just n) if the instance is not an orphan.
292 The 'n' is *any* of the locally-defined names mentioned anywhere in the
293 instance head. This name is used for versioning; the instance decl is
294 considered part of the defn of this 'n'.
296 I'm worried about whether this works right if we pick a name from
297 a functionally-dependent part of the instance decl. E.g.
299 module M where { class C a b | a -> b }
301 and suppose we are compiling module X:
307 instance C S T where ...
309 If we base the instance verion on T, I'm worried that changing S to S'
310 would change T's version, but not S or S'. But an importing module might
311 not depend on T, and so might not be recompiled even though the new instance
312 (C S' T) might be relevant. I have not been able to make a concrete example,
313 and it seems deeply obscure, so I'm going to leave it for now.
316 Note [Versioning of rules]
317 ~~~~~~~~~~~~~~~~~~~~~~~~~~
318 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
319 n appears on the LHS of the rule; any change in the rule changes the version of n.
323 -- -----------------------------------------------------------------------------
326 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
327 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
328 -- Deeply revolting, because it has to predict what gets bound,
329 -- especially the question of whether there's a wrapper for a datacon
331 -- N.B. the set of names returned here *must* match the set of
332 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
333 -- TyThing.getOccName should define a bijection between the two lists.
334 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
335 -- The order of the list does not matter.
336 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
339 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
340 ifCons = IfNewTyCon (
341 IfCon { ifConOcc = con_occ,
344 ifFamInst = famInst})
345 = -- fields (names of selectors)
347 -- implicit coerion and (possibly) family instance coercion
348 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
349 -- data constructor and worker (newtypes don't have a wrapper)
350 [con_occ, mkDataConWorkerOcc con_occ]
353 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
354 ifCons = IfDataTyCon cons,
355 ifFamInst = famInst})
356 = -- fields (names of selectors)
357 nub (concatMap ifConFields cons) -- Eliminate duplicate fields
358 -- (possibly) family instance coercion;
359 -- there is no implicit coercion for non-newtypes
360 ++ famInstCo famInst tc_occ
361 -- for each data constructor in order,
362 -- data constructor, worker, and (possibly) wrapper
363 ++ concatMap dc_occs cons
366 | has_wrapper = [con_occ, work_occ, wrap_occ]
367 | otherwise = [con_occ, work_occ]
369 con_occ = ifConOcc con_decl -- DataCon namespace
370 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
371 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
372 strs = ifConStricts con_decl
373 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
374 || not (null . ifConEqSpec $ con_decl)
376 -- ToDo: may miss strictness in existential dicts
378 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
379 ifSigs = sigs, ifATs = ats })
380 = -- dictionary datatype:
383 -- (possibly) newtype coercion
385 -- data constructor (DataCon namespace)
386 -- data worker (Id namespace)
387 -- no wrapper (class dictionaries never have a wrapper)
388 [dc_occ, dcww_occ] ++
390 [ifName at | at <- ats ] ++
391 -- superclass selectors
392 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
393 -- operation selectors
394 [op | IfaceClassOp op _ _ <- sigs]
396 n_ctxt = length sc_ctxt
398 tc_occ = mkClassTyConOcc cls_occ
399 dc_occ = mkClassDataConOcc cls_occ
400 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
402 dcww_occ = mkDataConWorkerOcc dc_occ
403 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
405 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
406 ifFamInst = famInst})
407 = famInstCo famInst tc_occ
409 ifaceDeclSubBndrs _ = []
411 -- coercion for data/newtype family instances
412 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
413 famInstCo Nothing _ = []
414 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
416 ----------------------------- Printing IfaceDecl ------------------------------
418 instance Outputable IfaceDecl where
421 pprIfaceDecl :: IfaceDecl -> SDoc
422 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
423 = sep [ ppr var <+> dcolon <+> ppr ty,
426 pprIfaceDecl (IfaceForeign {ifName = tycon})
427 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
429 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
430 ifOpenSyn = False, ifSynRhs = mono_ty,
431 ifFamInst = mbFamInst})
432 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
433 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
435 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
436 ifOpenSyn = True, ifSynRhs = mono_ty})
437 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
438 4 (dcolon <+> ppr mono_ty)
440 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
441 ifTyVars = tyvars, ifCons = condecls,
442 ifRec = isrec, ifFamInst = mbFamInst})
443 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
444 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
445 pprFamily mbFamInst])
447 pp_nd = case condecls of
448 IfAbstractTyCon -> ptext (sLit "data")
449 IfOpenDataTyCon -> ptext (sLit "data family")
450 IfDataTyCon _ -> ptext (sLit "data")
451 IfNewTyCon _ -> ptext (sLit "newtype")
453 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
454 ifFDs = fds, ifATs = ats, ifSigs = sigs,
456 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
457 4 (vcat [pprRec isrec,
461 pprRec :: RecFlag -> SDoc
462 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
464 pprGen :: Bool -> SDoc
465 pprGen True = ptext (sLit "Generics: yes")
466 pprGen False = ptext (sLit "Generics: no")
468 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
469 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
470 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
472 instance Outputable IfaceClassOp where
473 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
475 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
476 pprIfaceDeclHead context thing tyvars
477 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
478 pprIfaceTvBndrs tyvars]
480 pp_condecls :: OccName -> IfaceConDecls -> SDoc
481 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
482 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
483 pp_condecls _ IfOpenDataTyCon = empty
484 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
485 (map (pprIfaceConDecl tc) cs))
487 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
489 (IfCon { ifConOcc = name, ifConInfix = is_infix,
490 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
491 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
492 ifConStricts = strs, ifConFields = fields })
494 if is_infix then ptext (sLit "Infix") else empty,
495 if null strs then empty
496 else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
497 if null fields then empty
498 else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
500 main_payload = ppr name <+> dcolon <+>
501 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
503 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
504 | (tv,ty) <- eq_spec]
506 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
507 -- because we don't have a Name for the tycon, only an OccName
508 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
509 (t:ts) -> fsep (t : map (arrow <+>) ts)
510 [] -> panic "pp_con_taus"
512 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
514 instance Outputable IfaceRule where
515 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
516 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
517 = sep [hsep [doubleQuotes (ftext name), ppr act,
518 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
519 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
520 ptext (sLit "=") <+> ppr rhs])
523 instance Outputable IfaceInst where
524 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
525 ifInstCls = cls, ifInstTys = mb_tcs})
526 = hang (ptext (sLit "instance") <+> ppr flag
527 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
528 2 (equals <+> ppr dfun_id)
530 instance Outputable IfaceFamInst where
531 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
532 ifFamInstTyCon = tycon_id})
533 = hang (ptext (sLit "family instance") <+>
534 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
535 2 (equals <+> ppr tycon_id)
537 ppr_rough :: Maybe IfaceTyCon -> SDoc
538 ppr_rough Nothing = dot
539 ppr_rough (Just tc) = ppr tc
543 ----------------------------- Printing IfaceExpr ------------------------------------
546 instance Outputable IfaceExpr where
547 ppr e = pprIfaceExpr noParens e
549 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
550 -- The function adds parens in context that need
551 -- an atomic value (e.g. function args)
553 pprIfaceExpr _ (IfaceLcl v) = ppr v
554 pprIfaceExpr _ (IfaceExt v) = ppr v
555 pprIfaceExpr _ (IfaceLit l) = ppr l
556 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
557 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
558 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
560 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
561 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
563 pprIfaceExpr add_par e@(IfaceLam _ _)
564 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
565 pprIfaceExpr noParens body])
567 (bndrs,body) = collect [] e
568 collect bs (IfaceLam b e) = collect (b:bs) e
569 collect bs e = (reverse bs, e)
571 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
572 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
573 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
574 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
575 pprIfaceExpr noParens rhs <+> char '}'])
577 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
578 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
579 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
580 <+> ppr bndr <+> char '{',
581 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
583 pprIfaceExpr _ (IfaceCast expr co)
584 = sep [pprIfaceExpr parens expr,
585 nest 2 (ptext (sLit "`cast`")),
586 pprParendIfaceType co]
588 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
589 = add_par (sep [ptext (sLit "let {"),
590 nest 2 (ppr_bind (b, rhs)),
592 pprIfaceExpr noParens body])
594 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
595 = add_par (sep [ptext (sLit "letrec {"),
596 nest 2 (sep (map ppr_bind pairs)),
598 pprIfaceExpr noParens body])
600 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
602 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
603 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
604 arrow <+> pprIfaceExpr noParens rhs]
606 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
607 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
608 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
610 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
611 ppr_bind (IfLetBndr b ty info, rhs)
612 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
613 equals <+> pprIfaceExpr noParens rhs]
616 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
617 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
618 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
621 instance Outputable IfaceNote where
622 ppr (IfaceSCC cc) = pprCostCentreCore cc
623 ppr IfaceInlineMe = ptext (sLit "__inline_me")
624 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
627 instance Outputable IfaceConAlt where
628 ppr IfaceDefault = text "DEFAULT"
629 ppr (IfaceLitAlt l) = ppr l
630 ppr (IfaceDataAlt d) = ppr d
631 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
632 -- IfaceTupleAlt is handled by the case-alternative printer
635 instance Outputable IfaceIdInfo where
637 ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
639 instance Outputable IfaceInfoItem where
640 ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+>
641 parens (pprIfaceExpr noParens unf)
642 ppr (HsInline act) = ptext (sLit "Inline:") <+> ppr act
643 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
644 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
645 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
646 ppr (HsWorker w a) = ptext (sLit "Worker:") <+> ppr w <+> int a
649 -- -----------------------------------------------------------------------------
650 -- Finding the Names in IfaceSyn
652 -- This is used for dependency analysis in MkIface, so that we
653 -- fingerprint a declaration before the things that depend on it. It
654 -- is specific to interface-file fingerprinting in the sense that we
655 -- don't collect *all* Names: for example, the DFun of an instance is
656 -- recorded textually rather than by its fingerprint when
657 -- fingerprinting the instance, so DFuns are not dependencies.
659 freeNamesIfDecl :: IfaceDecl -> NameSet
660 freeNamesIfDecl (IfaceId _s t i) =
661 freeNamesIfType t &&&
663 freeNamesIfDecl IfaceForeign{} =
665 freeNamesIfDecl d@IfaceData{} =
666 freeNamesIfTvBndrs (ifTyVars d) &&&
667 freeNamesIfTcFam (ifFamInst d) &&&
668 freeNamesIfContext (ifCtxt d) &&&
669 freeNamesIfConDecls (ifCons d)
670 freeNamesIfDecl d@IfaceSyn{} =
671 freeNamesIfTvBndrs (ifTyVars d) &&&
672 freeNamesIfType (ifSynRhs d) &&&
673 freeNamesIfTcFam (ifFamInst d)
674 freeNamesIfDecl d@IfaceClass{} =
675 freeNamesIfTvBndrs (ifTyVars d) &&&
676 freeNamesIfContext (ifCtxt d) &&&
677 freeNamesIfDecls (ifATs d) &&&
678 fnList freeNamesIfClsSig (ifSigs d)
680 -- All other changes are handled via the version info on the tycon
681 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
682 freeNamesIfTcFam (Just (tc,tys)) =
683 freeNamesIfTc tc &&& fnList freeNamesIfType tys
684 freeNamesIfTcFam Nothing =
687 freeNamesIfContext :: IfaceContext -> NameSet
688 freeNamesIfContext = fnList freeNamesIfPredType
690 freeNamesIfDecls :: [IfaceDecl] -> NameSet
691 freeNamesIfDecls = fnList freeNamesIfDecl
693 freeNamesIfClsSig :: IfaceClassOp -> NameSet
694 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
696 freeNamesIfConDecls :: IfaceConDecls -> NameSet
697 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
698 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
699 freeNamesIfConDecls _ = emptyNameSet
701 freeNamesIfConDecl :: IfaceConDecl -> NameSet
702 freeNamesIfConDecl c =
703 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
704 freeNamesIfTvBndrs (ifConExTvs c) &&&
705 freeNamesIfContext (ifConCtxt c) &&&
706 fnList freeNamesIfType (ifConArgTys c) &&&
707 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
709 freeNamesIfPredType :: IfacePredType -> NameSet
710 freeNamesIfPredType (IfaceClassP cl tys) =
711 unitNameSet cl &&& fnList freeNamesIfType tys
712 freeNamesIfPredType (IfaceIParam _n ty) =
714 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
715 freeNamesIfType ty1 &&& freeNamesIfType ty2
717 freeNamesIfType :: IfaceType -> NameSet
718 freeNamesIfType (IfaceTyVar _) = emptyNameSet
719 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
720 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
721 freeNamesIfType (IfaceTyConApp tc ts) =
722 freeNamesIfTc tc &&& fnList freeNamesIfType ts
723 freeNamesIfType (IfaceForAllTy tv t) =
724 freeNamesIfTvBndr tv &&& freeNamesIfType t
725 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
727 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
728 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
730 freeNamesIfBndr :: IfaceBndr -> NameSet
731 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
732 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
734 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
735 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
736 -- kinds can have Names inside, when the Kind is an equality predicate
738 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
739 freeNamesIfIdBndr = freeNamesIfTvBndr
741 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
742 freeNamesIfIdInfo NoInfo = emptyNameSet
743 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
745 freeNamesItem :: IfaceInfoItem -> NameSet
746 freeNamesItem (HsUnfold u) = freeNamesIfExpr u
747 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
748 freeNamesItem _ = emptyNameSet
750 freeNamesIfExpr :: IfaceExpr -> NameSet
751 freeNamesIfExpr (IfaceExt v) = unitNameSet v
752 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
753 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
754 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
755 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
756 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
757 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
758 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
760 freeNamesIfExpr (IfaceCase s _ ty alts)
761 = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
763 -- no need to look at the constructor, because we'll already have its
764 -- parent recorded by the type on the case expression.
765 freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
767 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
768 = freeNamesIfExpr r &&& freeNamesIfExpr x
770 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
771 = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
773 freeNamesIfExpr _ = emptyNameSet
776 freeNamesIfTc :: IfaceTyCon -> NameSet
777 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
778 -- ToDo: shouldn't we include IfaceIntTc & co.?
779 freeNamesIfTc _ = emptyNameSet
781 freeNamesIfRule :: IfaceRule -> NameSet
782 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
784 fnList freeNamesIfBndr bs &&&
785 fnList freeNamesIfExpr es &&&
789 (&&&) :: NameSet -> NameSet -> NameSet
790 (&&&) = unionNameSets
792 fnList :: (a -> NameSet) -> [a] -> NameSet
793 fnList f = foldr (&&&) emptyNameSet . map f