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