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"
48 %************************************************************************
50 Data type declarations
52 %************************************************************************
56 = IfaceId { ifName :: OccName,
58 ifIdInfo :: IfaceIdInfo }
60 | IfaceData { ifName :: OccName, -- Type constructor
61 ifTyVars :: [IfaceTvBndr], -- Type variables
62 ifCtxt :: IfaceContext, -- The "stupid theta"
63 ifCons :: IfaceConDecls, -- Includes new/data info
64 ifRec :: RecFlag, -- Recursive or not?
65 ifGadtSyntax :: Bool, -- True <=> declared using
67 ifGeneric :: Bool, -- True <=> generic converter
68 -- functions available
69 -- We need this for imported
70 -- data decls, since the
71 -- imported modules may have
73 -- different flags to the
74 -- current compilation unit
75 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
76 -- Just <=> instance of family
78 -- ifCons /= IfOpenDataTyCon
79 -- for family instances
82 | IfaceSyn { ifName :: OccName, -- Type constructor
83 ifTyVars :: [IfaceTvBndr], -- Type variables
84 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
85 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
86 -- Nothing for an open family
87 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
88 -- Just <=> instance of family
89 -- Invariant: ifOpenSyn == False
90 -- for family instances
93 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
94 ifName :: OccName, -- Name of the class
95 ifTyVars :: [IfaceTvBndr], -- Type variables
96 ifFDs :: [FunDep FastString], -- Functional dependencies
97 ifATs :: [IfaceDecl], -- Associated type families
98 ifSigs :: [IfaceClassOp], -- Method signatures
99 ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
102 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
104 ifExtName :: Maybe FastString }
106 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
107 -- Nothing => no default method
108 -- Just False => ordinary polymorphic default method
109 -- Just True => generic default method
112 = IfAbstractTyCon -- No info
113 | IfOpenDataTyCon -- Open data family
114 | IfDataTyCon [IfaceConDecl] -- data type decls
115 | IfNewTyCon IfaceConDecl -- newtype decls
117 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
118 visibleIfConDecls IfAbstractTyCon = []
119 visibleIfConDecls IfOpenDataTyCon = []
120 visibleIfConDecls (IfDataTyCon cs) = cs
121 visibleIfConDecls (IfNewTyCon c) = [c]
125 ifConOcc :: OccName, -- Constructor name
126 ifConInfix :: Bool, -- True <=> declared infix
127 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
128 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
129 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
130 ifConCtxt :: IfaceContext, -- Non-stupid context
131 ifConArgTys :: [IfaceType], -- Arg types
132 ifConFields :: [OccName], -- ...ditto... (field labels)
133 ifConStricts :: [StrictnessMark]} -- Empty (meaning all lazy),
134 -- or 1-1 corresp with arg tys
137 = IfaceInst { ifInstCls :: Name, -- See comments with
138 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
139 ifDFun :: Name, -- The dfun
140 ifOFlag :: OverlapFlag, -- Overlap flag
141 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
142 -- There's always a separate IfaceDecl for the DFun, which gives
143 -- its IdInfo with its full type and version number.
144 -- The instance declarations taken together have a version number,
145 -- and we don't want that to wobble gratuitously
146 -- If this instance decl is *used*, we'll record a usage on the dfun;
147 -- and if the head does not change it won't be used if it wasn't before
150 = IfaceFamInst { ifFamInstFam :: Name -- Family tycon
151 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
152 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
157 ifRuleName :: RuleName,
158 ifActivation :: Activation,
159 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
160 ifRuleHead :: Name, -- Head of lhs
161 ifRuleArgs :: [IfaceExpr], -- Args of LHS
162 ifRuleRhs :: IfaceExpr,
163 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
167 = NoInfo -- When writing interface file without -O
168 | HasInfo [IfaceInfoItem] -- Has info, and here it is
170 -- Here's a tricky case:
171 -- * Compile with -O module A, and B which imports A.f
172 -- * Change function f in A, and recompile without -O
173 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
174 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
175 -- but we do not do that now. Instead it's discarded when the
176 -- ModIface is read into the various decl pools.)
177 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
178 -- and so gives a new version.
182 | HsStrictness StrictSig
183 | HsInline Activation
186 | HsWorker Name Arity -- Worker, if any see IdInfo.WorkerInfo
187 -- for why we want arity here.
188 -- NB: we need IfaceExtName (not just OccName) because the worker
189 -- can simplify to a function in another module.
190 -- NB: Specialisations and rules come in separately and are
191 -- only later attached to the Id. Partial reason: some are orphans.
193 --------------------------------
195 = IfaceLcl FastString
197 | IfaceType IfaceType
198 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
199 | IfaceLam IfaceBndr IfaceExpr
200 | IfaceApp IfaceExpr IfaceExpr
201 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
202 | IfaceLet IfaceBinding IfaceExpr
203 | IfaceNote IfaceNote IfaceExpr
204 | IfaceCast IfaceExpr IfaceCoercion
206 | IfaceFCall ForeignCall IfaceType
207 | IfaceTick Module Int
209 data IfaceNote = IfaceSCC CostCentre
211 | IfaceCoreNote String
213 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
214 -- Note: FastString, not IfaceBndr (and same with the case binder)
215 -- We reconstruct the kind/type of the thing from the context
216 -- thus saving bulk in interface files
218 data IfaceConAlt = IfaceDefault
220 | IfaceTupleAlt Boxity
221 | IfaceLitAlt Literal
224 = IfaceNonRec IfaceLetBndr IfaceExpr
225 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
227 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
228 -- It's used for *non-top-level* let/rec binders
229 -- See Note [IdInfo on nested let-bindings]
230 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
233 Note [IdInfo on nested let-bindings]
234 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
235 Occasionally we want to preserve IdInfo on nested let bindings. The one
236 that came up was a NOINLINE pragma on a let-binding inside an INLINE
237 function. The user (Duncan Coutts) really wanted the NOINLINE control
238 to cross the separate compilation boundary.
240 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
241 Currently we only actually retain InlinePragInfo, but in principle we could
245 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
246 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
247 If a module contains any "orphans", then its interface file is read
248 regardless, so that its instances are not missed.
250 Roughly speaking, an instance is an orphan if its head (after the =>)
251 mentions nothing defined in this module. Functional dependencies
252 complicate the situation though. Consider
254 module M where { class C a b | a -> b }
256 and suppose we are compiling module X:
261 instance C Int T where ...
263 This instance is an orphan, because when compiling a third module Y we
264 might get a constraint (C Int v), and we'd want to improve v to T. So
265 we must make sure X's instances are loaded, even if we do not directly
268 More precisely, an instance is an orphan iff
270 If there are no fundeps, then at least of the names in
271 the instance head is locally defined.
273 If there are fundeps, then for every fundep, at least one of the
274 names free in a *non-determined* part of the instance head is
275 defined in this module.
277 (Note that these conditions hold trivially if the class is locally
280 Note [Versioning of instances]
281 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
282 Now consider versioning. If we *use* an instance decl in one compilation,
283 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
284 But suppose we *don't* (currently) use an instance! We must recompile if
285 the instance is changed in such a way that it becomes important. (This would
286 only matter with overlapping instances, else the importing module wouldn't have
287 compiled before and the recompilation check is irrelevant.)
289 The is_orph field is set to (Just n) if the instance is not an orphan.
290 The 'n' is *any* of the locally-defined names mentioned anywhere in the
291 instance head. This name is used for versioning; the instance decl is
292 considered part of the defn of this 'n'.
294 I'm worried about whether this works right if we pick a name from
295 a functionally-dependent part of the instance decl. E.g.
297 module M where { class C a b | a -> b }
299 and suppose we are compiling module X:
305 instance C S T where ...
307 If we base the instance verion on T, I'm worried that changing S to S'
308 would change T's version, but not S or S'. But an importing module might
309 not depend on T, and so might not be recompiled even though the new instance
310 (C S' T) might be relevant. I have not been able to make a concrete example,
311 and it seems deeply obscure, so I'm going to leave it for now.
314 Note [Versioning of rules]
315 ~~~~~~~~~~~~~~~~~~~~~~~~~~
316 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
317 n appears on the LHS of the rule; any change in the rule changes the version of n.
321 -- -----------------------------------------------------------------------------
324 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
325 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
326 -- Deeply revolting, because it has to predict what gets bound,
327 -- especially the question of whether there's a wrapper for a datacon
329 -- N.B. the set of names returned here *must* match the set of
330 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
331 -- TyThing.getOccName should define a bijection between the two lists.
332 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
333 -- The order of the list does not matter.
334 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
337 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
338 ifCons = IfNewTyCon (
339 IfCon { ifConOcc = con_occ,
342 ifFamInst = famInst})
343 = -- fields (names of selectors)
345 -- implicit coerion and (possibly) family instance coercion
346 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
347 -- data constructor and worker (newtypes don't have a wrapper)
348 [con_occ, mkDataConWorkerOcc con_occ]
351 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
352 ifCons = IfDataTyCon cons,
353 ifFamInst = famInst})
354 = -- fields (names of selectors)
355 nub (concatMap ifConFields cons) -- Eliminate duplicate fields
356 -- (possibly) family instance coercion;
357 -- there is no implicit coercion for non-newtypes
358 ++ famInstCo famInst tc_occ
359 -- for each data constructor in order,
360 -- data constructor, worker, and (possibly) wrapper
361 ++ concatMap dc_occs cons
364 | has_wrapper = [con_occ, work_occ, wrap_occ]
365 | otherwise = [con_occ, work_occ]
367 con_occ = ifConOcc con_decl -- DataCon namespace
368 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
369 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
370 strs = ifConStricts con_decl
371 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
372 || not (null . ifConEqSpec $ con_decl)
374 -- ToDo: may miss strictness in existential dicts
376 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
377 ifSigs = sigs, ifATs = ats })
378 = -- dictionary datatype:
381 -- (possibly) newtype coercion
383 -- data constructor (DataCon namespace)
384 -- data worker (Id namespace)
385 -- no wrapper (class dictionaries never have a wrapper)
386 [dc_occ, dcww_occ] ++
388 [ifName at | at <- ats ] ++
389 -- superclass selectors
390 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
391 -- operation selectors
392 [op | IfaceClassOp op _ _ <- sigs]
394 n_ctxt = length sc_ctxt
396 tc_occ = mkClassTyConOcc cls_occ
397 dc_occ = mkClassDataConOcc cls_occ
398 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
400 dcww_occ = mkDataConWorkerOcc dc_occ
401 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
403 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
404 ifFamInst = famInst})
405 = famInstCo famInst tc_occ
407 ifaceDeclSubBndrs _ = []
409 -- coercion for data/newtype family instances
410 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
411 famInstCo Nothing _ = []
412 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
414 ----------------------------- Printing IfaceDecl ------------------------------
416 instance Outputable IfaceDecl where
419 pprIfaceDecl :: IfaceDecl -> SDoc
420 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
421 = sep [ ppr var <+> dcolon <+> ppr ty,
424 pprIfaceDecl (IfaceForeign {ifName = tycon})
425 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
427 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
428 ifSynRhs = Just mono_ty,
429 ifFamInst = mbFamInst})
430 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
431 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
433 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
434 ifSynRhs = Nothing, ifSynKind = kind })
435 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
436 4 (dcolon <+> ppr kind)
438 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
439 ifTyVars = tyvars, ifCons = condecls,
440 ifRec = isrec, ifFamInst = mbFamInst})
441 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
442 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
443 pprFamily mbFamInst])
445 pp_nd = case condecls of
446 IfAbstractTyCon -> ptext (sLit "data")
447 IfOpenDataTyCon -> ptext (sLit "data family")
448 IfDataTyCon _ -> ptext (sLit "data")
449 IfNewTyCon _ -> ptext (sLit "newtype")
451 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
452 ifFDs = fds, ifATs = ats, ifSigs = sigs,
454 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
455 4 (vcat [pprRec isrec,
459 pprRec :: RecFlag -> SDoc
460 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
462 pprGen :: Bool -> SDoc
463 pprGen True = ptext (sLit "Generics: yes")
464 pprGen False = ptext (sLit "Generics: no")
466 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
467 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
468 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
470 instance Outputable IfaceClassOp where
471 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
473 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
474 pprIfaceDeclHead context thing tyvars
475 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
476 pprIfaceTvBndrs tyvars]
478 pp_condecls :: OccName -> IfaceConDecls -> SDoc
479 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
480 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
481 pp_condecls _ IfOpenDataTyCon = empty
482 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
483 (map (pprIfaceConDecl tc) cs))
485 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
487 (IfCon { ifConOcc = name, ifConInfix = is_infix,
488 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
489 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
490 ifConStricts = strs, ifConFields = fields })
492 if is_infix then ptext (sLit "Infix") else empty,
493 if null strs then empty
494 else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
495 if null fields then empty
496 else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
498 main_payload = ppr name <+> dcolon <+>
499 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
501 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
502 | (tv,ty) <- eq_spec]
504 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
505 -- because we don't have a Name for the tycon, only an OccName
506 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
507 (t:ts) -> fsep (t : map (arrow <+>) ts)
508 [] -> panic "pp_con_taus"
510 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
512 instance Outputable IfaceRule where
513 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
514 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
515 = sep [hsep [doubleQuotes (ftext name), ppr act,
516 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
517 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
518 ptext (sLit "=") <+> ppr rhs])
521 instance Outputable IfaceInst where
522 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
523 ifInstCls = cls, ifInstTys = mb_tcs})
524 = hang (ptext (sLit "instance") <+> ppr flag
525 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
526 2 (equals <+> ppr dfun_id)
528 instance Outputable IfaceFamInst where
529 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
530 ifFamInstTyCon = tycon_id})
531 = hang (ptext (sLit "family instance") <+>
532 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
533 2 (equals <+> ppr tycon_id)
535 ppr_rough :: Maybe IfaceTyCon -> SDoc
536 ppr_rough Nothing = dot
537 ppr_rough (Just tc) = ppr tc
541 ----------------------------- Printing IfaceExpr ------------------------------------
544 instance Outputable IfaceExpr where
545 ppr e = pprIfaceExpr noParens e
547 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
548 -- The function adds parens in context that need
549 -- an atomic value (e.g. function args)
551 pprIfaceExpr _ (IfaceLcl v) = ppr v
552 pprIfaceExpr _ (IfaceExt v) = ppr v
553 pprIfaceExpr _ (IfaceLit l) = ppr l
554 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
555 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
556 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
558 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
559 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
561 pprIfaceExpr add_par e@(IfaceLam _ _)
562 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
563 pprIfaceExpr noParens body])
565 (bndrs,body) = collect [] e
566 collect bs (IfaceLam b e) = collect (b:bs) e
567 collect bs e = (reverse bs, e)
569 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
570 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
571 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
572 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
573 pprIfaceExpr noParens rhs <+> char '}'])
575 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
576 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
577 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
578 <+> ppr bndr <+> char '{',
579 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
581 pprIfaceExpr _ (IfaceCast expr co)
582 = sep [pprIfaceExpr parens expr,
583 nest 2 (ptext (sLit "`cast`")),
584 pprParendIfaceType co]
586 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
587 = add_par (sep [ptext (sLit "let {"),
588 nest 2 (ppr_bind (b, rhs)),
590 pprIfaceExpr noParens body])
592 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
593 = add_par (sep [ptext (sLit "letrec {"),
594 nest 2 (sep (map ppr_bind pairs)),
596 pprIfaceExpr noParens body])
598 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
600 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
601 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
602 arrow <+> pprIfaceExpr noParens rhs]
604 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
605 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
606 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
608 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
609 ppr_bind (IfLetBndr b ty info, rhs)
610 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
611 equals <+> pprIfaceExpr noParens rhs]
614 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
615 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
616 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
619 instance Outputable IfaceNote where
620 ppr (IfaceSCC cc) = pprCostCentreCore cc
621 ppr IfaceInlineMe = ptext (sLit "__inline_me")
622 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
625 instance Outputable IfaceConAlt where
626 ppr IfaceDefault = text "DEFAULT"
627 ppr (IfaceLitAlt l) = ppr l
628 ppr (IfaceDataAlt d) = ppr d
629 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
630 -- IfaceTupleAlt is handled by the case-alternative printer
633 instance Outputable IfaceIdInfo where
635 ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
637 instance Outputable IfaceInfoItem where
638 ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+>
639 parens (pprIfaceExpr noParens unf)
640 ppr (HsInline act) = ptext (sLit "Inline:") <+> ppr act
641 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
642 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
643 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
644 ppr (HsWorker w a) = ptext (sLit "Worker:") <+> ppr w <+> int a
647 -- -----------------------------------------------------------------------------
648 -- Finding the Names in IfaceSyn
650 -- This is used for dependency analysis in MkIface, so that we
651 -- fingerprint a declaration before the things that depend on it. It
652 -- is specific to interface-file fingerprinting in the sense that we
653 -- don't collect *all* Names: for example, the DFun of an instance is
654 -- recorded textually rather than by its fingerprint when
655 -- fingerprinting the instance, so DFuns are not dependencies.
657 freeNamesIfDecl :: IfaceDecl -> NameSet
658 freeNamesIfDecl (IfaceId _s t i) =
659 freeNamesIfType t &&&
661 freeNamesIfDecl IfaceForeign{} =
663 freeNamesIfDecl d@IfaceData{} =
664 freeNamesIfTvBndrs (ifTyVars d) &&&
665 freeNamesIfTcFam (ifFamInst d) &&&
666 freeNamesIfContext (ifCtxt d) &&&
667 freeNamesIfConDecls (ifCons d)
668 freeNamesIfDecl d@IfaceSyn{} =
669 freeNamesIfTvBndrs (ifTyVars d) &&&
670 freeNamesIfSynRhs (ifSynRhs d) &&&
671 freeNamesIfTcFam (ifFamInst d)
672 freeNamesIfDecl d@IfaceClass{} =
673 freeNamesIfTvBndrs (ifTyVars d) &&&
674 freeNamesIfContext (ifCtxt d) &&&
675 freeNamesIfDecls (ifATs d) &&&
676 fnList freeNamesIfClsSig (ifSigs d)
678 -- All other changes are handled via the version info on the tycon
679 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
680 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
681 freeNamesIfSynRhs Nothing = emptyNameSet
683 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
684 freeNamesIfTcFam (Just (tc,tys)) =
685 freeNamesIfTc tc &&& fnList freeNamesIfType tys
686 freeNamesIfTcFam Nothing =
689 freeNamesIfContext :: IfaceContext -> NameSet
690 freeNamesIfContext = fnList freeNamesIfPredType
692 freeNamesIfDecls :: [IfaceDecl] -> NameSet
693 freeNamesIfDecls = fnList freeNamesIfDecl
695 freeNamesIfClsSig :: IfaceClassOp -> NameSet
696 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
698 freeNamesIfConDecls :: IfaceConDecls -> NameSet
699 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
700 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
701 freeNamesIfConDecls _ = emptyNameSet
703 freeNamesIfConDecl :: IfaceConDecl -> NameSet
704 freeNamesIfConDecl c =
705 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
706 freeNamesIfTvBndrs (ifConExTvs c) &&&
707 freeNamesIfContext (ifConCtxt c) &&&
708 fnList freeNamesIfType (ifConArgTys c) &&&
709 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
711 freeNamesIfPredType :: IfacePredType -> NameSet
712 freeNamesIfPredType (IfaceClassP cl tys) =
713 unitNameSet cl &&& fnList freeNamesIfType tys
714 freeNamesIfPredType (IfaceIParam _n ty) =
716 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
717 freeNamesIfType ty1 &&& freeNamesIfType ty2
719 freeNamesIfType :: IfaceType -> NameSet
720 freeNamesIfType (IfaceTyVar _) = emptyNameSet
721 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
722 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
723 freeNamesIfType (IfaceTyConApp tc ts) =
724 freeNamesIfTc tc &&& fnList freeNamesIfType ts
725 freeNamesIfType (IfaceForAllTy tv t) =
726 freeNamesIfTvBndr tv &&& freeNamesIfType t
727 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
729 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
730 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
732 freeNamesIfBndr :: IfaceBndr -> NameSet
733 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
734 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
736 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
737 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
738 -- kinds can have Names inside, when the Kind is an equality predicate
740 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
741 freeNamesIfIdBndr = freeNamesIfTvBndr
743 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
744 freeNamesIfIdInfo NoInfo = emptyNameSet
745 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
747 freeNamesItem :: IfaceInfoItem -> NameSet
748 freeNamesItem (HsUnfold u) = freeNamesIfExpr u
749 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
750 freeNamesItem _ = emptyNameSet
752 freeNamesIfExpr :: IfaceExpr -> NameSet
753 freeNamesIfExpr (IfaceExt v) = unitNameSet v
754 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
755 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
756 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
757 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
758 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
759 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
760 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
762 freeNamesIfExpr (IfaceCase s _ ty alts)
763 = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
765 -- no need to look at the constructor, because we'll already have its
766 -- parent recorded by the type on the case expression.
767 freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
769 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
770 = freeNamesIfExpr r &&& freeNamesIfExpr x
772 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
773 = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
775 freeNamesIfExpr _ = emptyNameSet
778 freeNamesIfTc :: IfaceTyCon -> NameSet
779 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
780 -- ToDo: shouldn't we include IfaceIntTc & co.?
781 freeNamesIfTc _ = emptyNameSet
783 freeNamesIfRule :: IfaceRule -> NameSet
784 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
786 fnList freeNamesIfBndr bs &&&
787 fnList freeNamesIfExpr es &&&
791 (&&&) :: NameSet -> NameSet -> NameSet
792 (&&&) = unionNameSets
794 fnList :: (a -> NameSet) -> [a] -> NameSet
795 fnList f = foldr (&&&) emptyNameSet . map f