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(..), IfaceIdDetails(..),
13 IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
14 IfaceInst(..), IfaceFamInst(..),
17 ifaceDeclSubBndrs, visibleIfConDecls,
20 freeNamesIfDecl, freeNamesIfRule,
23 pprIfaceExpr, pprIfaceDeclHead
26 #include "HsVersions.h"
48 %************************************************************************
50 Data type declarations
52 %************************************************************************
56 = IfaceId { ifName :: OccName,
58 ifIdDetails :: IfaceIdDetails,
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 ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
86 ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
87 -- Nothing for an open family
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 ifConWrapper :: Bool, -- True <=> has a wrapper
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
170 ifAnnotatedTarget :: IfaceAnnTarget,
171 ifAnnotatedValue :: Serialized
174 type IfaceAnnTarget = AnnTarget OccName
176 -- We only serialise the IdDetails of top-level Ids, and even then
177 -- we only need a very limited selection. Notably, none of the
178 -- implicit ones are needed here, becuase they are not put it
183 | IfRecSelId IfaceTyCon Bool
187 = NoInfo -- When writing interface file without -O
188 | HasInfo [IfaceInfoItem] -- Has info, and here it is
190 -- Here's a tricky case:
191 -- * Compile with -O module A, and B which imports A.f
192 -- * Change function f in A, and recompile without -O
193 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
194 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
195 -- but we do not do that now. Instead it's discarded when the
196 -- ModIface is read into the various decl pools.)
197 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
198 -- and so gives a new version.
202 | HsStrictness StrictSig
203 | HsInline InlinePragma
206 | HsWorker Name Arity -- Worker, if any see IdInfo.WorkerInfo
207 -- for why we want arity here.
208 -- NB: we need IfaceExtName (not just OccName) because the worker
209 -- can simplify to a function in another module.
210 -- NB: Specialisations and rules come in separately and are
211 -- only later attached to the Id. Partial reason: some are orphans.
213 --------------------------------
215 = IfaceLcl FastString
217 | IfaceType IfaceType
218 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
219 | IfaceLam IfaceBndr IfaceExpr
220 | IfaceApp IfaceExpr IfaceExpr
221 | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
222 | IfaceLet IfaceBinding IfaceExpr
223 | IfaceNote IfaceNote IfaceExpr
224 | IfaceCast IfaceExpr IfaceCoercion
226 | IfaceFCall ForeignCall IfaceType
227 | IfaceTick Module Int
229 data IfaceNote = IfaceSCC CostCentre
231 | IfaceCoreNote String
233 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
234 -- Note: FastString, not IfaceBndr (and same with the case binder)
235 -- We reconstruct the kind/type of the thing from the context
236 -- thus saving bulk in interface files
238 data IfaceConAlt = IfaceDefault
240 | IfaceTupleAlt Boxity
241 | IfaceLitAlt Literal
244 = IfaceNonRec IfaceLetBndr IfaceExpr
245 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
247 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
248 -- It's used for *non-top-level* let/rec binders
249 -- See Note [IdInfo on nested let-bindings]
250 data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
253 Note [IdInfo on nested let-bindings]
254 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
255 Occasionally we want to preserve IdInfo on nested let bindings. The one
256 that came up was a NOINLINE pragma on a let-binding inside an INLINE
257 function. The user (Duncan Coutts) really wanted the NOINLINE control
258 to cross the separate compilation boundary.
260 So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
261 Currently we only actually retain InlinePragInfo, but in principle we could
265 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
266 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
267 If a module contains any "orphans", then its interface file is read
268 regardless, so that its instances are not missed.
270 Roughly speaking, an instance is an orphan if its head (after the =>)
271 mentions nothing defined in this module. Functional dependencies
272 complicate the situation though. Consider
274 module M where { class C a b | a -> b }
276 and suppose we are compiling module X:
281 instance C Int T where ...
283 This instance is an orphan, because when compiling a third module Y we
284 might get a constraint (C Int v), and we'd want to improve v to T. So
285 we must make sure X's instances are loaded, even if we do not directly
288 More precisely, an instance is an orphan iff
290 If there are no fundeps, then at least of the names in
291 the instance head is locally defined.
293 If there are fundeps, then for every fundep, at least one of the
294 names free in a *non-determined* part of the instance head is
295 defined in this module.
297 (Note that these conditions hold trivially if the class is locally
300 Note [Versioning of instances]
301 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
302 Now consider versioning. If we *use* an instance decl in one compilation,
303 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
304 But suppose we *don't* (currently) use an instance! We must recompile if
305 the instance is changed in such a way that it becomes important. (This would
306 only matter with overlapping instances, else the importing module wouldn't have
307 compiled before and the recompilation check is irrelevant.)
309 The is_orph field is set to (Just n) if the instance is not an orphan.
310 The 'n' is *any* of the locally-defined names mentioned anywhere in the
311 instance head. This name is used for versioning; the instance decl is
312 considered part of the defn of this 'n'.
314 I'm worried about whether this works right if we pick a name from
315 a functionally-dependent part of the instance decl. E.g.
317 module M where { class C a b | a -> b }
319 and suppose we are compiling module X:
325 instance C S T where ...
327 If we base the instance verion on T, I'm worried that changing S to S'
328 would change T's version, but not S or S'. But an importing module might
329 not depend on T, and so might not be recompiled even though the new instance
330 (C S' T) might be relevant. I have not been able to make a concrete example,
331 and it seems deeply obscure, so I'm going to leave it for now.
334 Note [Versioning of rules]
335 ~~~~~~~~~~~~~~~~~~~~~~~~~~
336 A rule that is not an orphan has an ifRuleOrph field of (Just n), where
337 n appears on the LHS of the rule; any change in the rule changes the version of n.
341 -- -----------------------------------------------------------------------------
344 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
345 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
346 -- Deeply revolting, because it has to predict what gets bound,
347 -- especially the question of whether there's a wrapper for a datacon
349 -- N.B. the set of names returned here *must* match the set of
350 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
351 -- TyThing.getOccName should define a bijection between the two lists.
352 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
353 -- The order of the list does not matter.
354 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
357 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
358 ifCons = IfNewTyCon (
359 IfCon { ifConOcc = con_occ }),
360 ifFamInst = famInst})
361 = -- implicit coerion and (possibly) family instance coercion
362 (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
363 -- data constructor and worker (newtypes don't have a wrapper)
364 [con_occ, mkDataConWorkerOcc con_occ]
367 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
368 ifCons = IfDataTyCon cons,
369 ifFamInst = famInst})
370 = -- (possibly) family instance coercion;
371 -- there is no implicit coercion for non-newtypes
372 famInstCo famInst tc_occ
373 -- for each data constructor in order,
374 -- data constructor, worker, and (possibly) wrapper
375 ++ concatMap dc_occs cons
378 | has_wrapper = [con_occ, work_occ, wrap_occ]
379 | otherwise = [con_occ, work_occ]
381 con_occ = ifConOcc con_decl -- DataCon namespace
382 wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
383 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
384 has_wrapper = ifConWrapper con_decl -- This is the reason for
385 -- having the ifConWrapper field!
387 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
388 ifSigs = sigs, ifATs = ats })
389 = -- dictionary datatype:
392 -- (possibly) newtype coercion
394 -- data constructor (DataCon namespace)
395 -- data worker (Id namespace)
396 -- no wrapper (class dictionaries never have a wrapper)
397 [dc_occ, dcww_occ] ++
399 [ifName at | at <- ats ] ++
400 -- superclass selectors
401 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
402 -- operation selectors
403 [op | IfaceClassOp op _ _ <- sigs]
405 n_ctxt = length sc_ctxt
407 tc_occ = mkClassTyConOcc cls_occ
408 dc_occ = mkClassDataConOcc cls_occ
409 co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
411 dcww_occ = mkDataConWorkerOcc dc_occ
412 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
414 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
415 ifFamInst = famInst})
416 = famInstCo famInst tc_occ
418 ifaceDeclSubBndrs _ = []
420 -- coercion for data/newtype family instances
421 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
422 famInstCo Nothing _ = []
423 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
425 ----------------------------- Printing IfaceDecl ------------------------------
427 instance Outputable IfaceDecl where
430 pprIfaceDecl :: IfaceDecl -> SDoc
431 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
432 ifIdDetails = details, ifIdInfo = info})
433 = sep [ ppr var <+> dcolon <+> ppr ty,
434 nest 2 (ppr details),
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, ifConWrapper = has_wrap,
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 has_wrap then ptext (sLit "HasWrapper") else empty,
507 if null strs then empty
508 else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
509 if null fields then empty
510 else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
512 main_payload = ppr name <+> dcolon <+>
513 pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
515 eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
516 | (tv,ty) <- eq_spec]
518 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
519 -- because we don't have a Name for the tycon, only an OccName
520 pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
521 (t:ts) -> fsep (t : map (arrow <+>) ts)
522 [] -> panic "pp_con_taus"
524 pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
526 instance Outputable IfaceRule where
527 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
528 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
529 = sep [hsep [doubleQuotes (ftext name), ppr act,
530 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
531 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
532 ptext (sLit "=") <+> ppr rhs])
535 instance Outputable IfaceInst where
536 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
537 ifInstCls = cls, ifInstTys = mb_tcs})
538 = hang (ptext (sLit "instance") <+> ppr flag
539 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
540 2 (equals <+> ppr dfun_id)
542 instance Outputable IfaceFamInst where
543 ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
544 ifFamInstTyCon = tycon_id})
545 = hang (ptext (sLit "family instance") <+>
546 ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
547 2 (equals <+> ppr tycon_id)
549 ppr_rough :: Maybe IfaceTyCon -> SDoc
550 ppr_rough Nothing = dot
551 ppr_rough (Just tc) = ppr tc
555 ----------------------------- Printing IfaceExpr ------------------------------------
558 instance Outputable IfaceExpr where
559 ppr e = pprIfaceExpr noParens e
561 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
562 -- The function adds parens in context that need
563 -- an atomic value (e.g. function args)
565 pprIfaceExpr _ (IfaceLcl v) = ppr v
566 pprIfaceExpr _ (IfaceExt v) = ppr v
567 pprIfaceExpr _ (IfaceLit l) = ppr l
568 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
569 pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
570 pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
572 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
573 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
575 pprIfaceExpr add_par e@(IfaceLam _ _)
576 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
577 pprIfaceExpr noParens body])
579 (bndrs,body) = collect [] e
580 collect bs (IfaceLam b e) = collect (b:bs) e
581 collect bs e = (reverse bs, e)
583 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
584 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
585 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
586 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
587 pprIfaceExpr noParens rhs <+> char '}'])
589 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
590 = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
591 <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
592 <+> ppr bndr <+> char '{',
593 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
595 pprIfaceExpr _ (IfaceCast expr co)
596 = sep [pprIfaceExpr parens expr,
597 nest 2 (ptext (sLit "`cast`")),
598 pprParendIfaceType co]
600 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
601 = add_par (sep [ptext (sLit "let {"),
602 nest 2 (ppr_bind (b, rhs)),
604 pprIfaceExpr noParens body])
606 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
607 = add_par (sep [ptext (sLit "letrec {"),
608 nest 2 (sep (map ppr_bind pairs)),
610 pprIfaceExpr noParens body])
612 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
614 ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
615 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
616 arrow <+> pprIfaceExpr noParens rhs]
618 ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
619 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
620 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
622 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
623 ppr_bind (IfLetBndr b ty info, rhs)
624 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
625 equals <+> pprIfaceExpr noParens rhs]
628 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
629 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
630 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
633 instance Outputable IfaceNote where
634 ppr (IfaceSCC cc) = pprCostCentreCore cc
635 ppr IfaceInlineMe = ptext (sLit "__inline_me")
636 ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
639 instance Outputable IfaceConAlt where
640 ppr IfaceDefault = text "DEFAULT"
641 ppr (IfaceLitAlt l) = ppr l
642 ppr (IfaceDataAlt d) = ppr d
643 ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
644 -- IfaceTupleAlt is handled by the case-alternative printer
647 instance Outputable IfaceIdDetails where
648 ppr IfVanillaId = empty
649 ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
650 <+> if b then ptext (sLit "<naughty>") else empty
651 ppr IfDFunId = ptext (sLit "DFunId")
653 instance Outputable IfaceIdInfo where
655 ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
657 instance Outputable IfaceInfoItem where
658 ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+>
659 parens (pprIfaceExpr noParens unf)
660 ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
661 ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
662 ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
663 ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
664 ppr (HsWorker w a) = ptext (sLit "Worker:") <+> ppr w <+> int a
667 -- -----------------------------------------------------------------------------
668 -- Finding the Names in IfaceSyn
670 -- This is used for dependency analysis in MkIface, so that we
671 -- fingerprint a declaration before the things that depend on it. It
672 -- is specific to interface-file fingerprinting in the sense that we
673 -- don't collect *all* Names: for example, the DFun of an instance is
674 -- recorded textually rather than by its fingerprint when
675 -- fingerprinting the instance, so DFuns are not dependencies.
677 freeNamesIfDecl :: IfaceDecl -> NameSet
678 freeNamesIfDecl (IfaceId _s t _d i) =
679 freeNamesIfType t &&&
681 freeNamesIfDecl IfaceForeign{} =
683 freeNamesIfDecl d@IfaceData{} =
684 freeNamesIfTvBndrs (ifTyVars d) &&&
685 freeNamesIfTcFam (ifFamInst d) &&&
686 freeNamesIfContext (ifCtxt d) &&&
687 freeNamesIfConDecls (ifCons d)
688 freeNamesIfDecl d@IfaceSyn{} =
689 freeNamesIfTvBndrs (ifTyVars d) &&&
690 freeNamesIfSynRhs (ifSynRhs d) &&&
691 freeNamesIfTcFam (ifFamInst d)
692 freeNamesIfDecl d@IfaceClass{} =
693 freeNamesIfTvBndrs (ifTyVars d) &&&
694 freeNamesIfContext (ifCtxt d) &&&
695 freeNamesIfDecls (ifATs d) &&&
696 fnList freeNamesIfClsSig (ifSigs d)
698 -- All other changes are handled via the version info on the tycon
699 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
700 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
701 freeNamesIfSynRhs Nothing = emptyNameSet
703 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
704 freeNamesIfTcFam (Just (tc,tys)) =
705 freeNamesIfTc tc &&& fnList freeNamesIfType tys
706 freeNamesIfTcFam Nothing =
709 freeNamesIfContext :: IfaceContext -> NameSet
710 freeNamesIfContext = fnList freeNamesIfPredType
712 freeNamesIfDecls :: [IfaceDecl] -> NameSet
713 freeNamesIfDecls = fnList freeNamesIfDecl
715 freeNamesIfClsSig :: IfaceClassOp -> NameSet
716 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
718 freeNamesIfConDecls :: IfaceConDecls -> NameSet
719 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
720 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
721 freeNamesIfConDecls _ = emptyNameSet
723 freeNamesIfConDecl :: IfaceConDecl -> NameSet
724 freeNamesIfConDecl c =
725 freeNamesIfTvBndrs (ifConUnivTvs c) &&&
726 freeNamesIfTvBndrs (ifConExTvs c) &&&
727 freeNamesIfContext (ifConCtxt c) &&&
728 fnList freeNamesIfType (ifConArgTys c) &&&
729 fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
731 freeNamesIfPredType :: IfacePredType -> NameSet
732 freeNamesIfPredType (IfaceClassP cl tys) =
733 unitNameSet cl &&& fnList freeNamesIfType tys
734 freeNamesIfPredType (IfaceIParam _n ty) =
736 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
737 freeNamesIfType ty1 &&& freeNamesIfType ty2
739 freeNamesIfType :: IfaceType -> NameSet
740 freeNamesIfType (IfaceTyVar _) = emptyNameSet
741 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
742 freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
743 freeNamesIfType (IfaceTyConApp tc ts) =
744 freeNamesIfTc tc &&& fnList freeNamesIfType ts
745 freeNamesIfType (IfaceForAllTy tv t) =
746 freeNamesIfTvBndr tv &&& freeNamesIfType t
747 freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
749 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
750 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
752 freeNamesIfBndr :: IfaceBndr -> NameSet
753 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
754 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
756 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
757 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
758 -- kinds can have Names inside, when the Kind is an equality predicate
760 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
761 freeNamesIfIdBndr = freeNamesIfTvBndr
763 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
764 freeNamesIfIdInfo NoInfo = emptyNameSet
765 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
767 freeNamesItem :: IfaceInfoItem -> NameSet
768 freeNamesItem (HsUnfold u) = freeNamesIfExpr u
769 freeNamesItem (HsWorker wkr _) = unitNameSet wkr
770 freeNamesItem _ = emptyNameSet
772 freeNamesIfExpr :: IfaceExpr -> NameSet
773 freeNamesIfExpr (IfaceExt v) = unitNameSet v
774 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
775 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
776 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
777 freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
778 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
779 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
780 freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
782 freeNamesIfExpr (IfaceCase s _ ty alts)
783 = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
785 -- no need to look at the constructor, because we'll already have its
786 -- parent recorded by the type on the case expression.
787 freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
789 freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
790 = freeNamesIfExpr r &&& freeNamesIfExpr x
792 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
793 = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
795 freeNamesIfExpr _ = emptyNameSet
798 freeNamesIfTc :: IfaceTyCon -> NameSet
799 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
800 -- ToDo: shouldn't we include IfaceIntTc & co.?
801 freeNamesIfTc _ = emptyNameSet
803 freeNamesIfRule :: IfaceRule -> NameSet
804 freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
806 fnList freeNamesIfBndr bs &&&
807 fnList freeNamesIfExpr es &&&
811 (&&&) :: NameSet -> NameSet -> NameSet
812 (&&&) = unionNameSets
814 fnList :: (a -> NameSet) -> [a] -> NameSet
815 fnList f = foldr (&&&) emptyNameSet . map f