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