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 ifOpenSyn :: Bool, -- Is an open family?
85 ifSynRhs :: IfaceType, -- Type for an ordinary
86 -- synonym and kind for an
88 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
89 -- Just <=> instance of family
90 -- Invariant: ifOpenSyn == False
91 -- for family instances
94 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
95 ifName :: OccName, -- Name of the class
96 ifTyVars :: [IfaceTvBndr], -- Type variables
97 ifFDs :: [FunDep FastString], -- Functional dependencies
98 ifATs :: [IfaceDecl], -- Associated type families
99 ifSigs :: [IfaceClassOp], -- Method signatures
100 ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
103 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
105 ifExtName :: Maybe FastString }
107 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
108 -- Nothing => no default method
109 -- Just False => ordinary polymorphic default method
110 -- Just True => generic default method
113 = IfAbstractTyCon -- No info
114 | IfOpenDataTyCon -- Open data family
115 | IfDataTyCon [IfaceConDecl] -- data type decls
116 | IfNewTyCon IfaceConDecl -- newtype decls
118 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
119 visibleIfConDecls IfAbstractTyCon = []
120 visibleIfConDecls IfOpenDataTyCon = []
121 visibleIfConDecls (IfDataTyCon cs) = cs
122 visibleIfConDecls (IfNewTyCon c) = [c]
126 ifConOcc :: OccName, -- Constructor name
127 ifConInfix :: Bool, -- True <=> declared infix
128 ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
129 ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
130 ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
131 ifConCtxt :: IfaceContext, -- Non-stupid context
132 ifConArgTys :: [IfaceType], -- Arg types
133 ifConFields :: [OccName], -- ...ditto... (field labels)
134 ifConStricts :: [StrictnessMark]} -- Empty (meaning all lazy),
135 -- or 1-1 corresp with arg tys
138 = IfaceInst { ifInstCls :: Name, -- See comments with
139 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
140 ifDFun :: Name, -- The dfun
141 ifOFlag :: OverlapFlag, -- Overlap flag
142 ifInstOrph :: Maybe OccName } -- See Note [Orphans]
143 -- There's always a separate IfaceDecl for the DFun, which gives
144 -- its IdInfo with its full type and version number.
145 -- The instance declarations taken together have a version number,
146 -- and we don't want that to wobble gratuitously
147 -- If this instance decl is *used*, we'll record a usage on the dfun;
148 -- and if the head does not change it won't be used if it wasn't before
151 = IfaceFamInst { ifFamInstFam :: Name -- Family tycon
152 , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
153 , ifFamInstTyCon :: IfaceTyCon -- Instance decl
158 ifRuleName :: RuleName,
159 ifActivation :: Activation,
160 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
161 ifRuleHead :: Name, -- Head of lhs
162 ifRuleArgs :: [IfaceExpr], -- Args of LHS
163 ifRuleRhs :: IfaceExpr,
164 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
168 = NoInfo -- When writing interface file without -O
169 | HasInfo [IfaceInfoItem] -- Has info, and here it is
171 -- Here's a tricky case:
172 -- * Compile with -O module A, and B which imports A.f
173 -- * Change function f in A, and recompile without -O
174 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
175 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
176 -- but we do not do that now. Instead it's discarded when the
177 -- ModIface is read into the various decl pools.)
178 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
179 -- and so gives a new version.
183 | HsStrictness StrictSig
184 | HsInline Activation
187 | HsWorker Name Arity -- Worker, if any see IdInfo.WorkerInfo
188 -- for why we want arity here.
189 -- NB: we need IfaceExtName (not just OccName) because the worker
190 -- can simplify to a function in another module.
191 -- NB: Specialisations and rules come in separately and are
192 -- only later attached to the Id. Partial reason: some are orphans.
194 --------------------------------
196 = IfaceLcl FastString
198 | IfaceType IfaceType
199 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
200 | IfaceLam IfaceBndr IfaceExpr
201 | IfaceApp IfaceExpr IfaceExpr
202 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
203 | IfaceLet IfaceBinding IfaceExpr
204 | IfaceNote IfaceNote IfaceExpr
205 | IfaceCast IfaceExpr IfaceCoercion
207 | IfaceFCall ForeignCall IfaceType
208 | IfaceTick Module Int
210 data IfaceNote = IfaceSCC CostCentre
212 | IfaceCoreNote String
214 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
215 -- Note: FastString, not IfaceBndr (and same with the case binder)
216 -- We reconstruct the kind/type of the thing from the context
217 -- thus saving bulk in interface files
219 data IfaceConAlt = IfaceDefault
221 | IfaceTupleAlt Boxity
222 | IfaceLitAlt Literal
225 = IfaceNonRec IfaceLetBndr IfaceExpr
226 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
228 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
229 -- It's used for *non-top-level* let/rec binders
230 -- See Note [IdInfo on nested let-bindings]
231 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
234 Note [IdInfo on nested let-bindings]
235 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
236 Occasionally we want to preserve IdInfo on nested let bindings. The one
237 that came up was a NOINLINE pragma on a let-binding inside an INLINE
238 function. The user (Duncan Coutts) really wanted the NOINLINE control
239 to cross the separate compilation boundary.
241 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
242 Currently we only actually retain InlinePragInfo, but in principle we could
246 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
247 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
248 If a module contains any "orphans", then its interface file is read
249 regardless, so that its instances are not missed.
251 Roughly speaking, an instance is an orphan if its head (after the =>)
252 mentions nothing defined in this module. Functional dependencies
253 complicate the situation though. Consider
255 module M where { class C a b | a -> b }
257 and suppose we are compiling module X:
262 instance C Int T where ...
264 This instance is an orphan, because when compiling a third module Y we
265 might get a constraint (C Int v), and we'd want to improve v to T. So
266 we must make sure X's instances are loaded, even if we do not directly
269 More precisely, an instance is an orphan iff
271 If there are no fundeps, then at least of the names in
272 the instance head is locally defined.
274 If there are fundeps, then for every fundep, at least one of the
275 names free in a *non-determined* part of the instance head is
276 defined in this module.
278 (Note that these conditions hold trivially if the class is locally
281 Note [Versioning of instances]
282 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
283 Now consider versioning. If we *use* an instance decl in one compilation,
284 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
285 But suppose we *don't* (currently) use an instance! We must recompile if
286 the instance is changed in such a way that it becomes important. (This would
287 only matter with overlapping instances, else the importing module wouldn't have
288 compiled before and the recompilation check is irrelevant.)
290 The is_orph field is set to (Just n) if the instance is not an orphan.
291 The 'n' is *any* of the locally-defined names mentioned anywhere in the
292 instance head. This name is used for versioning; the instance decl is
293 considered part of the defn of this 'n'.
295 I'm worried about whether this works right if we pick a name from
296 a functionally-dependent part of the instance decl. E.g.
298 module M where { class C a b | a -> b }
300 and suppose we are compiling module X:
306 instance C S T where ...
308 If we base the instance verion on T, I'm worried that changing S to S'
309 would change T's version, but not S or S'. But an importing module might
310 not depend on T, and so might not be recompiled even though the new instance
311 (C S' T) might be relevant. I have not been able to make a concrete example,
312 and it seems deeply obscure, so I'm going to leave it for now.
315 Note [Versioning of rules]
316 ~~~~~~~~~~~~~~~~~~~~~~~~~~
317 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
318 n appears on the LHS of the rule; any change in the rule changes the version of n.
322 -- -----------------------------------------------------------------------------
325 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
326 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
327 -- Deeply revolting, because it has to predict what gets bound,
328 -- especially the question of whether there's a wrapper for a datacon
330 -- N.B. the set of names returned here *must* match the set of
331 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
332 -- TyThing.getOccName should define a bijection between the two lists.
333 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
334 -- The order of the list does not matter.
335 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
338 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
339 ifCons = IfNewTyCon (
340 IfCon { ifConOcc = con_occ,
343 ifFamInst = famInst})
344 = -- fields (names of selectors)
346 -- implicit coerion and (possibly) family instance coercion
347 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
348 -- data constructor and worker (newtypes don't have a wrapper)
349 [con_occ, mkDataConWorkerOcc con_occ]
352 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
353 ifCons = IfDataTyCon cons,
354 ifFamInst = famInst})
355 = -- fields (names of selectors)
356 nub (concatMap ifConFields cons) -- Eliminate duplicate fields
357 -- (possibly) family instance coercion;
358 -- there is no implicit coercion for non-newtypes
359 ++ famInstCo famInst tc_occ
360 -- for each data constructor in order,
361 -- data constructor, worker, and (possibly) wrapper
362 ++ concatMap dc_occs cons
365 | has_wrapper = [con_occ, work_occ, wrap_occ]
366 | otherwise = [con_occ, work_occ]
368 con_occ = ifConOcc con_decl -- DataCon namespace
369 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
370 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
371 strs = ifConStricts con_decl
372 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
373 || not (null . ifConEqSpec $ con_decl)
375 -- ToDo: may miss strictness in existential dicts
377 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
378 ifSigs = sigs, ifATs = ats })
379 = -- dictionary datatype:
382 -- (possibly) newtype coercion
384 -- data constructor (DataCon namespace)
385 -- data worker (Id namespace)
386 -- no wrapper (class dictionaries never have a wrapper)
387 [dc_occ, dcww_occ] ++
389 [ifName at | at <- ats ] ++
390 -- superclass selectors
391 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
392 -- operation selectors
393 [op | IfaceClassOp op _ _ <- sigs]
395 n_ctxt = length sc_ctxt
397 tc_occ = mkClassTyConOcc cls_occ
398 dc_occ = mkClassDataConOcc cls_occ
399 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
401 dcww_occ = mkDataConWorkerOcc dc_occ
402 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
404 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
405 ifFamInst = famInst})
406 = famInstCo famInst tc_occ
408 ifaceDeclSubBndrs _ = []
410 -- coercion for data/newtype family instances
411 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
412 famInstCo Nothing _ = []
413 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
415 ----------------------------- Printing IfaceDecl ------------------------------
417 instance Outputable IfaceDecl where
420 pprIfaceDecl :: IfaceDecl -> SDoc
421 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
422 = sep [ ppr var <+> dcolon <+> ppr ty,
425 pprIfaceDecl (IfaceForeign {ifName = tycon})
426 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
428 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
429 ifOpenSyn = False, ifSynRhs = mono_ty,
430 ifFamInst = mbFamInst})
431 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
432 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
434 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
435 ifOpenSyn = True, ifSynRhs = mono_ty})
436 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
437 4 (dcolon <+> ppr mono_ty)
439 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
440 ifTyVars = tyvars, ifCons = condecls,
441 ifRec = isrec, ifFamInst = mbFamInst})
442 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
443 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
444 pprFamily mbFamInst])
446 pp_nd = case condecls of
447 IfAbstractTyCon -> ptext (sLit "data")
448 IfOpenDataTyCon -> ptext (sLit "data family")
449 IfDataTyCon _ -> ptext (sLit "data")
450 IfNewTyCon _ -> ptext (sLit "newtype")
452 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
453 ifFDs = fds, ifATs = ats, ifSigs = sigs,
455 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
456 4 (vcat [pprRec isrec,
460 pprRec :: RecFlag -> SDoc
461 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
463 pprGen :: Bool -> SDoc
464 pprGen True = ptext (sLit "Generics: yes")
465 pprGen False = ptext (sLit "Generics: no")
467 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
468 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
469 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
471 instance Outputable IfaceClassOp where
472 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
474 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
475 pprIfaceDeclHead context thing tyvars
476 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
477 pprIfaceTvBndrs tyvars]
479 pp_condecls :: OccName -> IfaceConDecls -> SDoc
480 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
481 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
482 pp_condecls _ IfOpenDataTyCon = empty
483 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
484 (map (pprIfaceConDecl tc) cs))
486 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
488 (IfCon { ifConOcc = name, ifConInfix = is_infix,
489 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
490 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
491 ifConStricts = strs, ifConFields = fields })
493 if is_infix then ptext (sLit "Infix") else empty,
494 if null strs then empty
495 else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
496 if null fields then empty
497 else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
499 main_payload = ppr name <+> dcolon <+>
500 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
502 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
503 | (tv,ty) <- eq_spec]
505 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
506 -- because we don't have a Name for the tycon, only an OccName
507 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
508 (t:ts) -> fsep (t : map (arrow <+>) ts)
509 [] -> panic "pp_con_taus"
511 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
513 instance Outputable IfaceRule where
514 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
515 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
516 = sep [hsep [doubleQuotes (ftext name), ppr act,
517 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
518 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
519 ptext (sLit "=") <+> ppr rhs])
522 instance Outputable IfaceInst where
523 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
524 ifInstCls = cls, ifInstTys = mb_tcs})
525 = hang (ptext (sLit "instance") <+> ppr flag
526 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
527 2 (equals <+> ppr dfun_id)
529 instance Outputable IfaceFamInst where
530 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
531 ifFamInstTyCon = tycon_id})
532 = hang (ptext (sLit "family instance") <+>
533 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
534 2 (equals <+> ppr tycon_id)
536 ppr_rough :: Maybe IfaceTyCon -> SDoc
537 ppr_rough Nothing = dot
538 ppr_rough (Just tc) = ppr tc
542 ----------------------------- Printing IfaceExpr ------------------------------------
545 instance Outputable IfaceExpr where
546 ppr e = pprIfaceExpr noParens e
548 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
549 -- The function adds parens in context that need
550 -- an atomic value (e.g. function args)
552 pprIfaceExpr _ (IfaceLcl v) = ppr v
553 pprIfaceExpr _ (IfaceExt v) = ppr v
554 pprIfaceExpr _ (IfaceLit l) = ppr l
555 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
556 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
557 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
559 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
560 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
562 pprIfaceExpr add_par e@(IfaceLam _ _)
563 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
564 pprIfaceExpr noParens body])
566 (bndrs,body) = collect [] e
567 collect bs (IfaceLam b e) = collect (b:bs) e
568 collect bs e = (reverse bs, e)
570 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
571 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
572 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
573 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
574 pprIfaceExpr noParens rhs <+> char '}'])
576 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
577 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
578 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
579 <+> ppr bndr <+> char '{',
580 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
582 pprIfaceExpr _ (IfaceCast expr co)
583 = sep [pprIfaceExpr parens expr,
584 nest 2 (ptext (sLit "`cast`")),
585 pprParendIfaceType co]
587 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
588 = add_par (sep [ptext (sLit "let {"),
589 nest 2 (ppr_bind (b, rhs)),
591 pprIfaceExpr noParens body])
593 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
594 = add_par (sep [ptext (sLit "letrec {"),
595 nest 2 (sep (map ppr_bind pairs)),
597 pprIfaceExpr noParens body])
599 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
601 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
602 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
603 arrow <+> pprIfaceExpr noParens rhs]
605 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
606 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
607 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
609 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
610 ppr_bind (IfLetBndr b ty info, rhs)
611 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
612 equals <+> pprIfaceExpr noParens rhs]
615 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
616 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
617 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
620 instance Outputable IfaceNote where
621 ppr (IfaceSCC cc) = pprCostCentreCore cc
622 ppr IfaceInlineMe = ptext (sLit "__inline_me")
623 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
626 instance Outputable IfaceConAlt where
627 ppr IfaceDefault = text "DEFAULT"
628 ppr (IfaceLitAlt l) = ppr l
629 ppr (IfaceDataAlt d) = ppr d
630 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
631 -- IfaceTupleAlt is handled by the case-alternative printer
634 instance Outputable IfaceIdInfo where
636 ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
638 instance Outputable IfaceInfoItem where
639 ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+>
640 parens (pprIfaceExpr noParens unf)
641 ppr (HsInline act) = ptext (sLit "Inline:") <+> ppr act
642 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
643 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
644 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
645 ppr (HsWorker w a) = ptext (sLit "Worker:") <+> ppr w <+> int a
648 -- -----------------------------------------------------------------------------
649 -- Finding the Names in IfaceSyn
651 -- This is used for dependency analysis in MkIface, so that we
652 -- fingerprint a declaration before the things that depend on it. It
653 -- is specific to interface-file fingerprinting in the sense that we
654 -- don't collect *all* Names: for example, the DFun of an instance is
655 -- recorded textually rather than by its fingerprint when
656 -- fingerprinting the instance, so DFuns are not dependencies.
658 freeNamesIfDecl :: IfaceDecl -> NameSet
659 freeNamesIfDecl (IfaceId _s t i) =
660 freeNamesIfType t &&&
662 freeNamesIfDecl IfaceForeign{} =
664 freeNamesIfDecl d@IfaceData{} =
665 freeNamesIfTvBndrs (ifTyVars d) &&&
666 freeNamesIfTcFam (ifFamInst d) &&&
667 freeNamesIfContext (ifCtxt d) &&&
668 freeNamesIfConDecls (ifCons d)
669 freeNamesIfDecl d@IfaceSyn{} =
670 freeNamesIfTvBndrs (ifTyVars d) &&&
671 freeNamesIfType (ifSynRhs d) &&&
672 freeNamesIfTcFam (ifFamInst d)
673 freeNamesIfDecl d@IfaceClass{} =
674 freeNamesIfTvBndrs (ifTyVars d) &&&
675 freeNamesIfContext (ifCtxt d) &&&
676 freeNamesIfDecls (ifATs d) &&&
677 fnList freeNamesIfClsSig (ifSigs d)
679 -- All other changes are handled via the version info on the tycon
680 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
681 freeNamesIfTcFam (Just (tc,tys)) =
682 freeNamesIfTc tc &&& fnList freeNamesIfType tys
683 freeNamesIfTcFam Nothing =
686 freeNamesIfContext :: IfaceContext -> NameSet
687 freeNamesIfContext = fnList freeNamesIfPredType
689 freeNamesIfDecls :: [IfaceDecl] -> NameSet
690 freeNamesIfDecls = fnList freeNamesIfDecl
692 freeNamesIfClsSig :: IfaceClassOp -> NameSet
693 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
695 freeNamesIfConDecls :: IfaceConDecls -> NameSet
696 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
697 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
698 freeNamesIfConDecls _ = emptyNameSet
700 freeNamesIfConDecl :: IfaceConDecl -> NameSet
701 freeNamesIfConDecl c =
702 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
703 freeNamesIfTvBndrs (ifConExTvs c) &&&
704 freeNamesIfContext (ifConCtxt c) &&&
705 fnList freeNamesIfType (ifConArgTys c) &&&
706 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
708 freeNamesIfPredType :: IfacePredType -> NameSet
709 freeNamesIfPredType (IfaceClassP cl tys) =
710 unitNameSet cl &&& fnList freeNamesIfType tys
711 freeNamesIfPredType (IfaceIParam _n ty) =
713 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
714 freeNamesIfType ty1 &&& freeNamesIfType ty2
716 freeNamesIfType :: IfaceType -> NameSet
717 freeNamesIfType (IfaceTyVar _) = emptyNameSet
718 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
719 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
720 freeNamesIfType (IfaceTyConApp tc ts) =
721 freeNamesIfTc tc &&& fnList freeNamesIfType ts
722 freeNamesIfType (IfaceForAllTy tv t) =
723 freeNamesIfTvBndr tv &&& freeNamesIfType t
724 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
726 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
727 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
729 freeNamesIfBndr :: IfaceBndr -> NameSet
730 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
731 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
733 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
734 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
735 -- kinds can have Names inside, when the Kind is an equality predicate
737 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
738 freeNamesIfIdBndr = freeNamesIfTvBndr
740 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
741 freeNamesIfIdInfo NoInfo = emptyNameSet
742 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
744 freeNamesItem :: IfaceInfoItem -> NameSet
745 freeNamesItem (HsUnfold u) = freeNamesIfExpr u
746 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
747 freeNamesItem _ = emptyNameSet
749 freeNamesIfExpr :: IfaceExpr -> NameSet
750 freeNamesIfExpr (IfaceExt v) = unitNameSet v
751 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
752 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
753 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
754 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
755 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
756 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
757 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
759 freeNamesIfExpr (IfaceCase s _ ty alts)
760 = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
762 -- no need to look at the constructor, because we'll already have its
763 -- parent recorded by the type on the case expression.
764 freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
766 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
767 = freeNamesIfExpr r &&& freeNamesIfExpr x
769 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
770 = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
772 freeNamesIfExpr _ = emptyNameSet
775 freeNamesIfTc :: IfaceTyCon -> NameSet
776 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
777 -- ToDo: shouldn't we include IfaceIntTc & co.?
778 freeNamesIfTc _ = emptyNameSet
780 freeNamesIfRule :: IfaceRule -> NameSet
781 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
783 fnList freeNamesIfBndr bs &&&
784 fnList freeNamesIfExpr es &&&
788 (&&&) :: NameSet -> NameSet -> NameSet
789 (&&&) = unionNameSets
791 fnList :: (a -> NameSet) -> [a] -> NameSet
792 fnList f = foldr (&&&) emptyNameSet . map f