Major refactoring of CoAxioms
[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 {-# OPTIONS -fno-warn-tabs #-}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and
10 -- detab the module (please do the detabbing in a separate patch). See
11 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
12 -- for details
13
14 module IfaceSyn (
15         module IfaceType,
16
17         IfaceDecl(..), IfaceClassOp(..), IfaceAT(..), IfaceATDefault(..),
18         IfaceConDecl(..), IfaceConDecls(..),
19         IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
20         IfaceBinding(..), IfaceConAlt(..),
21         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
22         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
23         IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
24
25         -- Misc
26         ifaceDeclImplicitBndrs, visibleIfConDecls,
27
28         -- Free Names
29         freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
30
31         -- Pretty printing
32         pprIfaceExpr, pprIfaceDeclHead
33     ) where
34
35 #include "HsVersions.h"
36
37 import IfaceType
38 import Demand
39 import Annotations
40 import Class
41 import NameSet
42 import Name
43 import CostCentre
44 import Literal
45 import ForeignCall
46 import Serialized
47 import BasicTypes
48 import Outputable
49 import FastString
50 import Module
51 import TysWiredIn ( eqTyConName )
52
53 infixl 3 &&&
54 \end{code}
55
56
57 %************************************************************************
58 %*                                                                      *
59     Data type declarations
60 %*                                                                      *
61 %************************************************************************
62
63 \begin{code}
64 data IfaceDecl
65   = IfaceId { ifName      :: OccName,
66               ifType      :: IfaceType,
67               ifIdDetails :: IfaceIdDetails,
68               ifIdInfo    :: IfaceIdInfo }
69
70   | IfaceData { ifName       :: OccName,        -- Type constructor
71                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
72                 ifCtxt       :: IfaceContext,   -- The "stupid theta"
73                 ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
74                 ifRec        :: RecFlag,        -- Recursive or not?
75                 ifGadtSyntax :: Bool,           -- True <=> declared using
76                                                 -- GADT syntax
77                 ifAxiom      :: Maybe IfExtName -- The axiom, for a newtype, 
78                                                 -- or data/newtype family instance
79     }
80
81   | IfaceSyn  { ifName    :: OccName,           -- Type constructor
82                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
83                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
84                 ifSynRhs  :: Maybe IfaceType    -- Just rhs for an ordinary synonyn
85                                                 -- Nothing for an type family declaration
86     }
87
88   | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
89                  ifName    :: OccName,          -- Name of the class TyCon
90                  ifTyVars  :: [IfaceTvBndr],    -- Type variables
91                  ifFDs     :: [FunDep FastString], -- Functional dependencies
92                  ifATs     :: [IfaceAT],      -- Associated type families
93                  ifSigs    :: [IfaceClassOp],   -- Method signatures
94                  ifRec     :: RecFlag           -- Is newtype/datatype associated
95                                                 --   with the class recursive?
96     }
97
98   | IfaceAxiom { ifName   :: OccName       -- Axiom name
99                , ifTyVars :: [IfaceTvBndr] -- Axiom tyvars
100                , ifLHS    :: IfaceType     -- Axiom LHS
101                , ifRHS    :: IfaceType }   -- and RHS
102
103   | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
104                                                 -- beyond .NET
105                    ifExtName :: Maybe FastString }
106
107 data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
108         -- Nothing    => no default method
109         -- Just False => ordinary polymorphic default method
110         -- Just True  => generic default method
111
112 data IfaceAT = IfaceAT IfaceDecl [IfaceATDefault]
113         -- Nothing => no default associated type instance
114         -- Just ds => default associated type instance from these templates
115
116 data IfaceATDefault = IfaceATD [IfaceTvBndr] [IfaceType] IfaceType
117         -- Each associated type default template is a triple of:
118         --   1. TyVars of the RHS and family arguments (including the class TVs)
119         --   3. The instantiated family arguments
120         --   2. The RHS of the synonym
121
122 data IfaceConDecls
123   = IfAbstractTyCon Bool        -- c.f TyCon.AbstractTyCon
124   | IfDataFamTyCon              -- Data family
125   | IfDataTyCon [IfaceConDecl]  -- Data type decls
126   | IfNewTyCon  IfaceConDecl    -- Newtype decls
127
128 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
129 visibleIfConDecls (IfAbstractTyCon {}) = []
130 visibleIfConDecls IfDataFamTyCon      = []
131 visibleIfConDecls (IfDataTyCon cs)     = cs
132 visibleIfConDecls (IfNewTyCon c)       = [c]
133
134 data IfaceConDecl
135   = IfCon {
136         ifConOcc     :: OccName,                -- Constructor name
137         ifConWrapper :: Bool,                   -- True <=> has a wrapper
138         ifConInfix   :: Bool,                   -- True <=> declared infix
139         ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
140         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
141         ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality contraints
142         ifConCtxt    :: IfaceContext,           -- Non-stupid context
143         ifConArgTys  :: [IfaceType],            -- Arg types
144         ifConFields  :: [OccName],              -- ...ditto... (field labels)
145         ifConStricts :: [HsBang]}               -- Empty (meaning all lazy),
146                                                 -- or 1-1 corresp with arg tys
147
148 data IfaceClsInst
149   = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
150                    ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
151                    ifDFun     :: IfExtName,                -- The dfun
152                    ifOFlag    :: OverlapFlag,              -- Overlap flag
153                    ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
154         -- There's always a separate IfaceDecl for the DFun, which gives
155         -- its IdInfo with its full type and version number.
156         -- The instance declarations taken together have a version number,
157         -- and we don't want that to wobble gratuitously
158         -- If this instance decl is *used*, we'll record a usage on the dfun;
159         -- and if the head does not change it won't be used if it wasn't before
160
161 data IfaceFamInst
162   = IfaceFamInst { ifFamInstFam   :: IfExtName           -- Family name
163                  , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
164                  , ifFamInstAxiom :: IfExtName           -- The axiom
165                  , ifFamInstOrph  :: Maybe OccName       -- Just like IfaceClsInst
166                  }
167
168 data IfaceRule
169   = IfaceRule {
170         ifRuleName   :: RuleName,
171         ifActivation :: Activation,
172         ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
173         ifRuleHead   :: IfExtName,      -- Head of lhs
174         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
175         ifRuleRhs    :: IfaceExpr,
176         ifRuleAuto   :: Bool,
177         ifRuleOrph   :: Maybe OccName   -- Just like IfaceClsInst
178     }
179
180 data IfaceAnnotation
181   = IfaceAnnotation {
182         ifAnnotatedTarget :: IfaceAnnTarget,
183         ifAnnotatedValue :: Serialized
184   }
185
186 type IfaceAnnTarget = AnnTarget OccName
187
188 -- We only serialise the IdDetails of top-level Ids, and even then
189 -- we only need a very limited selection.  Notably, none of the
190 -- implicit ones are needed here, becuase they are not put it
191 -- interface files
192
193 data IfaceIdDetails
194   = IfVanillaId
195   | IfRecSelId IfaceTyCon Bool
196   | IfDFunId 
197
198 data IfaceIdInfo
199   = NoInfo                      -- When writing interface file without -O
200   | HasInfo [IfaceInfoItem]     -- Has info, and here it is
201
202 -- Here's a tricky case:
203 --   * Compile with -O module A, and B which imports A.f
204 --   * Change function f in A, and recompile without -O
205 --   * When we read in old A.hi we read in its IdInfo (as a thunk)
206 --      (In earlier GHCs we used to drop IdInfo immediately on reading,
207 --       but we do not do that now.  Instead it's discarded when the
208 --       ModIface is read into the various decl pools.)
209 --   * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
210 --      and so gives a new version.
211
212 data IfaceInfoItem
213   = HsArity      Arity
214   | HsStrictness StrictSig
215   | HsInline     InlinePragma
216   | HsUnfold     Bool             -- True <=> isStrongLoopBreaker is true
217                  IfaceUnfolding   -- See Note [Expose recursive functions]
218   | HsNoCafRefs
219
220 -- NB: Specialisations and rules come in separately and are
221 -- only later attached to the Id.  Partial reason: some are orphans.
222
223 data IfaceUnfolding
224   = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
225                                 -- Possibly could eliminate the Bool here, the information
226                                 -- is also in the InlinePragma.
227
228   | IfCompulsory IfaceExpr      -- Only used for default methods, in fact
229
230   | IfInlineRule Arity          -- INLINE pragmas
231                  Bool           -- OK to inline even if *un*-saturated
232                  Bool           -- OK to inline even if context is boring
233                  IfaceExpr
234
235   | IfExtWrapper Arity IfExtName  -- NB: sometimes we need a IfExtName (not just IfLclName)
236   | IfLclWrapper Arity IfLclName  --     because the worker can simplify to a function in
237                                   --     another module.
238
239   | IfDFunUnfold [IfaceExpr]
240
241 --------------------------------
242 data IfaceExpr
243   = IfaceLcl    IfLclName
244   | IfaceExt    IfExtName
245   | IfaceType   IfaceType
246   | IfaceCo     IfaceType               -- We re-use IfaceType for coercions
247   | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
248   | IfaceLam    IfaceBndr IfaceExpr
249   | IfaceApp    IfaceExpr IfaceExpr
250   | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
251   | IfaceLet    IfaceBinding  IfaceExpr
252   | IfaceCast   IfaceExpr IfaceCoercion
253   | IfaceLit    Literal
254   | IfaceFCall  ForeignCall IfaceType
255   | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E
256
257 data IfaceTickish
258   = IfaceHpcTick Module Int                -- from HpcTick x
259   | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
260   -- no breakpoints: we never export these into interface files
261
262 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
263         -- Note: IfLclName, not IfaceBndr (and same with the case binder)
264         -- We reconstruct the kind/type of the thing from the context
265         -- thus saving bulk in interface files
266
267 data IfaceConAlt = IfaceDefault
268                  | IfaceDataAlt IfExtName
269                  | IfaceLitAlt Literal
270
271 data IfaceBinding
272   = IfaceNonRec IfaceLetBndr IfaceExpr
273   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
274
275 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
276 -- It's used for *non-top-level* let/rec binders
277 -- See Note [IdInfo on nested let-bindings]
278 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
279 \end{code}
280
281 Note [Expose recursive functions]
282 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
283 For supercompilation we want to put *all* unfoldings in the interface
284 file, even for functions that are recursive (or big).  So we need to
285 know when an unfolding belongs to a loop-breaker so that we can refrain
286 from inlining it (except during supercompilation).
287
288 Note [IdInfo on nested let-bindings]
289 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
290 Occasionally we want to preserve IdInfo on nested let bindings. The one
291 that came up was a NOINLINE pragma on a let-binding inside an INLINE
292 function.  The user (Duncan Coutts) really wanted the NOINLINE control
293 to cross the separate compilation boundary.
294
295 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
296 that is what is seen by importing module with --make
297
298 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
299 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
300 Class instances, rules, and family instances are divided into orphans
301 and non-orphans.  Roughly speaking, an instance/rule is an orphan if
302 its left hand side mentions nothing defined in this module.  Orphan-hood
303 has two major consequences
304
305  * A non-orphan is not finger-printed separately.  Instead, for
306    fingerprinting purposes it is treated as part of the entity it
307    mentions on the LHS.  For example
308       data T = T1 | T2
309       instance Eq T where ....
310    The instance (Eq T) is incorprated as part of T's fingerprint.
311
312    In constrast, orphans are all fingerprinted together in the 
313    mi_orph_hash field of the ModIface. 
314   
315    See MkIface.addFingerprints.
316
317  * A module that contains orphans is called an "orphan module".  If
318    the module being compiled depends (transitively) on an oprhan
319    module M, then M.hi is read in regardless of whether M is oherwise
320    needed. This is to ensure that we don't miss any instance decls in
321    M.  But it's painful, because it means we need to keep track of all
322    the orphan modules below us.
323
324 Orphan-hood is computed when we generate an IfaceInst, IfaceRule, or
325 IfaceFamInst respectively: 
326
327  - If an instance is an orphan its ifInstOprh field is Nothing
328    Otherwise ifInstOrph is (Just n) where n is the Name of a
329    local class or tycon that witnesses its non-orphan-hood.
330    This computation is done by MkIface.instanceToIfaceInst
331
332  - Similarly for ifRuleOrph
333    The computation is done by MkIface.coreRuleToIfaceRule
334
335 Note [When exactly is an instance decl an orphan?]
336 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
337   (see MkIface.instanceToIfaceInst, which implements this)
338 Roughly speaking, an instance is an orphan if its head (after the =>)
339 mentions nothing defined in this module.  
340
341 Functional dependencies complicate the situation though. Consider
342
343   module M where { class C a b | a -> b }
344
345 and suppose we are compiling module X:
346
347   module X where
348         import M
349         data T = ...
350         instance C Int T where ...
351
352 This instance is an orphan, because when compiling a third module Y we
353 might get a constraint (C Int v), and we'd want to improve v to T.  So
354 we must make sure X's instances are loaded, even if we do not directly
355 use anything from X.
356
357 More precisely, an instance is an orphan iff
358
359   If there are no fundeps, then at least of the names in
360   the instance head is locally defined.
361
362   If there are fundeps, then for every fundep, at least one of the
363   names free in a *non-determined* part of the instance head is
364   defined in this module.
365
366 (Note that these conditions hold trivially if the class is locally
367 defined.)  
368
369 Note [Versioning of instances]
370 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
371 See [http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
372
373 \begin{code}
374 -- -----------------------------------------------------------------------------
375 -- Utils on IfaceSyn
376
377 ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
378 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
379 -- Deeply revolting, because it has to predict what gets bound,
380 -- especially the question of whether there's a wrapper for a datacon
381 -- See Note [Implicit TyThings] in HscTypes
382
383 -- N.B. the set of names returned here *must* match the set of
384 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
385 -- TyThing.getOccName should define a bijection between the two lists.
386 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
387 -- The order of the list does not matter.
388 ifaceDeclImplicitBndrs IfaceData {ifCons = IfAbstractTyCon {}}  = []
389
390 -- Newtype
391 ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ,
392                               ifCons = IfNewTyCon (
393                                         IfCon { ifConOcc = con_occ })})
394   =   -- implicit newtype coercion
395     (mkNewTyCoOcc tc_occ) : -- JPM: newtype coercions shouldn't be implicit
396       -- data constructor and worker (newtypes don't have a wrapper)
397     [con_occ, mkDataConWorkerOcc con_occ]
398
399
400 ifaceDeclImplicitBndrs (IfaceData {ifName = _tc_occ,
401                               ifCons = IfDataTyCon cons })
402   = -- for each data constructor in order,
403     --    data constructor, worker, and (possibly) wrapper
404     concatMap dc_occs cons
405   where
406     dc_occs con_decl
407         | has_wrapper = [con_occ, work_occ, wrap_occ]
408         | otherwise   = [con_occ, work_occ]
409         where
410           con_occ  = ifConOcc con_decl            -- DataCon namespace
411           wrap_occ = mkDataConWrapperOcc con_occ  -- Id namespace
412           work_occ = mkDataConWorkerOcc con_occ   -- Id namespace
413           has_wrapper = ifConWrapper con_decl     -- This is the reason for
414                                                   -- having the ifConWrapper field!
415
416 ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
417                                ifSigs = sigs, ifATs = ats })
418   = --   (possibly) newtype coercion
419     co_occs ++
420     --    data constructor (DataCon namespace)
421     --    data worker (Id namespace)
422     --    no wrapper (class dictionaries never have a wrapper)
423     [dc_occ, dcww_occ] ++
424     -- associated types
425     [ifName at | IfaceAT at _ <- ats ] ++
426     -- superclass selectors
427     [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
428     -- operation selectors
429     [op | IfaceClassOp op  _ _ <- sigs]
430   where
431     n_ctxt = length sc_ctxt
432     n_sigs = length sigs
433     co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
434             | otherwise  = []
435     dcww_occ = mkDataConWorkerOcc dc_occ
436     dc_occ = mkClassDataConOcc cls_tc_occ
437     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
438
439 ifaceDeclImplicitBndrs _ = []
440
441 ----------------------------- Printing IfaceDecl ------------------------------
442
443 instance Outputable IfaceDecl where
444   ppr = pprIfaceDecl
445
446 pprIfaceDecl :: IfaceDecl -> SDoc
447 pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
448                        ifIdDetails = details, ifIdInfo = info})
449   = sep [ ppr var <+> dcolon <+> ppr ty,
450           nest 2 (ppr details),
451           nest 2 (ppr info) ]
452
453 pprIfaceDecl (IfaceForeign {ifName = tycon})
454   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
455
456 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
457                         ifSynRhs = Just mono_ty})
458   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
459        4 (vcat [equals <+> ppr mono_ty])
460
461 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
462                         ifSynRhs = Nothing, ifSynKind = kind })
463   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
464        4 (dcolon <+> ppr kind)
465
466 pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
467                          ifTyVars = tyvars, ifCons = condecls,
468                          ifRec = isrec, ifAxiom = mbAxiom})
469   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
470        4 (vcat [pprRec isrec, pp_condecls tycon condecls,
471                 pprAxiom mbAxiom])
472   where
473     pp_nd = case condecls of
474                 IfAbstractTyCon dis -> ptext (sLit "abstract") <> parens (ppr dis)
475                 IfDataFamTyCon     -> ptext (sLit "data family")
476                 IfDataTyCon _       -> ptext (sLit "data")
477                 IfNewTyCon _        -> ptext (sLit "newtype")
478
479 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
480                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
481                           ifRec = isrec})
482   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
483        4 (vcat [pprRec isrec,
484                 sep (map ppr ats),
485                 sep (map ppr sigs)])
486
487 pprIfaceDecl (IfaceAxiom {ifName = name, ifTyVars = tyvars,
488                           ifLHS = lhs, ifRHS = rhs})
489   = hang (ptext (sLit "axiom") <+> ppr name <+> ppr tyvars)
490        2 (dcolon <+> ppr lhs <+> text "~#" <+> ppr rhs)
491
492 pprRec :: RecFlag -> SDoc
493 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
494
495 pprAxiom :: Maybe Name -> SDoc
496 pprAxiom Nothing   = ptext (sLit "FamilyInstance: none")
497 pprAxiom (Just ax) = ptext (sLit "FamilyInstance:") <+> ppr ax
498
499 instance Outputable IfaceClassOp where
500    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
501
502 instance Outputable IfaceAT where
503    ppr (IfaceAT d defs) = hang (ppr d) 2 (vcat (map ppr defs))
504
505 instance Outputable IfaceATDefault where
506    ppr (IfaceATD tvs pat_tys ty) = ppr tvs <+> hsep (map ppr pat_tys) <+> char '=' <+> ppr ty
507
508 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
509 pprIfaceDeclHead context thing tyvars
510   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
511           pprIfaceTvBndrs tyvars]
512
513 pp_condecls :: OccName -> IfaceConDecls -> SDoc
514 pp_condecls _  (IfAbstractTyCon {}) = empty
515 pp_condecls _  IfDataFamTyCon      = empty
516 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
517 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
518                                                             (map (pprIfaceConDecl tc) cs))
519
520 mkIfaceEqPred :: IfaceType -> IfaceType -> IfacePredType
521 -- IA0_NOTE: This is wrong, but only used for pretty-printing.
522 mkIfaceEqPred ty1 ty2 = IfaceTyConApp (IfaceTc eqTyConName) [ty1, ty2]
523
524 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
525 pprIfaceConDecl tc
526         (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
527                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
528                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
529                  ifConStricts = strs, ifConFields = fields })
530   = sep [main_payload,
531          if is_infix then ptext (sLit "Infix") else empty,
532          if has_wrap then ptext (sLit "HasWrapper") else empty,
533          ppUnless (null strs) $
534             nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
535          ppUnless (null fields) $
536             nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
537   where
538     ppr_bang HsNoBang = char '_'        -- Want to see these
539     ppr_bang bang     = ppr bang
540
541     main_payload = ppr name <+> dcolon <+>
542                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
543
544     eq_ctxt = [(mkIfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
545               | (tv,ty) <- eq_spec]
546
547         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
548         -- because we don't have a Name for the tycon, only an OccName
549     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
550                 (t:ts) -> fsep (t : map (arrow <+>) ts)
551                 []     -> panic "pp_con_taus"
552
553     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
554
555 instance Outputable IfaceRule where
556   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
557                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
558     = sep [hsep [doubleQuotes (ftext name), ppr act,
559                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
560            nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
561                         ptext (sLit "=") <+> ppr rhs])
562       ]
563
564 instance Outputable IfaceClsInst where
565   ppr (IfaceClsInst {ifDFun = dfun_id, ifOFlag = flag,
566                   ifInstCls = cls, ifInstTys = mb_tcs})
567     = hang (ptext (sLit "instance") <+> ppr flag
568                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
569          2 (equals <+> ppr dfun_id)
570
571 instance Outputable IfaceFamInst where
572   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
573                      ifFamInstAxiom = tycon_ax})
574     = hang (ptext (sLit "family instance") <+>
575             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
576          2 (equals <+> ppr tycon_ax)
577
578 ppr_rough :: Maybe IfaceTyCon -> SDoc
579 ppr_rough Nothing   = dot
580 ppr_rough (Just tc) = ppr tc
581 \end{code}
582
583
584 ----------------------------- Printing IfaceExpr ------------------------------------
585
586 \begin{code}
587 instance Outputable IfaceExpr where
588     ppr e = pprIfaceExpr noParens e
589
590 pprParendIfaceExpr :: IfaceExpr -> SDoc
591 pprParendIfaceExpr = pprIfaceExpr parens
592
593 -- | Pretty Print an IfaceExpre
594 --
595 -- The first argument should be a function that adds parens in context that need
596 -- an atomic value (e.g. function args)
597 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
598
599 pprIfaceExpr _       (IfaceLcl v)       = ppr v
600 pprIfaceExpr _       (IfaceExt v)       = ppr v
601 pprIfaceExpr _       (IfaceLit l)       = ppr l
602 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
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 (IfaceTick tickish e)
647   = add_par (pprIfaceTickish tickish <+> pprIfaceExpr noParens e)
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 con bs = ppr con <+> hsep (map ppr bs)
655
656 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
657 ppr_bind (IfLetBndr b ty info, rhs)
658   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
659          equals <+> pprIfaceExpr noParens rhs]
660
661 ------------------
662 pprIfaceTickish :: IfaceTickish -> SDoc
663 pprIfaceTickish (IfaceHpcTick m ix)
664   = braces (text "tick" <+> ppr m <+> ppr ix)
665 pprIfaceTickish (IfaceSCC cc tick scope)
666   = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)
667
668 ------------------
669 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
670 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
671                                           nest 2 (pprParendIfaceExpr arg) : args
672 pprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)
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
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          = ptext (sLit "DFunId")
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   maybe emptyNameSet unitNameSet (ifAxiom d) &&&
735   freeNamesIfContext (ifCtxt d) &&&
736   freeNamesIfConDecls (ifCons d)
737 freeNamesIfDecl d@IfaceSyn{} =
738   freeNamesIfTvBndrs (ifTyVars d) &&&
739   freeNamesIfSynRhs (ifSynRhs d) &&&
740   freeNamesIfKind (ifSynKind d) -- IA0_NOTE: because of promotion, we
741                                 -- return names in the kind signature
742 freeNamesIfDecl d@IfaceClass{} =
743   freeNamesIfTvBndrs (ifTyVars d) &&&
744   freeNamesIfContext (ifCtxt d) &&&
745   fnList freeNamesIfAT     (ifATs d) &&&
746   fnList freeNamesIfClsSig (ifSigs d)
747 freeNamesIfDecl d@IfaceAxiom{} =
748   freeNamesIfTvBndrs (ifTyVars d) &&&
749   freeNamesIfType (ifLHS d) &&&
750   freeNamesIfType (ifRHS d)
751
752 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
753 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
754 freeNamesIfIdDetails _                 = emptyNameSet
755
756 -- All other changes are handled via the version info on the tycon
757 freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
758 freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
759 freeNamesIfSynRhs Nothing   = emptyNameSet
760
761 freeNamesIfContext :: IfaceContext -> NameSet
762 freeNamesIfContext = fnList freeNamesIfType
763
764 freeNamesIfAT :: IfaceAT -> NameSet
765 freeNamesIfAT (IfaceAT decl defs)
766   = freeNamesIfDecl decl &&&
767     fnList fn_at_def defs
768   where
769     fn_at_def (IfaceATD tvs pat_tys ty)
770       = freeNamesIfTvBndrs tvs &&&
771         fnList freeNamesIfType pat_tys &&&
772         freeNamesIfType ty
773
774 freeNamesIfClsSig :: IfaceClassOp -> NameSet
775 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
776
777 freeNamesIfConDecls :: IfaceConDecls -> NameSet
778 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
779 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
780 freeNamesIfConDecls _               = emptyNameSet
781
782 freeNamesIfConDecl :: IfaceConDecl -> NameSet
783 freeNamesIfConDecl c =
784   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
785   freeNamesIfTvBndrs (ifConExTvs c) &&&
786   freeNamesIfContext (ifConCtxt c) &&&
787   fnList freeNamesIfType (ifConArgTys c) &&&
788   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
789
790 freeNamesIfKind :: IfaceType -> NameSet
791 freeNamesIfKind = freeNamesIfType
792
793 freeNamesIfType :: IfaceType -> NameSet
794 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
795 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
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 freeNamesIfType (IfaceCoConApp tc ts) = 
802    freeNamesIfCo tc &&& fnList freeNamesIfType ts
803
804 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
805 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
806
807 freeNamesIfBndr :: IfaceBndr -> NameSet
808 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
809 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
810
811 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
812 -- Remember IfaceLetBndr is used only for *nested* bindings
813 -- The IdInfo can contain an unfolding (in the case of
814 -- local INLINE pragmas), so look there too
815 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
816                                              &&& freeNamesIfIdInfo info
817
818 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
819 freeNamesIfTvBndr (_fs,k) = freeNamesIfKind k
820     -- kinds can have Names inside, because of promotion
821
822 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
823 freeNamesIfIdBndr = freeNamesIfTvBndr
824
825 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
826 freeNamesIfIdInfo NoInfo      = emptyNameSet
827 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
828
829 freeNamesItem :: IfaceInfoItem -> NameSet
830 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
831 freeNamesItem _              = emptyNameSet
832
833 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
834 freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
835 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
836 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
837 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
838 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
839 freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr vs
840
841 freeNamesIfExpr :: IfaceExpr -> NameSet
842 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
843 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
844 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
845 freeNamesIfExpr (IfaceCo co)      = freeNamesIfType co
846 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
847 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
848 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
849 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
850 freeNamesIfExpr (IfaceTick _ e)   = freeNamesIfExpr e
851
852 freeNamesIfExpr (IfaceCase s _ alts)
853   = freeNamesIfExpr s 
854     &&& fnList fn_alt alts &&& fn_cons alts
855   where
856     fn_alt (_con,_bs,r) = freeNamesIfExpr r
857
858     -- Depend on the data constructors.  Just one will do!
859     -- Note [Tracking data constructors]
860     fn_cons []                            = emptyNameSet
861     fn_cons ((IfaceDefault    ,_,_) : xs) = fn_cons xs
862     fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
863     fn_cons (_                      : _ ) = emptyNameSet
864
865 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
866   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
867
868 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
869   = fnList fn_pair as &&& freeNamesIfExpr x
870   where
871     fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
872
873 freeNamesIfExpr _ = emptyNameSet
874
875 freeNamesIfTc :: IfaceTyCon -> NameSet
876 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
877 -- ToDo: shouldn't we include IfaceIntTc & co.?
878 freeNamesIfTc _ = emptyNameSet
879
880 freeNamesIfCo :: IfaceCoCon -> NameSet
881 freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
882 -- ToDo: include IfaceIPCoAx? Probably not necessary.
883 freeNamesIfCo _ = emptyNameSet
884
885 freeNamesIfRule :: IfaceRule -> NameSet
886 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
887                            , ifRuleArgs = es, ifRuleRhs = rhs })
888   = unitNameSet f &&&
889     fnList freeNamesIfBndr bs &&&
890     fnList freeNamesIfExpr es &&&
891     freeNamesIfExpr rhs
892     
893 freeNamesIfFamInst :: IfaceFamInst -> NameSet
894 freeNamesIfFamInst (IfaceFamInst { ifFamInstFam = famName
895                                  , ifFamInstAxiom = axName })
896   = unitNameSet famName &&&
897     unitNameSet axName
898
899 -- helpers
900 (&&&) :: NameSet -> NameSet -> NameSet
901 (&&&) = unionNameSets
902
903 fnList :: (a -> NameSet) -> [a] -> NameSet
904 fnList f = foldr (&&&) emptyNameSet . map f
905 \end{code}
906
907 Note [Tracking data constructors]
908 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
909 In a case expression
910    case e of { C a -> ...; ... }
911 You might think that we don't need to include the datacon C
912 in the free names, because its type will probably show up in
913 the free names of 'e'.  But in rare circumstances this may
914 not happen.   Here's the one that bit me:
915
916    module DynFlags where
917      import {-# SOURCE #-} Packages( PackageState )
918      data DynFlags = DF ... PackageState ...
919
920    module Packages where
921      import DynFlags
922      data PackageState = PS ...
923      lookupModule (df :: DynFlags)
924         = case df of
925               DF ...p... -> case p of
926                                PS ... -> ...
927
928 Now, lookupModule depends on DynFlags, but the transitive dependency
929 on the *locally-defined* type PackageState is not visible. We need
930 to take account of the use of the data constructor PS in the pattern match.
931