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(..), IfaceUnfolding(..),
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
195 | HsUnfold IfaceUnfolding
198 -- NB: Specialisations and rules come in separately and are
199 -- only later attached to the Id. Partial reason: some are orphans.
202 = IfCoreUnfold IfaceExpr
203 | IfInlineRule Arity IfaceExpr
204 | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
205 -- can simplify to a function in another module.
207 --------------------------------
209 = IfaceLcl FastString
211 | IfaceType IfaceType
212 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
213 | IfaceLam IfaceBndr IfaceExpr
214 | IfaceApp IfaceExpr IfaceExpr
215 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
216 | IfaceLet IfaceBinding IfaceExpr
217 | IfaceNote IfaceNote IfaceExpr
218 | IfaceCast IfaceExpr IfaceCoercion
220 | IfaceFCall ForeignCall IfaceType
221 | IfaceTick Module Int
223 data IfaceNote = IfaceSCC CostCentre
224 | IfaceCoreNote String
226 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
227 -- Note: FastString, not IfaceBndr (and same with the case binder)
228 -- We reconstruct the kind/type of the thing from the context
229 -- thus saving bulk in interface files
231 data IfaceConAlt = IfaceDefault
233 | IfaceTupleAlt Boxity
234 | IfaceLitAlt Literal
237 = IfaceNonRec IfaceLetBndr IfaceExpr
238 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
240 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
241 -- It's used for *non-top-level* let/rec binders
242 -- See Note [IdInfo on nested let-bindings]
243 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
246 Note [IdInfo on nested let-bindings]
247 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
248 Occasionally we want to preserve IdInfo on nested let bindings. The one
249 that came up was a NOINLINE pragma on a let-binding inside an INLINE
250 function. The user (Duncan Coutts) really wanted the NOINLINE control
251 to cross the separate compilation boundary.
253 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
254 Currently we only actually retain InlinePragInfo, but in principle we could
258 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
259 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
260 If a module contains any "orphans", then its interface file is read
261 regardless, so that its instances are not missed.
263 Roughly speaking, an instance is an orphan if its head (after the =>)
264 mentions nothing defined in this module. Functional dependencies
265 complicate the situation though. Consider
267 module M where { class C a b | a -> b }
269 and suppose we are compiling module X:
274 instance C Int T where ...
276 This instance is an orphan, because when compiling a third module Y we
277 might get a constraint (C Int v), and we'd want to improve v to T. So
278 we must make sure X's instances are loaded, even if we do not directly
281 More precisely, an instance is an orphan iff
283 If there are no fundeps, then at least of the names in
284 the instance head is locally defined.
286 If there are fundeps, then for every fundep, at least one of the
287 names free in a *non-determined* part of the instance head is
288 defined in this module.
290 (Note that these conditions hold trivially if the class is locally
293 Note [Versioning of instances]
294 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
295 Now consider versioning. If we *use* an instance decl in one compilation,
296 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
297 But suppose we *don't* (currently) use an instance! We must recompile if
298 the instance is changed in such a way that it becomes important. (This would
299 only matter with overlapping instances, else the importing module wouldn't have
300 compiled before and the recompilation check is irrelevant.)
302 The is_orph field is set to (Just n) if the instance is not an orphan.
303 The 'n' is *any* of the locally-defined names mentioned anywhere in the
304 instance head. This name is used for versioning; the instance decl is
305 considered part of the defn of this 'n'.
307 I'm worried about whether this works right if we pick a name from
308 a functionally-dependent part of the instance decl. E.g.
310 module M where { class C a b | a -> b }
312 and suppose we are compiling module X:
318 instance C S T where ...
320 If we base the instance verion on T, I'm worried that changing S to S'
321 would change T's version, but not S or S'. But an importing module might
322 not depend on T, and so might not be recompiled even though the new instance
323 (C S' T) might be relevant. I have not been able to make a concrete example,
324 and it seems deeply obscure, so I'm going to leave it for now.
327 Note [Versioning of rules]
328 ~~~~~~~~~~~~~~~~~~~~~~~~~~
329 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
330 n appears on the LHS of the rule; any change in the rule changes the version of n.
334 -- -----------------------------------------------------------------------------
337 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
338 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
339 -- Deeply revolting, because it has to predict what gets bound,
340 -- especially the question of whether there's a wrapper for a datacon
342 -- N.B. the set of names returned here *must* match the set of
343 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
344 -- TyThing.getOccName should define a bijection between the two lists.
345 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
346 -- The order of the list does not matter.
347 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
350 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
351 ifCons = IfNewTyCon (
352 IfCon { ifConOcc = con_occ,
355 ifFamInst = famInst})
356 = -- fields (names of selectors)
358 -- implicit coerion and (possibly) family instance coercion
359 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
360 -- data constructor and worker (newtypes don't have a wrapper)
361 [con_occ, mkDataConWorkerOcc con_occ]
364 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
365 ifCons = IfDataTyCon cons,
366 ifFamInst = famInst})
367 = -- fields (names of selectors)
368 nub (concatMap ifConFields cons) -- Eliminate duplicate fields
369 -- (possibly) family instance coercion;
370 -- there is no implicit coercion for non-newtypes
371 ++ famInstCo famInst tc_occ
372 -- for each data constructor in order,
373 -- data constructor, worker, and (possibly) wrapper
374 ++ concatMap dc_occs cons
377 | has_wrapper = [con_occ, work_occ, wrap_occ]
378 | otherwise = [con_occ, work_occ]
380 con_occ = ifConOcc con_decl -- DataCon namespace
381 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
382 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
383 strs = ifConStricts con_decl
384 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
385 || not (null . ifConEqSpec $ con_decl)
387 -- ToDo: may miss strictness in existential dicts
389 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
390 ifSigs = sigs, ifATs = ats })
391 = -- dictionary datatype:
394 -- (possibly) newtype coercion
396 -- data constructor (DataCon namespace)
397 -- data worker (Id namespace)
398 -- no wrapper (class dictionaries never have a wrapper)
399 [dc_occ, dcww_occ] ++
401 [ifName at | at <- ats ] ++
402 -- superclass selectors
403 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
404 -- operation selectors
405 [op | IfaceClassOp op _ _ <- sigs]
407 n_ctxt = length sc_ctxt
409 tc_occ = mkClassTyConOcc cls_occ
410 dc_occ = mkClassDataConOcc cls_occ
411 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
413 dcww_occ = mkDataConWorkerOcc dc_occ
414 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
416 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
417 ifFamInst = famInst})
418 = famInstCo famInst tc_occ
420 ifaceDeclSubBndrs _ = []
422 -- coercion for data/newtype family instances
423 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
424 famInstCo Nothing _ = []
425 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
427 ----------------------------- Printing IfaceDecl ------------------------------
429 instance Outputable IfaceDecl where
432 pprIfaceDecl :: IfaceDecl -> SDoc
433 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
434 = sep [ ppr var <+> dcolon <+> ppr ty,
437 pprIfaceDecl (IfaceForeign {ifName = tycon})
438 = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
440 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
441 ifSynRhs = Just mono_ty,
442 ifFamInst = mbFamInst})
443 = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
444 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
446 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
447 ifSynRhs = Nothing, ifSynKind = kind })
448 = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
449 4 (dcolon <+> ppr kind)
451 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
452 ifTyVars = tyvars, ifCons = condecls,
453 ifRec = isrec, ifFamInst = mbFamInst})
454 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
455 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
456 pprFamily mbFamInst])
458 pp_nd = case condecls of
459 IfAbstractTyCon -> ptext (sLit "data")
460 IfOpenDataTyCon -> ptext (sLit "data family")
461 IfDataTyCon _ -> ptext (sLit "data")
462 IfNewTyCon _ -> ptext (sLit "newtype")
464 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
465 ifFDs = fds, ifATs = ats, ifSigs = sigs,
467 = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
468 4 (vcat [pprRec isrec,
472 pprRec :: RecFlag -> SDoc
473 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
475 pprGen :: Bool -> SDoc
476 pprGen True = ptext (sLit "Generics: yes")
477 pprGen False = ptext (sLit "Generics: no")
479 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
480 pprFamily Nothing = ptext (sLit "FamilyInstance: none")
481 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
483 instance Outputable IfaceClassOp where
484 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
486 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
487 pprIfaceDeclHead context thing tyvars
488 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
489 pprIfaceTvBndrs tyvars]
491 pp_condecls :: OccName -> IfaceConDecls -> SDoc
492 pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
493 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
494 pp_condecls _ IfOpenDataTyCon = empty
495 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
496 (map (pprIfaceConDecl tc) cs))
498 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
500 (IfCon { ifConOcc = name, ifConInfix = is_infix,
501 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
502 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
503 ifConStricts = strs, ifConFields = fields })
505 if is_infix then ptext (sLit "Infix") else empty,
506 if null strs then empty
507 else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
508 if null fields then empty
509 else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
511 main_payload = ppr name <+> dcolon <+>
512 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
514 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
515 | (tv,ty) <- eq_spec]
517 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
518 -- because we don't have a Name for the tycon, only an OccName
519 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
520 (t:ts) -> fsep (t : map (arrow <+>) ts)
521 [] -> panic "pp_con_taus"
523 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
525 instance Outputable IfaceRule where
526 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
527 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
528 = sep [hsep [doubleQuotes (ftext name), ppr act,
529 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
530 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
531 ptext (sLit "=") <+> ppr rhs])
534 instance Outputable IfaceInst where
535 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
536 ifInstCls = cls, ifInstTys = mb_tcs})
537 = hang (ptext (sLit "instance") <+> ppr flag
538 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
539 2 (equals <+> ppr dfun_id)
541 instance Outputable IfaceFamInst where
542 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
543 ifFamInstTyCon = tycon_id})
544 = hang (ptext (sLit "family instance") <+>
545 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
546 2 (equals <+> ppr tycon_id)
548 ppr_rough :: Maybe IfaceTyCon -> SDoc
549 ppr_rough Nothing = dot
550 ppr_rough (Just tc) = ppr tc
554 ----------------------------- Printing IfaceExpr ------------------------------------
557 instance Outputable IfaceExpr where
558 ppr e = pprIfaceExpr noParens e
560 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
561 -- The function adds parens in context that need
562 -- an atomic value (e.g. function args)
564 pprIfaceExpr _ (IfaceLcl v) = ppr v
565 pprIfaceExpr _ (IfaceExt v) = ppr v
566 pprIfaceExpr _ (IfaceLit l) = ppr l
567 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
568 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
569 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
571 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
572 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
574 pprIfaceExpr add_par e@(IfaceLam _ _)
575 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
576 pprIfaceExpr noParens body])
578 (bndrs,body) = collect [] e
579 collect bs (IfaceLam b e) = collect (b:bs) e
580 collect bs e = (reverse bs, e)
582 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
583 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
584 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
585 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
586 pprIfaceExpr noParens rhs <+> char '}'])
588 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
589 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
590 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
591 <+> ppr bndr <+> char '{',
592 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
594 pprIfaceExpr _ (IfaceCast expr co)
595 = sep [pprIfaceExpr parens expr,
596 nest 2 (ptext (sLit "`cast`")),
597 pprParendIfaceType co]
599 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
600 = add_par (sep [ptext (sLit "let {"),
601 nest 2 (ppr_bind (b, rhs)),
603 pprIfaceExpr noParens body])
605 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
606 = add_par (sep [ptext (sLit "letrec {"),
607 nest 2 (sep (map ppr_bind pairs)),
609 pprIfaceExpr noParens body])
611 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
613 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
614 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
615 arrow <+> pprIfaceExpr noParens rhs]
617 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
618 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
619 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
621 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
622 ppr_bind (IfLetBndr b ty info, rhs)
623 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
624 equals <+> pprIfaceExpr noParens rhs]
627 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
628 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
629 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
632 instance Outputable IfaceNote where
633 ppr (IfaceSCC cc) = pprCostCentreCore cc
634 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
637 instance Outputable IfaceConAlt where
638 ppr IfaceDefault = text "DEFAULT"
639 ppr (IfaceLitAlt l) = ppr l
640 ppr (IfaceDataAlt d) = ppr d
641 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
642 -- IfaceTupleAlt is handled by the case-alternative printer
645 instance Outputable IfaceIdInfo where
647 ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
649 instance Outputable IfaceInfoItem where
650 ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+> ppr 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")
656 instance Outputable IfaceUnfolding where
657 ppr (IfCoreUnfold e) = parens (ppr e)
658 ppr (IfInlineRule a e) = ptext (sLit "INLINE:") <+> parens (ptext (sLit "arity") <+> int a) <+> parens (ppr e)
659 ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
662 -- -----------------------------------------------------------------------------
663 -- Finding the Names in IfaceSyn
665 -- This is used for dependency analysis in MkIface, so that we
666 -- fingerprint a declaration before the things that depend on it. It
667 -- is specific to interface-file fingerprinting in the sense that we
668 -- don't collect *all* Names: for example, the DFun of an instance is
669 -- recorded textually rather than by its fingerprint when
670 -- fingerprinting the instance, so DFuns are not dependencies.
672 freeNamesIfDecl :: IfaceDecl -> NameSet
673 freeNamesIfDecl (IfaceId _s t i) =
674 freeNamesIfType t &&&
676 freeNamesIfDecl IfaceForeign{} =
678 freeNamesIfDecl d@IfaceData{} =
679 freeNamesIfTvBndrs (ifTyVars d) &&&
680 freeNamesIfTcFam (ifFamInst d) &&&
681 freeNamesIfContext (ifCtxt d) &&&
682 freeNamesIfConDecls (ifCons d)
683 freeNamesIfDecl d@IfaceSyn{} =
684 freeNamesIfTvBndrs (ifTyVars d) &&&
685 freeNamesIfSynRhs (ifSynRhs d) &&&
686 freeNamesIfTcFam (ifFamInst d)
687 freeNamesIfDecl d@IfaceClass{} =
688 freeNamesIfTvBndrs (ifTyVars d) &&&
689 freeNamesIfContext (ifCtxt d) &&&
690 freeNamesIfDecls (ifATs d) &&&
691 fnList freeNamesIfClsSig (ifSigs d)
693 -- All other changes are handled via the version info on the tycon
694 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
695 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
696 freeNamesIfSynRhs Nothing = emptyNameSet
698 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
699 freeNamesIfTcFam (Just (tc,tys)) =
700 freeNamesIfTc tc &&& fnList freeNamesIfType tys
701 freeNamesIfTcFam Nothing =
704 freeNamesIfContext :: IfaceContext -> NameSet
705 freeNamesIfContext = fnList freeNamesIfPredType
707 freeNamesIfDecls :: [IfaceDecl] -> NameSet
708 freeNamesIfDecls = fnList freeNamesIfDecl
710 freeNamesIfClsSig :: IfaceClassOp -> NameSet
711 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
713 freeNamesIfConDecls :: IfaceConDecls -> NameSet
714 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
715 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
716 freeNamesIfConDecls _ = emptyNameSet
718 freeNamesIfConDecl :: IfaceConDecl -> NameSet
719 freeNamesIfConDecl c =
720 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
721 freeNamesIfTvBndrs (ifConExTvs c) &&&
722 freeNamesIfContext (ifConCtxt c) &&&
723 fnList freeNamesIfType (ifConArgTys c) &&&
724 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
726 freeNamesIfPredType :: IfacePredType -> NameSet
727 freeNamesIfPredType (IfaceClassP cl tys) =
728 unitNameSet cl &&& fnList freeNamesIfType tys
729 freeNamesIfPredType (IfaceIParam _n ty) =
731 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
732 freeNamesIfType ty1 &&& freeNamesIfType ty2
734 freeNamesIfType :: IfaceType -> NameSet
735 freeNamesIfType (IfaceTyVar _) = emptyNameSet
736 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
737 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
738 freeNamesIfType (IfaceTyConApp tc ts) =
739 freeNamesIfTc tc &&& fnList freeNamesIfType ts
740 freeNamesIfType (IfaceForAllTy tv t) =
741 freeNamesIfTvBndr tv &&& freeNamesIfType t
742 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
744 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
745 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
747 freeNamesIfBndr :: IfaceBndr -> NameSet
748 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
749 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
751 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
752 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
753 -- kinds can have Names inside, when the Kind is an equality predicate
755 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
756 freeNamesIfIdBndr = freeNamesIfTvBndr
758 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
759 freeNamesIfIdInfo NoInfo = emptyNameSet
760 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
762 freeNamesItem :: IfaceInfoItem -> NameSet
763 freeNamesItem (HsUnfold u) = freeNamesIfUnfold u
764 freeNamesItem _ = emptyNameSet
766 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
767 freeNamesIfUnfold (IfCoreUnfold e) = freeNamesIfExpr e
768 freeNamesIfUnfold (IfInlineRule _ e) = freeNamesIfExpr e
769 freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
771 freeNamesIfExpr :: IfaceExpr -> NameSet
772 freeNamesIfExpr (IfaceExt v) = unitNameSet v
773 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
774 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
775 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
776 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
777 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
778 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
779 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
781 freeNamesIfExpr (IfaceCase s _ ty alts)
782 = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
784 -- no need to look at the constructor, because we'll already have its
785 -- parent recorded by the type on the case expression.
786 freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
788 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
789 = freeNamesIfExpr r &&& freeNamesIfExpr x
791 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
792 = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
794 freeNamesIfExpr _ = emptyNameSet
797 freeNamesIfTc :: IfaceTyCon -> NameSet
798 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
799 -- ToDo: shouldn't we include IfaceIntTc & co.?
800 freeNamesIfTc _ = emptyNameSet
802 freeNamesIfRule :: IfaceRule -> NameSet
803 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
805 fnList freeNamesIfBndr bs &&&
806 fnList freeNamesIfExpr es &&&
810 (&&&) :: NameSet -> NameSet -> NameSet
811 (&&&) = unionNameSets
813 fnList :: (a -> NameSet) -> [a] -> NameSet
814 fnList f = foldr (&&&) emptyNameSet . map f