Improve dead block calculation, per Simon Marlow's advice.
[ghc.git] / compiler / iface / IfaceSyn.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 %
5
6 \begin{code}
7 module IfaceSyn (
8         module IfaceType,
9
10         IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
11         IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
12         IfaceBinding(..), IfaceConAlt(..),
13         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
14         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
15         IfaceInst(..), IfaceFamInst(..),
16
17         -- Misc
18         ifaceDeclSubBndrs, visibleIfConDecls,
19
20         -- Free Names
21         freeNamesIfDecl, freeNamesIfRule,
22
23         -- Pretty printing
24         pprIfaceExpr, pprIfaceDeclHead
25     ) where
26
27 #include "HsVersions.h"
28
29 import IfaceType
30 import CoreSyn( DFunArg, dfunArgExprs )
31 import PprCore()     -- Printing DFunArgs
32 import Demand
33 import Annotations
34 import Class
35 import NameSet
36 import Name
37 import CostCentre
38 import Literal
39 import ForeignCall
40 import Serialized
41 import BasicTypes
42 import Outputable
43 import FastString
44 import Module
45
46 infixl 3 &&&
47 \end{code}
48
49
50 %************************************************************************
51 %*                                                                      *
52     Data type declarations
53 %*                                                                      *
54 %************************************************************************
55
56 \begin{code}
57 data IfaceDecl
58   = IfaceId { ifName      :: OccName,
59               ifType      :: IfaceType,
60               ifIdDetails :: IfaceIdDetails,
61               ifIdInfo    :: IfaceIdInfo }
62
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
69                                                 -- GADT syntax
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
75                                                 -- been compiled with
76                                                 -- different flags to the
77                                                 -- current compilation unit
78                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
79                                                 -- Just <=> instance of family
80                                                 -- Invariant:
81                                                 --   ifCons /= IfOpenDataTyCon
82                                                 --   for family instances
83     }
84
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
94     }
95
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
103                                                 --   with the class recursive?
104     }
105
106   | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
107                                                 -- beyond .NET
108                    ifExtName :: Maybe FastString }
109
110 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
111         -- Nothing    => no default method
112         -- Just False => ordinary polymorphic default method
113         -- Just True  => generic default method
114
115 data IfaceConDecls
116   = IfAbstractTyCon             -- No info
117   | IfOpenDataTyCon             -- Open data family
118   | IfDataTyCon [IfaceConDecl]  -- data type decls
119   | IfNewTyCon  IfaceConDecl    -- newtype decls
120
121 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
122 visibleIfConDecls IfAbstractTyCon  = []
123 visibleIfConDecls IfOpenDataTyCon  = []
124 visibleIfConDecls (IfDataTyCon cs) = cs
125 visibleIfConDecls (IfNewTyCon c)   = [c]
126
127 data IfaceConDecl
128   = IfCon {
129         ifConOcc     :: OccName,                -- Constructor name
130         ifConWrapper :: Bool,                   -- True <=> has a wrapper
131         ifConInfix   :: Bool,                   -- True <=> declared infix
132         ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
133         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
134         ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality contraints
135         ifConCtxt    :: IfaceContext,           -- Non-stupid context
136         ifConArgTys  :: [IfaceType],            -- Arg types
137         ifConFields  :: [OccName],              -- ...ditto... (field labels)
138         ifConStricts :: [HsBang]}               -- Empty (meaning all lazy),
139                                                 -- or 1-1 corresp with arg tys
140
141 data IfaceInst
142   = IfaceInst { ifInstCls  :: IfExtName,                -- See comments with
143                 ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
144                 ifDFun     :: IfExtName,                -- The dfun
145                 ifOFlag    :: OverlapFlag,              -- Overlap flag
146                 ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
147         -- There's always a separate IfaceDecl for the DFun, which gives
148         -- its IdInfo with its full type and version number.
149         -- The instance declarations taken together have a version number,
150         -- and we don't want that to wobble gratuitously
151         -- If this instance decl is *used*, we'll record a usage on the dfun;
152         -- and if the head does not change it won't be used if it wasn't before
153
154 data IfaceFamInst
155   = IfaceFamInst { ifFamInstFam   :: IfExtName                -- Family tycon
156                  , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
157                  , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
158                  }
159
160 data IfaceRule
161   = IfaceRule {
162         ifRuleName   :: RuleName,
163         ifActivation :: Activation,
164         ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
165         ifRuleHead   :: IfExtName,      -- Head of lhs
166         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
167         ifRuleRhs    :: IfaceExpr,
168         ifRuleAuto   :: Bool,
169         ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
170     }
171
172 data IfaceAnnotation
173   = IfaceAnnotation {
174         ifAnnotatedTarget :: IfaceAnnTarget,
175         ifAnnotatedValue :: Serialized
176   }
177
178 type IfaceAnnTarget = AnnTarget OccName
179
180 -- We only serialise the IdDetails of top-level Ids, and even then
181 -- we only need a very limited selection.  Notably, none of the
182 -- implicit ones are needed here, becuase they are not put it
183 -- interface files
184
185 data IfaceIdDetails
186   = IfVanillaId
187   | IfRecSelId IfaceTyCon Bool
188   | IfDFunId Int          -- Number of silent args
189
190 data IfaceIdInfo
191   = NoInfo                      -- When writing interface file without -O
192   | HasInfo [IfaceInfoItem]     -- Has info, and here it is
193
194 -- Here's a tricky case:
195 --   * Compile with -O module A, and B which imports A.f
196 --   * Change function f in A, and recompile without -O
197 --   * When we read in old A.hi we read in its IdInfo (as a thunk)
198 --      (In earlier GHCs we used to drop IdInfo immediately on reading,
199 --       but we do not do that now.  Instead it's discarded when the
200 --       ModIface is read into the various decl pools.)
201 --   * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
202 --      and so gives a new version.
203
204 data IfaceInfoItem
205   = HsArity      Arity
206   | HsStrictness StrictSig
207   | HsInline     InlinePragma
208   | HsUnfold     Bool             -- True <=> isNonRuleLoopBreaker is true
209                  IfaceUnfolding   -- See Note [Expose recursive functions]
210   | HsNoCafRefs
211
212 -- NB: Specialisations and rules come in separately and are
213 -- only later attached to the Id.  Partial reason: some are orphans.
214
215 data IfaceUnfolding
216   = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
217                                 -- Possibly could eliminate the Bool here, the information
218                                 -- is also in the InlinePragma.
219
220   | IfCompulsory IfaceExpr      -- Only used for default methods, in fact
221
222   | IfInlineRule Arity          -- INLINE pragmas
223                  Bool           -- OK to inline even if *un*-saturated
224                  Bool           -- OK to inline even if context is boring
225                  IfaceExpr
226
227   | IfExtWrapper Arity IfExtName  -- NB: sometimes we need a IfExtName (not just IfLclName)
228   | IfLclWrapper Arity IfLclName  --     because the worker can simplify to a function in
229                                   --     another module.
230
231   | IfDFunUnfold [DFunArg IfaceExpr]
232
233 --------------------------------
234 data IfaceExpr
235   = IfaceLcl    IfLclName
236   | IfaceExt    IfExtName
237   | IfaceType   IfaceType
238   | IfaceTuple  Boxity [IfaceExpr]              -- Saturated; type arguments omitted
239   | IfaceLam    IfaceBndr IfaceExpr
240   | IfaceApp    IfaceExpr IfaceExpr
241   | IfaceCase   IfaceExpr IfLclName IfaceType [IfaceAlt]
242   | IfaceLet    IfaceBinding  IfaceExpr
243   | IfaceNote   IfaceNote IfaceExpr
244   | IfaceCast   IfaceExpr IfaceCoercion
245   | IfaceLit    Literal
246   | IfaceFCall  ForeignCall IfaceType
247   | IfaceTick   Module Int
248
249 data IfaceNote = IfaceSCC CostCentre
250                | IfaceCoreNote String
251
252 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
253         -- Note: IfLclName, not IfaceBndr (and same with the case binder)
254         -- We reconstruct the kind/type of the thing from the context
255         -- thus saving bulk in interface files
256
257 data IfaceConAlt = IfaceDefault
258                  | IfaceDataAlt IfExtName
259                  | IfaceTupleAlt Boxity
260                  | IfaceLitAlt Literal
261
262 data IfaceBinding
263   = IfaceNonRec IfaceLetBndr IfaceExpr
264   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
265
266 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
267 -- It's used for *non-top-level* let/rec binders
268 -- See Note [IdInfo on nested let-bindings]
269 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
270 \end{code}
271
272 Note [Expose recursive functions]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
274 For supercompilation we want to put *all* unfoldings in the interface
275 file, even for functions that are recursive (or big).  So we need to
276 know when an unfolding belongs to a loop-breaker so that we can refrain
277 from inlining it (except during supercompilation).
278
279 Note [IdInfo on nested let-bindings]
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281 Occasionally we want to preserve IdInfo on nested let bindings. The one
282 that came up was a NOINLINE pragma on a let-binding inside an INLINE
283 function.  The user (Duncan Coutts) really wanted the NOINLINE control
284 to cross the separate compilation boundary.
285
286 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
287 that is what is seen by importing module with --make
288
289 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
290 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
291 If a module contains any "orphans", then its interface file is read
292 regardless, so that its instances are not missed.
293
294 Roughly speaking, an instance is an orphan if its head (after the =>)
295 mentions nothing defined in this module.  Functional dependencies
296 complicate the situation though. Consider
297
298   module M where { class C a b | a -> b }
299
300 and suppose we are compiling module X:
301
302   module X where
303         import M
304         data T = ...
305         instance C Int T where ...
306
307 This instance is an orphan, because when compiling a third module Y we
308 might get a constraint (C Int v), and we'd want to improve v to T.  So
309 we must make sure X's instances are loaded, even if we do not directly
310 use anything from X.
311
312 More precisely, an instance is an orphan iff
313
314   If there are no fundeps, then at least of the names in
315   the instance head is locally defined.
316
317   If there are fundeps, then for every fundep, at least one of the
318   names free in a *non-determined* part of the instance head is
319   defined in this module.
320
321 (Note that these conditions hold trivially if the class is locally
322 defined.)
323
324 Note [Versioning of instances]
325 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
326 Now consider versioning.  If we *use* an instance decl in one compilation,
327 we'll depend on the dfun id for that instance, so we'll recompile if it changes.
328 But suppose we *don't* (currently) use an instance!  We must recompile if
329 the instance is changed in such a way that it becomes important.  (This would
330 only matter with overlapping instances, else the importing module wouldn't have
331 compiled before and the recompilation check is irrelevant.)
332
333 The is_orph field is set to (Just n) if the instance is not an orphan.
334 The 'n' is *any* of the locally-defined names mentioned anywhere in the
335 instance head.  This name is used for versioning; the instance decl is
336 considered part of the defn of this 'n'.
337
338 I'm worried about whether this works right if we pick a name from
339 a functionally-dependent part of the instance decl.  E.g.
340
341   module M where { class C a b | a -> b }
342
343 and suppose we are compiling module X:
344
345   module X where
346         import M
347         data S  = ...
348         data T = ...
349         instance C S T where ...
350
351 If we base the instance verion on T, I'm worried that changing S to S'
352 would change T's version, but not S or S'.  But an importing module might
353 not depend on T, and so might not be recompiled even though the new instance
354 (C S' T) might be relevant.  I have not been able to make a concrete example,
355 and it seems deeply obscure, so I'm going to leave it for now.
356
357
358 Note [Versioning of rules]
359 ~~~~~~~~~~~~~~~~~~~~~~~~~~
360 A rule that is not an orphan has an ifRuleOrph field of (Just n), where n
361 appears on the LHS of the rule; any change in the rule changes the version of n.
362
363
364 \begin{code}
365 -- -----------------------------------------------------------------------------
366 -- Utils on IfaceSyn
367
368 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
369 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
370 -- Deeply revolting, because it has to predict what gets bound,
371 -- especially the question of whether there's a wrapper for a datacon
372
373 -- N.B. the set of names returned here *must* match the set of
374 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
375 -- TyThing.getOccName should define a bijection between the two lists.
376 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
377 -- The order of the list does not matter.
378 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}  = []
379
380 -- Newtype
381 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
382                               ifCons = IfNewTyCon (
383                                         IfCon { ifConOcc = con_occ }),
384                               ifFamInst = famInst})
385   =   -- implicit coerion and (possibly) family instance coercion
386     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
387       -- data constructor and worker (newtypes don't have a wrapper)
388     [con_occ, mkDataConWorkerOcc con_occ]
389
390
391 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
392                               ifCons = IfDataTyCon cons,
393                               ifFamInst = famInst})
394   =   -- (possibly) family instance coercion;
395       -- there is no implicit coercion for non-newtypes
396     famInstCo famInst tc_occ
397       -- for each data constructor in order,
398       --    data constructor, worker, and (possibly) wrapper
399     ++ concatMap dc_occs cons
400   where
401     dc_occs con_decl
402         | has_wrapper = [con_occ, work_occ, wrap_occ]
403         | otherwise   = [con_occ, work_occ]
404         where
405           con_occ  = ifConOcc con_decl            -- DataCon namespace
406           wrap_occ = mkDataConWrapperOcc con_occ  -- Id namespace
407           work_occ = mkDataConWorkerOcc con_occ   -- Id namespace
408           has_wrapper = ifConWrapper con_decl     -- This is the reason for
409                                                   -- having the ifConWrapper field!
410
411 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
412                                ifSigs = sigs, ifATs = ats })
413   = -- dictionary datatype:
414     --   type constructor
415     tc_occ :
416     --   (possibly) newtype coercion
417     co_occs ++
418     --    data constructor (DataCon namespace)
419     --    data worker (Id namespace)
420     --    no wrapper (class dictionaries never have a wrapper)
421     [dc_occ, dcww_occ] ++
422     -- associated types
423     [ifName at | at <- ats ] ++
424     -- superclass selectors
425     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
426     -- operation selectors
427     [op | IfaceClassOp op  _ _ <- sigs]
428   where
429     n_ctxt = length sc_ctxt
430     n_sigs = length sigs
431     tc_occ  = mkClassTyConOcc cls_occ
432     dc_occ  = mkClassDataConOcc cls_occ
433     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
434             | otherwise  = []
435     dcww_occ = mkDataConWorkerOcc dc_occ
436     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
437
438 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
439                              ifFamInst = famInst})
440   = famInstCo famInst tc_occ
441
442 ifaceDeclSubBndrs _ = []
443
444 -- coercion for data/newtype family instances
445 famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
446 famInstCo Nothing  _       = []
447 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
448
449 ----------------------------- Printing IfaceDecl ------------------------------
450
451 instance Outputable IfaceDecl where
452   ppr = pprIfaceDecl
453
454 pprIfaceDecl :: IfaceDecl -> SDoc
455 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
456                        ifIdDetails = details, ifIdInfo = info})
457   = sep [ ppr var <+> dcolon <+> ppr ty,
458           nest 2 (ppr details),
459           nest 2 (ppr info) ]
460
461 pprIfaceDecl (IfaceForeign {ifName = tycon})
462   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
463
464 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
465                         ifSynRhs = Just mono_ty,
466                         ifFamInst = mbFamInst})
467   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
468        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
469
470 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
471                         ifSynRhs = Nothing, ifSynKind = kind })
472   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
473        4 (dcolon <+> ppr kind)
474
475 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
476                          ifTyVars = tyvars, ifCons = condecls,
477                          ifRec = isrec, ifFamInst = mbFamInst})
478   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
479        4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
480                 pprFamily mbFamInst])
481   where
482     pp_nd = case condecls of
483                 IfAbstractTyCon -> ptext (sLit "data")
484                 IfOpenDataTyCon -> ptext (sLit "data family")
485                 IfDataTyCon _   -> ptext (sLit "data")
486                 IfNewTyCon _    -> ptext (sLit "newtype")
487
488 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
489                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
490                           ifRec = isrec})
491   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
492        4 (vcat [pprRec isrec,
493                 sep (map ppr ats),
494                 sep (map ppr sigs)])
495
496 pprRec :: RecFlag -> SDoc
497 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
498
499 pprGen :: Bool -> SDoc
500 pprGen True  = ptext (sLit "Generics: yes")
501 pprGen False = ptext (sLit "Generics: no")
502
503 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
504 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
505 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
506
507 instance Outputable IfaceClassOp where
508    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
509
510 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
511 pprIfaceDeclHead context thing tyvars
512   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
513           pprIfaceTvBndrs tyvars]
514
515 pp_condecls :: OccName -> IfaceConDecls -> SDoc
516 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
517 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
518 pp_condecls _  IfOpenDataTyCon  = empty
519 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
520                                                             (map (pprIfaceConDecl tc) cs))
521
522 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
523 pprIfaceConDecl tc
524         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
525                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
526                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
527                  ifConStricts = strs, ifConFields = fields })
528   = sep [main_payload,
529          if is_infix then ptext (sLit "Infix") else empty,
530          if has_wrap then ptext (sLit "HasWrapper") else empty,
531          ppUnless (null strs) $
532             nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
533          ppUnless (null fields) $
534             nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
535   where
536     ppr_bang HsNoBang = char '_'        -- Want to see these
537     ppr_bang bang     = ppr bang
538
539     main_payload = ppr name <+> dcolon <+>
540                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
541
542     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
543               | (tv,ty) <- eq_spec]
544
545         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
546         -- because we don't have a Name for the tycon, only an OccName
547     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
548                 (t:ts) -> fsep (t : map (arrow <+>) ts)
549                 []     -> panic "pp_con_taus"
550
551     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
552
553 instance Outputable IfaceRule where
554   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
555                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
556     = sep [hsep [doubleQuotes (ftext name), ppr act,
557                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
558            nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
559                         ptext (sLit "=") <+> ppr rhs])
560       ]
561
562 instance Outputable IfaceInst where
563   ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
564                   ifInstCls = cls, ifInstTys = mb_tcs})
565     = hang (ptext (sLit "instance") <+> ppr flag
566                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
567          2 (equals <+> ppr dfun_id)
568
569 instance Outputable IfaceFamInst where
570   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
571                      ifFamInstTyCon = tycon_id})
572     = hang (ptext (sLit "family instance") <+>
573             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
574          2 (equals <+> ppr tycon_id)
575
576 ppr_rough :: Maybe IfaceTyCon -> SDoc
577 ppr_rough Nothing   = dot
578 ppr_rough (Just tc) = ppr tc
579 \end{code}
580
581
582 ----------------------------- Printing IfaceExpr ------------------------------------
583
584 \begin{code}
585 instance Outputable IfaceExpr where
586     ppr e = pprIfaceExpr noParens e
587
588 pprParendIfaceExpr :: IfaceExpr -> SDoc
589 pprParendIfaceExpr = pprIfaceExpr parens
590
591 -- | Pretty Print an IfaceExpre
592 --
593 -- The first argument should be a function that adds parens in context that need
594 -- an atomic value (e.g. function args)
595 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
596
597 pprIfaceExpr _       (IfaceLcl v)       = ppr v
598 pprIfaceExpr _       (IfaceExt v)       = ppr v
599 pprIfaceExpr _       (IfaceLit l)       = ppr l
600 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
601 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
602 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
603
604 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
605 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
606
607 pprIfaceExpr add_par i@(IfaceLam _ _)
608   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
609                   pprIfaceExpr noParens body])
610   where
611     (bndrs,body) = collect [] i
612     collect bs (IfaceLam b e) = collect (b:bs) e
613     collect bs e              = (reverse bs, e)
614
615 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
616   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
617                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
618                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
619                   pprIfaceExpr noParens rhs <+> char '}'])
620
621 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
622   = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
623                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
624                         <+> ppr bndr <+> char '{',
625                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
626
627 pprIfaceExpr _       (IfaceCast expr co)
628   = sep [pprParendIfaceExpr expr,
629          nest 2 (ptext (sLit "`cast`")),
630          pprParendIfaceType co]
631
632 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
633   = add_par (sep [ptext (sLit "let {"),
634                   nest 2 (ppr_bind (b, rhs)),
635                   ptext (sLit "} in"),
636                   pprIfaceExpr noParens body])
637
638 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
639   = add_par (sep [ptext (sLit "letrec {"),
640                   nest 2 (sep (map ppr_bind pairs)),
641                   ptext (sLit "} in"),
642                   pprIfaceExpr noParens body])
643
644 pprIfaceExpr add_par (IfaceNote note body) = add_par $ ppr note
645                                                 <+> pprParendIfaceExpr body
646
647 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
648 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
649                          arrow <+> pprIfaceExpr noParens rhs]
650
651 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
652 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
653 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
654
655 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
656 ppr_bind (IfLetBndr b ty info, rhs)
657   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
658          equals <+> pprIfaceExpr noParens rhs]
659
660 ------------------
661 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
662 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
663                                           nest 2 (pprParendIfaceExpr arg) : args
664 pprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)
665
666 ------------------
667 instance Outputable IfaceNote where
668     ppr (IfaceSCC cc)     = pprCostCentreCore cc
669     ppr (IfaceCoreNote s) = ptext (sLit "__core_note")
670                             <+> pprHsString (mkFastString s)
671
672
673 instance Outputable IfaceConAlt where
674     ppr IfaceDefault      = text "DEFAULT"
675     ppr (IfaceLitAlt l)   = ppr l
676     ppr (IfaceDataAlt d)  = ppr d
677     ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
678     -- IfaceTupleAlt is handled by the case-alternative printer
679
680 ------------------
681 instance Outputable IfaceIdDetails where
682   ppr IfVanillaId       = empty
683   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
684                           <+> if b then ptext (sLit "<naughty>") else empty
685   ppr (IfDFunId ns)     = ptext (sLit "DFunId") <> brackets (int ns)
686
687 instance Outputable IfaceIdInfo where
688   ppr NoInfo       = empty
689   ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
690                      <+> ptext (sLit "-}")
691
692 instance Outputable IfaceInfoItem where
693   ppr (HsUnfold lb unf)  = ptext (sLit "Unfolding")
694                            <> ppWhen lb (ptext (sLit "(loop-breaker)"))
695                            <> colon <+> ppr unf
696   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
697   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
698   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
699   ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
700
701 instance Outputable IfaceUnfolding where
702   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
703   ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty)
704                               <+> parens (ppr e)
705   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
706                                             <+> ppr (a,uok,bok),
707                                         pprParendIfaceExpr e]
708   ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
709                              <+> parens (ptext (sLit "arity") <+> int a)
710   ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
711                              <+> parens (ptext (sLit "arity") <+> int a)
712   ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
713                              <+> brackets (pprWithCommas ppr ns)
714
715 -- -----------------------------------------------------------------------------
716 -- | Finding the Names in IfaceSyn
717
718 -- This is used for dependency analysis in MkIface, so that we
719 -- fingerprint a declaration before the things that depend on it.  It
720 -- is specific to interface-file fingerprinting in the sense that we
721 -- don't collect *all* Names: for example, the DFun of an instance is
722 -- recorded textually rather than by its fingerprint when
723 -- fingerprinting the instance, so DFuns are not dependencies.
724
725 freeNamesIfDecl :: IfaceDecl -> NameSet
726 freeNamesIfDecl (IfaceId _s t d i) =
727   freeNamesIfType t &&&
728   freeNamesIfIdInfo i &&&
729   freeNamesIfIdDetails d
730 freeNamesIfDecl IfaceForeign{} =
731   emptyNameSet
732 freeNamesIfDecl d@IfaceData{} =
733   freeNamesIfTvBndrs (ifTyVars d) &&&
734   freeNamesIfTcFam (ifFamInst d) &&&
735   freeNamesIfContext (ifCtxt d) &&&
736   freeNamesIfConDecls (ifCons d)
737 freeNamesIfDecl d@IfaceSyn{} =
738   freeNamesIfTvBndrs (ifTyVars d) &&&
739   freeNamesIfSynRhs (ifSynRhs d) &&&
740   freeNamesIfTcFam (ifFamInst d)
741 freeNamesIfDecl d@IfaceClass{} =
742   freeNamesIfTvBndrs (ifTyVars d) &&&
743   freeNamesIfContext (ifCtxt d) &&&
744   freeNamesIfDecls   (ifATs d) &&&
745   fnList freeNamesIfClsSig (ifSigs d)
746
747 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
748 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
749 freeNamesIfIdDetails _                 = emptyNameSet
750
751 -- All other changes are handled via the version info on the tycon
752 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
753 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
754 freeNamesIfSynRhs Nothing   = emptyNameSet
755
756 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
757 freeNamesIfTcFam (Just (tc,tys)) =
758   freeNamesIfTc tc &&& fnList freeNamesIfType tys
759 freeNamesIfTcFam Nothing =
760   emptyNameSet
761
762 freeNamesIfContext :: IfaceContext -> NameSet
763 freeNamesIfContext = fnList freeNamesIfPredType
764
765 freeNamesIfDecls :: [IfaceDecl] -> NameSet
766 freeNamesIfDecls = fnList freeNamesIfDecl
767
768 freeNamesIfClsSig :: IfaceClassOp -> NameSet
769 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
770
771 freeNamesIfConDecls :: IfaceConDecls -> NameSet
772 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
773 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
774 freeNamesIfConDecls _               = emptyNameSet
775
776 freeNamesIfConDecl :: IfaceConDecl -> NameSet
777 freeNamesIfConDecl c =
778   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
779   freeNamesIfTvBndrs (ifConExTvs c) &&&
780   freeNamesIfContext (ifConCtxt c) &&&
781   fnList freeNamesIfType (ifConArgTys c) &&&
782   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
783
784 freeNamesIfPredType :: IfacePredType -> NameSet
785 freeNamesIfPredType (IfaceClassP cl tys) =
786    unitNameSet cl &&& fnList freeNamesIfType tys
787 freeNamesIfPredType (IfaceIParam _n ty) =
788    freeNamesIfType ty
789 freeNamesIfPredType (IfaceEqPred ty1 ty2) =
790    freeNamesIfType ty1 &&& freeNamesIfType ty2
791
792 freeNamesIfType :: IfaceType -> NameSet
793 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
794 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
795 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
796 freeNamesIfType (IfaceTyConApp tc ts) =
797    freeNamesIfTc tc &&& fnList freeNamesIfType ts
798 freeNamesIfType (IfaceForAllTy tv t)  =
799    freeNamesIfTvBndr tv &&& freeNamesIfType t
800 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
801
802 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
803 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
804
805 freeNamesIfBndr :: IfaceBndr -> NameSet
806 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
807 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
808
809 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
810 -- Remember IfaceLetBndr is used only for *nested* bindings
811 -- The IdInfo can contain an unfolding (in the case of
812 -- local INLINE pragmas), so look there too
813 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
814                                              &&& freeNamesIfIdInfo info
815
816 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
817 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
818     -- kinds can have Names inside, when the Kind is an equality predicate
819
820 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
821 freeNamesIfIdBndr = freeNamesIfTvBndr
822
823 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
824 freeNamesIfIdInfo NoInfo      = emptyNameSet
825 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
826
827 freeNamesItem :: IfaceInfoItem -> NameSet
828 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
829 freeNamesItem _              = emptyNameSet
830
831 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
832 freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
833 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
834 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
835 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
836 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
837 freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
838
839 freeNamesIfExpr :: IfaceExpr -> NameSet
840 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
841 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
842 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
843 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
844 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
845 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
846 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
847 freeNamesIfExpr (IfaceNote _n r)  = freeNamesIfExpr r
848
849 freeNamesIfExpr (IfaceCase s _ ty alts)
850   = freeNamesIfExpr s
851     &&& fnList fn_alt alts &&& fn_cons alts
852     &&& freeNamesIfType ty
853   where
854     fn_alt (_con,_bs,r) = freeNamesIfExpr r
855
856     -- Depend on the data constructors.  Just one will do!
857     -- Note [Tracking data constructors]
858     fn_cons []                            = emptyNameSet
859     fn_cons ((IfaceDefault    ,_,_) : xs) = fn_cons xs
860     fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
861     fn_cons (_                      : _ ) = emptyNameSet
862
863 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
864   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
865
866 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
867   = fnList fn_pair as &&& freeNamesIfExpr x
868   where
869     fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
870
871 freeNamesIfExpr _ = emptyNameSet
872
873 freeNamesIfTc :: IfaceTyCon -> NameSet
874 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
875 -- ToDo: shouldn't we include IfaceIntTc & co.?
876 freeNamesIfTc _ = emptyNameSet
877
878 freeNamesIfRule :: IfaceRule -> NameSet
879 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
880                            , ifRuleArgs = es, ifRuleRhs = rhs })
881   = unitNameSet f &&&
882     fnList freeNamesIfBndr bs &&&
883     fnList freeNamesIfExpr es &&&
884     freeNamesIfExpr rhs
885
886 -- helpers
887 (&&&) :: NameSet -> NameSet -> NameSet
888 (&&&) = unionNameSets
889
890 fnList :: (a -> NameSet) -> [a] -> NameSet
891 fnList f = foldr (&&&) emptyNameSet . map f
892 \end{code}
893
894 Note [Tracking data constructors]
895 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
896 In a case expression
897    case e of { C a -> ...; ... }
898 You might think that we don't need to include the datacon C
899 in the free names, because its type will probably show up in
900 the free names of 'e'.  But in rare circumstances this may
901 not happen.   Here's the one that bit me:
902
903    module DynFlags where
904      import {-# SOURCE #-} Packages( PackageState )
905      data DynFlags = DF ... PackageState ...
906
907    module Packages where
908      import DynFlags
909      data PackageState = PS ...
910      lookupModule (df :: DynFlags)
911         = case df of
912               DF ...p... -> case p of
913                                PS ... -> ...
914
915 Now, lookupModule depends on DynFlags, but the transitive dependency
916 on the *locally-defined* type PackageState is not visible. We need
917 to take account of the use of the data constructor PS in the pattern match.
918