935b8eda93590c54061428ad4a819d81a380cd7b
[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 {-# LANGUAGE CPP #-}
8 {-# OPTIONS_GHC -fno-warn-tabs #-}
9 -- The above warning supression flag is a temporary kludge.
10 -- While working on this module you are encouraged to remove it and
11 -- detab the module (please do the detabbing in a separate patch). See
12 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
13 -- for details
14
15 module IfaceSyn (
16         module IfaceType,
17
18         IfaceDecl(..), IfaceSynTyConRhs(..), IfaceClassOp(..), IfaceAT(..), 
19         IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
20         IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
21         IfaceBinding(..), IfaceConAlt(..),
22         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
23         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
24         IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), 
25         IfaceBang(..), IfaceAxBranch(..),
26         IfaceTyConParent(..),
27
28         -- Misc
29         ifaceDeclImplicitBndrs, visibleIfConDecls,
30         ifaceDeclFingerprints,
31
32         -- Free Names
33         freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
34
35         -- Pretty printing
36         pprIfaceExpr,
37         pprIfaceDecl,
38         ShowSub(..), ShowHowMuch(..)
39     ) where
40
41 #include "HsVersions.h"
42
43 import IfaceType
44 import PprCore()            -- Printing DFunArgs
45 import Demand
46 import Class
47 import NameSet
48 import CoAxiom ( BranchIndex, Role )
49 import Name
50 import CostCentre
51 import Literal
52 import ForeignCall
53 import Annotations( AnnPayload, AnnTarget )
54 import BasicTypes
55 import Outputable
56 import FastString
57 import Module
58 import Fingerprint
59 import Binary
60 import BooleanFormula ( BooleanFormula )
61 import HsBinds
62 import TyCon (Role (..))
63 import StaticFlags (opt_PprStyle_Debug)
64 import Util( filterOut )
65
66 import Control.Monad
67 import System.IO.Unsafe
68 import Data.Maybe (isJust)
69
70 infixl 3 &&&
71 \end{code}
72
73
74 %************************************************************************
75 %*                                                                      *
76                     Declarations
77 %*                                                                      *
78 %************************************************************************
79
80 \begin{code}
81 type IfaceTopBndr = OccName
82   -- It's convenient to have an OccName in the IfaceSyn, altough in each
83   -- case the namespace is implied by the context. However, having an
84   -- OccNames makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
85   -- very convenient. 
86   --   
87   -- We don't serialise the namespace onto the disk though; rather we 
88   -- drop it when serialising and add it back in when deserialising.
89
90 data IfaceDecl
91   = IfaceId { ifName      :: IfaceTopBndr,
92               ifType      :: IfaceType,
93               ifIdDetails :: IfaceIdDetails,
94               ifIdInfo    :: IfaceIdInfo }
95
96   | IfaceData { ifName       :: IfaceTopBndr,        -- Type constructor
97                 ifCType      :: Maybe CType,    -- C type for CAPI FFI
98                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
99                 ifRoles      :: [Role],         -- Roles
100                 ifCtxt       :: IfaceContext,   -- The "stupid theta"
101                 ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
102                 ifRec        :: RecFlag,        -- Recursive or not?
103                 ifPromotable :: Bool,           -- Promotable to kind level?
104                 ifGadtSyntax :: Bool,           -- True <=> declared using
105                                                 -- GADT syntax
106                 ifParent     :: IfaceTyConParent -- The axiom, for a newtype,
107                                                  -- or data/newtype family instance
108     }
109
110   | IfaceSyn  { ifName    :: IfaceTopBndr,           -- Type constructor
111                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
112                 ifRoles   :: [Role],            -- Roles
113                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
114                 ifSynRhs  :: IfaceSynTyConRhs }
115
116   | IfaceClass { ifCtxt    :: IfaceContext,             -- Context...
117                  ifName    :: IfaceTopBndr,             -- Name of the class TyCon
118                  ifTyVars  :: [IfaceTvBndr],            -- Type variables
119                  ifRoles   :: [Role],                   -- Roles
120                  ifFDs     :: [FunDep FastString],      -- Functional dependencies
121                  ifATs     :: [IfaceAT],                -- Associated type families
122                  ifSigs    :: [IfaceClassOp],           -- Method signatures
123                  ifMinDef  :: BooleanFormula IfLclName, -- Minimal complete definition
124                  ifRec     :: RecFlag                   -- Is newtype/datatype associated
125                                                         --   with the class recursive?
126     }
127
128   | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
129                  ifTyCon      :: IfaceTyCon,     -- LHS TyCon
130                  ifRole       :: Role,           -- Role of axiom
131                  ifAxBranches :: [IfaceAxBranch] -- Branches
132     }
133
134   | IfaceForeign { ifName :: IfaceTopBndr,           -- Needs expanding when we move
135                                                 -- beyond .NET
136                    ifExtName :: Maybe FastString }
137
138   | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym
139                   ifPatIsInfix    :: Bool,
140                   ifPatMatcher    :: IfExtName,
141                   ifPatWrapper    :: Maybe IfExtName,
142                   -- Everything below is redundant,
143                   -- but needed to implement pprIfaceDecl
144                   ifPatUnivTvs    :: [IfaceTvBndr],
145                   ifPatExTvs      :: [IfaceTvBndr],
146                   ifPatProvCtxt   :: IfaceContext,
147                   ifPatReqCtxt    :: IfaceContext,
148                   ifPatArgs       :: [IfaceType],
149                   ifPatTy         :: IfaceType }
150
151
152 data IfaceTyConParent
153   = IfNoParent
154   | IfDataInstance IfExtName
155                    IfaceTyCon
156                    IfaceTcArgs
157
158 data IfaceSynTyConRhs
159   = IfaceOpenSynFamilyTyCon
160   | IfaceClosedSynFamilyTyCon IfExtName       -- name of associated axiom
161                               [IfaceAxBranch] -- for pretty printing purposes only
162   | IfaceAbstractClosedSynFamilyTyCon
163   | IfaceSynonymTyCon IfaceType
164   | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
165
166 data IfaceClassOp = IfaceClassOp IfaceTopBndr DefMethSpec IfaceType
167         -- Nothing    => no default method
168         -- Just False => ordinary polymorphic default method
169         -- Just True  => generic default method
170
171 data IfaceAT = IfaceAT  -- See Class.ClassATItem
172                   IfaceDecl          -- The associated type declaration
173                   (Maybe IfaceType)  -- Default associated type instance, if any
174
175
176 -- This is just like CoAxBranch
177 data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars  :: [IfaceTvBndr]
178                                    , ifaxbLHS     :: IfaceTcArgs
179                                    , ifaxbRoles   :: [Role]
180                                    , ifaxbRHS     :: IfaceType
181                                    , ifaxbIncomps :: [BranchIndex] }
182                                      -- See Note [Storing compatibility] in CoAxiom
183
184 data IfaceConDecls
185   = IfAbstractTyCon Bool        -- c.f TyCon.AbstractTyCon
186   | IfDataFamTyCon              -- Data family
187   | IfDataTyCon [IfaceConDecl]  -- Data type decls
188   | IfNewTyCon  IfaceConDecl    -- Newtype decls
189
190 data IfaceConDecl
191   = IfCon {
192         ifConOcc     :: IfaceTopBndr,                -- Constructor name
193         ifConWrapper :: Bool,                   -- True <=> has a wrapper
194         ifConInfix   :: Bool,                   -- True <=> declared infix
195
196         -- The universal type variables are precisely those
197         -- of the type constructor of this data constructor
198         -- This is *easy* to guarantee when creating the IfCon
199         -- but it's not so easy for the original TyCon/DataCon
200         -- So this guarantee holds for IfaceConDecl, but *not* for DataCon
201
202         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
203         ifConEqSpec  :: IfaceEqSpec,            -- Equality constraints
204         ifConCtxt    :: IfaceContext,           -- Non-stupid context
205         ifConArgTys  :: [IfaceType],            -- Arg types
206         ifConFields  :: [IfaceTopBndr],         -- ...ditto... (field labels)
207         ifConStricts :: [IfaceBang]}            -- Empty (meaning all lazy),
208                                                 -- or 1-1 corresp with arg tys
209
210 type IfaceEqSpec = [(IfLclName,IfaceType)]
211
212 data IfaceBang
213   = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion
214
215 data IfaceClsInst
216   = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
217                    ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
218                    ifDFun     :: IfExtName,                -- The dfun
219                    ifOFlag    :: OverlapFlag,              -- Overlap flag
220                    ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
221         -- There's always a separate IfaceDecl for the DFun, which gives
222         -- its IdInfo with its full type and version number.
223         -- The instance declarations taken together have a version number,
224         -- and we don't want that to wobble gratuitously
225         -- If this instance decl is *used*, we'll record a usage on the dfun;
226         -- and if the head does not change it won't be used if it wasn't before
227
228 -- The ifFamInstTys field of IfaceFamInst contains a list of the rough
229 -- match types
230 data IfaceFamInst
231   = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
232                  , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
233                  , ifFamInstAxiom    :: IfExtName            -- The axiom
234                  , ifFamInstOrph     :: Maybe OccName        -- Just like IfaceClsInst
235                  }
236
237 data IfaceRule
238   = IfaceRule {
239         ifRuleName   :: RuleName,
240         ifActivation :: Activation,
241         ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
242         ifRuleHead   :: IfExtName,      -- Head of lhs
243         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
244         ifRuleRhs    :: IfaceExpr,
245         ifRuleAuto   :: Bool,
246         ifRuleOrph   :: Maybe OccName   -- Just like IfaceClsInst
247     }
248
249 data IfaceAnnotation
250   = IfaceAnnotation {
251         ifAnnotatedTarget :: IfaceAnnTarget,
252         ifAnnotatedValue  :: AnnPayload
253   }
254
255 type IfaceAnnTarget = AnnTarget OccName
256
257 -- Here's a tricky case:
258 --   * Compile with -O module A, and B which imports A.f
259 --   * Change function f in A, and recompile without -O
260 --   * When we read in old A.hi we read in its IdInfo (as a thunk)
261 --      (In earlier GHCs we used to drop IdInfo immediately on reading,
262 --       but we do not do that now.  Instead it's discarded when the
263 --       ModIface is read into the various decl pools.)
264 --   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
265 --      and so gives a new version.
266
267 data IfaceIdInfo
268   = NoInfo                      -- When writing interface file without -O
269   | HasInfo [IfaceInfoItem]     -- Has info, and here it is
270
271 data IfaceInfoItem
272   = HsArity         Arity
273   | HsStrictness    StrictSig
274   | HsInline        InlinePragma
275   | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
276                     IfaceUnfolding   -- See Note [Expose recursive functions]
277   | HsNoCafRefs
278
279 -- NB: Specialisations and rules come in separately and are
280 -- only later attached to the Id.  Partial reason: some are orphans.
281
282 data IfaceUnfolding
283   = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
284                                 -- Possibly could eliminate the Bool here, the information
285                                 -- is also in the InlinePragma.
286
287   | IfCompulsory IfaceExpr      -- Only used for default methods, in fact
288
289   | IfInlineRule Arity          -- INLINE pragmas
290                  Bool           -- OK to inline even if *un*-saturated
291                  Bool           -- OK to inline even if context is boring
292                  IfaceExpr
293
294   | IfDFunUnfold [IfaceBndr] [IfaceExpr]
295
296
297 -- We only serialise the IdDetails of top-level Ids, and even then
298 -- we only need a very limited selection.  Notably, none of the
299 -- implicit ones are needed here, because they are not put it
300 -- interface files
301
302 data IfaceIdDetails
303   = IfVanillaId
304   | IfRecSelId IfaceTyCon Bool
305   | IfDFunId Int          -- Number of silent args
306 \end{code}
307
308
309 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
310 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
311 Class instances, rules, and family instances are divided into orphans
312 and non-orphans.  Roughly speaking, an instance/rule is an orphan if
313 its left hand side mentions nothing defined in this module.  Orphan-hood
314 has two major consequences
315
316  * A non-orphan is not finger-printed separately.  Instead, for
317    fingerprinting purposes it is treated as part of the entity it
318    mentions on the LHS.  For example
319       data T = T1 | T2
320       instance Eq T where ....
321    The instance (Eq T) is incorprated as part of T's fingerprint.
322
323    In constrast, orphans are all fingerprinted together in the 
324    mi_orph_hash field of the ModIface. 
325   
326    See MkIface.addFingerprints.
327
328  * A module that contains orphans is called an "orphan module".  If
329    the module being compiled depends (transitively) on an oprhan
330    module M, then M.hi is read in regardless of whether M is oherwise
331    needed. This is to ensure that we don't miss any instance decls in
332    M.  But it's painful, because it means we need to keep track of all
333    the orphan modules below us.
334
335 Orphan-hood is computed when we generate an IfaceInst, IfaceRule, or
336 IfaceFamInst respectively: 
337
338  - If an instance is an orphan its ifInstOprh field is Nothing
339    Otherwise ifInstOrph is (Just n) where n is the Name of a
340    local class or tycon that witnesses its non-orphan-hood.
341    This computation is done by MkIface.instanceToIfaceInst
342
343  - Similarly for ifRuleOrph
344    The computation is done by MkIface.coreRuleToIfaceRule
345
346 Note [When exactly is an instance decl an orphan?]
347 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
348   (see MkIface.instanceToIfaceInst, which implements this)
349 Roughly speaking, an instance is an orphan if its head (after the =>)
350 mentions nothing defined in this module.  
351
352 Functional dependencies complicate the situation though. Consider
353
354   module M where { class C a b | a -> b }
355
356 and suppose we are compiling module X:
357
358   module X where
359         import M
360         data T = ...
361         instance C Int T where ...
362
363 This instance is an orphan, because when compiling a third module Y we
364 might get a constraint (C Int v), and we'd want to improve v to T.  So
365 we must make sure X's instances are loaded, even if we do not directly
366 use anything from X.
367
368 More precisely, an instance is an orphan iff
369
370   If there are no fundeps, then at least of the names in
371   the instance head is locally defined.
372
373   If there are fundeps, then for every fundep, at least one of the
374   names free in a *non-determined* part of the instance head is
375   defined in this module.
376
377 (Note that these conditions hold trivially if the class is locally
378 defined.)  
379
380 Note [Versioning of instances]
381 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
382 See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
383
384
385 %************************************************************************
386 %*                                                                      *
387                 Functions over declarations
388 %*                                                                      *
389 %************************************************************************
390
391 \begin{code}
392 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
393 visibleIfConDecls (IfAbstractTyCon {}) = []
394 visibleIfConDecls IfDataFamTyCon       = []
395 visibleIfConDecls (IfDataTyCon cs)     = cs
396 visibleIfConDecls (IfNewTyCon c)       = [c]
397 \end{code}
398
399 \begin{code}
400 ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
401 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
402 -- Deeply revolting, because it has to predict what gets bound,
403 -- especially the question of whether there's a wrapper for a datacon
404 -- See Note [Implicit TyThings] in HscTypes
405
406 -- N.B. the set of names returned here *must* match the set of
407 -- TyThings returned by HscTypes.implicitTyThings, in the sense that
408 -- TyThing.getOccName should define a bijection between the two lists.
409 -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
410 -- The order of the list does not matter.
411 ifaceDeclImplicitBndrs IfaceData {ifCons = IfAbstractTyCon {}}  = []
412
413 -- Newtype
414 ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ,
415                               ifCons = IfNewTyCon (
416                                         IfCon { ifConOcc = con_occ })})
417   =   -- implicit newtype coercion
418     (mkNewTyCoOcc tc_occ) : -- JPM: newtype coercions shouldn't be implicit
419       -- data constructor and worker (newtypes don't have a wrapper)
420     [con_occ, mkDataConWorkerOcc con_occ]
421
422
423 ifaceDeclImplicitBndrs (IfaceData {ifName = _tc_occ,
424                               ifCons = IfDataTyCon cons })
425   = -- for each data constructor in order,
426     --    data constructor, worker, and (possibly) wrapper
427     concatMap dc_occs cons
428   where
429     dc_occs con_decl
430         | has_wrapper = [con_occ, work_occ, wrap_occ]
431         | otherwise   = [con_occ, work_occ]
432         where
433           con_occ  = ifConOcc con_decl            -- DataCon namespace
434           wrap_occ = mkDataConWrapperOcc con_occ  -- Id namespace
435           work_occ = mkDataConWorkerOcc con_occ   -- Id namespace
436           has_wrapper = ifConWrapper con_decl     -- This is the reason for
437                                                   -- having the ifConWrapper field!
438
439 ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
440                                ifSigs = sigs, ifATs = ats })
441   = --   (possibly) newtype coercion
442     co_occs ++
443     --    data constructor (DataCon namespace)
444     --    data worker (Id namespace)
445     --    no wrapper (class dictionaries never have a wrapper)
446     [dc_occ, dcww_occ] ++
447     -- associated types
448     [ifName at | IfaceAT at _ <- ats ] ++
449     -- superclass selectors
450     [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
451     -- operation selectors
452     [op | IfaceClassOp op  _ _ <- sigs]
453   where
454     n_ctxt = length sc_ctxt
455     n_sigs = length sigs
456     co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
457             | otherwise  = []
458     dcww_occ = mkDataConWorkerOcc dc_occ
459     dc_occ = mkClassDataConOcc cls_tc_occ
460     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
461
462 ifaceDeclImplicitBndrs _ = []
463
464 -- -----------------------------------------------------------------------------
465 -- The fingerprints of an IfaceDecl
466
467        -- We better give each name bound by the declaration a
468        -- different fingerprint!  So we calculate the fingerprint of
469        -- each binder by combining the fingerprint of the whole
470        -- declaration with the name of the binder. (#5614, #7215)
471 ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)]
472 ifaceDeclFingerprints hash decl
473   = (ifName decl, hash) :
474     [ (occ, computeFingerprint' (hash,occ))
475     | occ <- ifaceDeclImplicitBndrs decl ]
476   where
477      computeFingerprint' =
478        unsafeDupablePerformIO
479         . computeFingerprint (panic "ifaceDeclFingerprints")
480 \end{code}
481
482 %************************************************************************
483 %*                                                                      *
484                 Expressions
485 %*                                                                      *
486 %************************************************************************
487
488 \begin{code}
489 data IfaceExpr
490   = IfaceLcl    IfLclName
491   | IfaceExt    IfExtName
492   | IfaceType   IfaceType
493   | IfaceCo     IfaceCoercion
494   | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
495   | IfaceLam    IfaceBndr IfaceExpr
496   | IfaceApp    IfaceExpr IfaceExpr
497   | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
498   | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
499   | IfaceLet    IfaceBinding  IfaceExpr
500   | IfaceCast   IfaceExpr IfaceCoercion
501   | IfaceLit    Literal
502   | IfaceFCall  ForeignCall IfaceType
503   | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E
504
505 data IfaceTickish
506   = IfaceHpcTick Module Int                -- from HpcTick x
507   | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
508   -- no breakpoints: we never export these into interface files
509
510 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
511         -- Note: IfLclName, not IfaceBndr (and same with the case binder)
512         -- We reconstruct the kind/type of the thing from the context
513         -- thus saving bulk in interface files
514
515 data IfaceConAlt = IfaceDefault
516                  | IfaceDataAlt IfExtName
517                  | IfaceLitAlt Literal
518
519 data IfaceBinding
520   = IfaceNonRec IfaceLetBndr IfaceExpr
521   | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
522
523 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
524 -- It's used for *non-top-level* let/rec binders
525 -- See Note [IdInfo on nested let-bindings]
526 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
527 \end{code}
528
529 Note [Empty case alternatives]
530 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
531 In IfaceSyn an IfaceCase does not record the types of the alternatives,
532 unlike CorSyn Case.  But we need this type if the alternatives are empty.
533 Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.
534
535 Note [Expose recursive functions]
536 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
537 For supercompilation we want to put *all* unfoldings in the interface
538 file, even for functions that are recursive (or big).  So we need to
539 know when an unfolding belongs to a loop-breaker so that we can refrain
540 from inlining it (except during supercompilation).
541
542 Note [IdInfo on nested let-bindings]
543 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
544 Occasionally we want to preserve IdInfo on nested let bindings. The one
545 that came up was a NOINLINE pragma on a let-binding inside an INLINE
546 function.  The user (Duncan Coutts) really wanted the NOINLINE control
547 to cross the separate compilation boundary.
548
549 In general we retain all info that is left by CoreTidy.tidyLetBndr, since
550 that is what is seen by importing module with --make
551
552
553 %************************************************************************
554 %*                                                                      *
555               Printing IfaceDecl
556 %*                                                                      *
557 %************************************************************************
558
559 \begin{code}
560 pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc
561 -- The TyCon might be local (just an OccName), or this might
562 -- be a branch for an imported TyCon, so it would be an ExtName
563 -- So it's easier to take an SDoc here
564 pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
565                                   , ifaxbLHS = pat_tys
566                                   , ifaxbRHS = rhs
567                                   , ifaxbIncomps = incomps })
568   = hang (pprUserIfaceForAll tvs)
569        2 (hang pp_lhs 2 (equals <+> ppr rhs))
570     $+$
571     nest 2 maybe_incomps
572   where
573     pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
574     maybe_incomps = ppUnless (null incomps) $ parens $
575                     ptext (sLit "incompatible indices:") <+> ppr incomps
576
577 instance Outputable IfaceAnnotation where
578   ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
579
580 instance HasOccName IfaceClassOp where
581   occName (IfaceClassOp n _ _) = n
582
583 instance HasOccName IfaceConDecl where
584   occName = ifConOcc
585
586 instance HasOccName IfaceDecl where
587   occName = ifName
588
589 instance Outputable IfaceDecl where
590   ppr = pprIfaceDecl showAll
591
592 data ShowSub
593   = ShowSub
594       { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
595                                         -- See Note [Printing IfaceDecl binders]
596       , ss_how_much :: ShowHowMuch }
597
598 data ShowHowMuch
599   = ShowHeader   -- Header information only, not rhs
600   | ShowSome [OccName]    -- []     <=> Print all sub-components
601                           -- (n:ns) <=> print sub-component 'n' with ShowSub=ns
602                           --            elide other sub-components to "..."
603                           -- May 14: the list is max 1 element long at the moment
604   | ShowIface    -- Everything including GHC-internal information (used in --show-iface)
605
606 showAll :: ShowSub
607 showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }
608
609 ppShowIface :: ShowSub -> SDoc -> SDoc
610 ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
611 ppShowIface _                                     _   = empty
612
613 ppShowRhs :: ShowSub -> SDoc -> SDoc
614 ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = empty
615 ppShowRhs _                                      doc = doc
616
617 showSub :: HasOccName n => ShowSub -> n -> Bool
618 showSub (ShowSub { ss_how_much = ShowHeader })     _     = False
619 showSub (ShowSub { ss_how_much = ShowSome (n:_) }) thing = n == occName thing
620 showSub (ShowSub { ss_how_much = _ })              _     = True
621 \end{code}
622
623 Note [Printing IfaceDecl binders]
624 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
625 The binders in an IfaceDecl are just OccNames, so we don't know what module they
626 come from.  But when we pretty-print a TyThing by converting to an IfaceDecl
627 (see PprTyThing), the TyThing may come from some other module so we really need
628 the module qualifier.  We solve this by passing in a pretty-printer for the
629 binders.
630
631 When printing an interface file (--show-iface), we want to print
632 everything unqualified, so we can just print the OccName directly.
633
634 \begin{code}
635 ppr_trim :: [Maybe SDoc] -> [SDoc]
636 -- Collapse a group of Nothings to a single "..."
637 ppr_trim xs
638   = snd (foldr go (False, []) xs)
639   where
640     go (Just doc) (_,     so_far) = (False, doc : so_far)
641     go Nothing    (True,  so_far) = (True, so_far)
642     go Nothing    (False, so_far) = (True, ptext (sLit "...") : so_far)
643
644 isIfaceDataInstance :: IfaceTyConParent -> Bool
645 isIfaceDataInstance IfNoParent = False
646 isIfaceDataInstance _          = True
647
648 pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
649 -- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
650 --     See Note [Pretty-printing TyThings] in PprTyThing
651 pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
652                              ifCtxt = context, ifTyVars = tc_tyvars,
653                              ifRoles = roles, ifCons = condecls,
654                              ifParent = parent, ifRec = isrec,
655                              ifGadtSyntax = gadt,
656                              ifPromotable = is_prom })
657
658   | gadt_style = vcat [ pp_roles
659                       , pp_nd <+> pp_lhs <+> pp_where
660                       , nest 2 (vcat pp_cons)
661                       , nest 2 $ ppShowIface ss pp_extra ]
662   | otherwise  = vcat [ pp_roles
663                       , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
664                       , nest 2 $ ppShowIface ss pp_extra ]
665   where
666     is_data_instance = isIfaceDataInstance parent
667
668     gadt_style = gadt || any (not . isVanillaIfaceConDecl) cons
669     cons       = visibleIfConDecls condecls
670     pp_where   = ppWhen (gadt_style && not (null cons)) $ ptext (sLit "where")
671     pp_cons    = ppr_trim (map show_con cons) :: [SDoc]
672
673     pp_lhs = case parent of
674                IfNoParent -> pprIfaceDeclHead context ss tycon tc_tyvars
675                _          -> ptext (sLit "instance") <+> pprIfaceTyConParent parent
676
677     pp_roles
678       | is_data_instance = empty
679       | otherwise        = pprRoles (== Representational) (pprPrefixIfDeclBndr ss tycon) 
680                                     tc_tyvars roles
681             -- Don't display roles for data family instances (yet)
682             -- See discussion on Trac #8672.
683
684     add_bars []     = empty
685     add_bars (c:cs) = sep ((equals <+> c) : map (char '|' <+>) cs)
686
687     ok_con dc = showSub ss dc || any (showSub ss) (ifConFields dc)
688
689     show_con dc
690       | ok_con dc = Just $ pprIfaceConDecl ss gadt_style mk_user_con_res_ty dc
691       | otherwise = Nothing
692
693     mk_user_con_res_ty :: IfaceEqSpec -> ([IfaceTvBndr], SDoc)
694     -- See Note [Result type of a data family GADT]
695     mk_user_con_res_ty eq_spec
696       | IfDataInstance _ tc tys <- parent
697       = (con_univ_tvs, pprIfaceType (IfaceTyConApp tc (substIfaceTcArgs gadt_subst tys)))
698       | otherwise
699       = (con_univ_tvs, sdocWithDynFlags (ppr_tc_app gadt_subst))
700       where
701         gadt_subst = mkFsEnv eq_spec
702         done_univ_tv (tv,_) = isJust (lookupFsEnv gadt_subst tv)
703         con_univ_tvs = filterOut done_univ_tv tc_tyvars
704
705     ppr_tc_app gadt_subst dflags
706        = pprPrefixIfDeclBndr ss tycon
707          <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
708                  | (tv,_kind) <- stripIfaceKindVars dflags tc_tyvars ]
709
710     pp_nd = case condecls of
711               IfAbstractTyCon d -> ptext (sLit "abstract") <> ppShowIface ss (parens (ppr d))
712               IfDataFamTyCon    -> ptext (sLit "data family")
713               IfDataTyCon _     -> ptext (sLit "data")
714               IfNewTyCon _      -> ptext (sLit "newtype")
715
716     pp_extra = vcat [pprCType ctype, pprRec isrec, pp_prom]
717
718     pp_prom | is_prom   = ptext (sLit "Promotable")
719             | otherwise = empty
720
721
722 pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
723                             , ifCtxt   = context, ifName  = clas
724                             , ifTyVars = tyvars,  ifRoles = roles
725                             , ifFDs    = fds })
726   = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles
727          , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars
728                                 <+> pprFundeps fds <+> pp_where
729          , nest 2 (vcat [vcat asocs, vcat dsigs, pprec])]
730     where
731       pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))
732
733       asocs = ppr_trim $ map maybeShowAssoc ats
734       dsigs = ppr_trim $ map maybeShowSig sigs
735       pprec = ppShowIface ss (pprRec isrec)
736
737       maybeShowAssoc :: IfaceAT -> Maybe SDoc
738       maybeShowAssoc asc@(IfaceAT d _)
739         | showSub ss d = Just $ pprIfaceAT ss asc
740         | otherwise    = Nothing
741
742       maybeShowSig :: IfaceClassOp -> Maybe SDoc
743       maybeShowSig sg
744         | showSub ss sg = Just $  pprIfaceClassOp ss sg
745         | otherwise     = Nothing
746
747 pprIfaceDecl ss (IfaceSyn { ifName   = tc
748                           , ifTyVars = tv
749                           , ifSynRhs = IfaceSynonymTyCon mono_ty })
750   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] ss tc tv <+> equals)
751        2 (sep [pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau])
752   where
753     (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
754
755 pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars
756                           , ifSynRhs = rhs, ifSynKind = kind })
757   = vcat [ hang (text "type family" <+> pprIfaceDeclHead [] ss tycon tyvars <+> dcolon)
758               2 (ppr kind <+> ppShowRhs ss (pp_rhs rhs))
759          , ppShowRhs ss (nest 2 (pp_branches rhs)) ]
760   where
761     pp_rhs IfaceOpenSynFamilyTyCon             = ppShowIface ss (ptext (sLit "open"))
762     pp_rhs IfaceAbstractClosedSynFamilyTyCon   = ppShowIface ss (ptext (sLit "closed, abstract"))
763     pp_rhs (IfaceClosedSynFamilyTyCon _ (_:_)) = ptext (sLit "where")
764     pp_rhs IfaceBuiltInSynFamTyCon = ppShowIface ss (ptext (sLit "built-in"))
765     pp_rhs _ = panic "pprIfaceDecl syn"
766
767     pp_branches (IfaceClosedSynFamilyTyCon ax brs)
768       = vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
769         $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax)
770     pp_branches _ = empty
771
772 pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper,
773                               ifPatIsInfix = is_infix,
774                               ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs,
775                               ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
776                               ifPatArgs = args,
777                               ifPatTy = ty })
778   = pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt)
779   where
780     has_wrap = isJust wrapper
781     args' = case (is_infix, args) of
782         (True, [left_ty, right_ty]) ->
783             InfixPatSyn (pprParendIfaceType left_ty) (pprParendIfaceType right_ty)
784         (_, tys) ->
785             PrefixPatSyn (map pprParendIfaceType tys)
786
787     ty' = pprParendIfaceType ty
788
789     pprCtxt [] = Nothing
790     pprCtxt ctxt = Just $ pprIfaceContext ctxt
791
792 pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
793                               ifIdDetails = details, ifIdInfo = info })
794   = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
795               2 (pprIfaceSigmaType ty)
796          , ppShowIface ss (ppr details)
797          , ppShowIface ss (ppr info) ]
798
799 pprIfaceDecl _ (IfaceForeign {ifName = tycon})
800   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
801
802 pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
803                            , ifAxBranches = branches })
804   = hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
805        2 (vcat $ map (pprAxBranch (ppr tycon)) branches)
806
807
808 pprCType :: Maybe CType -> SDoc
809 pprCType Nothing      = empty
810 pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType
811
812 -- if, for each role, suppress_if role is True, then suppress the role
813 -- output
814 pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTvBndr] -> [Role] -> SDoc
815 pprRoles suppress_if tyCon tyvars roles
816   = sdocWithDynFlags $ \dflags ->
817       let froles = suppressIfaceKinds dflags tyvars roles
818       in ppUnless (all suppress_if roles || null froles) $
819          ptext (sLit "type role") <+> tyCon <+> hsep (map ppr froles)
820
821 pprRec :: RecFlag -> SDoc
822 pprRec NonRecursive = empty
823 pprRec Recursive    = ptext (sLit "RecFlag: Recursive")
824
825 pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
826 pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ 
827   = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
828 pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
829   = parenSymOcc occ (ppr_bndr occ)
830
831 instance Outputable IfaceClassOp where
832    ppr = pprIfaceClassOp showAll
833
834 pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
835 pprIfaceClassOp ss (IfaceClassOp n dm ty) = hang opHdr 2 (pprIfaceSigmaType ty)
836   where opHdr = pprPrefixIfDeclBndr ss n
837                 <+> ppShowIface ss (ppr dm) <+> dcolon
838
839 instance Outputable IfaceAT where
840    ppr = pprIfaceAT showAll
841
842 pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
843 pprIfaceAT ss (IfaceAT d mb_def)
844   = vcat [ pprIfaceDecl ss d
845          , case mb_def of
846               Nothing  -> empty
847               Just rhs -> nest 2 $
848                           ptext (sLit "Default:") <+> ppr rhs ]
849
850 instance Outputable IfaceTyConParent where
851   ppr p = pprIfaceTyConParent p
852
853 pprIfaceTyConParent :: IfaceTyConParent -> SDoc
854 pprIfaceTyConParent IfNoParent
855   = empty
856 pprIfaceTyConParent (IfDataInstance _ tc tys)
857   = sdocWithDynFlags $ \dflags ->
858     let ftys = stripKindArgs dflags tys
859     in pprIfaceTypeApp tc ftys
860
861 pprIfaceDeclHead :: IfaceContext -> ShowSub -> OccName -> [IfaceTvBndr] -> SDoc
862 pprIfaceDeclHead context ss tc_occ tv_bndrs
863   = sdocWithDynFlags $ \ dflags ->
864     sep [ pprIfaceContextArr context
865         , pprPrefixIfDeclBndr ss tc_occ
866           <+> pprIfaceTvBndrs (stripIfaceKindVars dflags tv_bndrs) ]
867
868 isVanillaIfaceConDecl :: IfaceConDecl -> Bool
869 isVanillaIfaceConDecl (IfCon { ifConExTvs  = ex_tvs
870                              , ifConEqSpec = eq_spec
871                              , ifConCtxt   = ctxt })
872   = (null ex_tvs) && (null eq_spec) && (null ctxt)
873
874 pprIfaceConDecl :: ShowSub -> Bool
875                 -> (IfaceEqSpec -> ([IfaceTvBndr], SDoc))
876                 -> IfaceConDecl -> SDoc
877 pprIfaceConDecl ss gadt_style mk_user_con_res_ty
878         (IfCon { ifConOcc = name, ifConInfix = is_infix,
879                  ifConExTvs = ex_tvs,
880                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
881                  ifConStricts = stricts, ifConFields = labels })
882   | gadt_style = pp_prefix_con <+> dcolon <+> ppr_ty
883   | otherwise  = ppr_fields tys_w_strs
884   where
885     tys_w_strs :: [(IfaceBang, IfaceType)]
886     tys_w_strs = zip stricts arg_tys
887     pp_prefix_con = pprPrefixIfDeclBndr ss name
888
889     (univ_tvs, pp_res_ty) = mk_user_con_res_ty eq_spec
890     ppr_ty = pprIfaceForAllPart (univ_tvs ++ ex_tvs) ctxt pp_tau
891
892         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
893         -- because we don't have a Name for the tycon, only an OccName
894     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
895                 (t:ts) -> fsep (t : map (arrow <+>) ts)
896                 []     -> panic "pp_con_taus"
897
898     ppr_bang IfNoBang = ppWhen opt_PprStyle_Debug $ char '_'
899     ppr_bang IfStrict = char '!'
900     ppr_bang IfUnpack = ptext (sLit "{-# UNPACK #-}")
901     ppr_bang (IfUnpackCo co) = ptext (sLit "! {-# UNPACK #-}") <>
902                                pprParendIfaceCoercion co
903
904     pprParendBangTy (bang, ty) = ppr_bang bang <> pprParendIfaceType ty
905     pprBangTy       (bang, ty) = ppr_bang bang <> ppr ty
906
907     maybe_show_label (lbl,bty)
908       | showSub ss lbl = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty)
909       | otherwise      = Nothing
910
911     ppr_fields [ty1, ty2]
912       | is_infix && null labels
913       = sep [pprParendBangTy ty1, pprInfixIfDeclBndr ss name, pprParendBangTy ty2]
914     ppr_fields fields
915       | null labels = pp_prefix_con <+> sep (map pprParendBangTy fields)
916       | otherwise   = pp_prefix_con <+> (braces $ sep $ punctuate comma $ ppr_trim $
917                                     map maybe_show_label (zip labels fields))
918
919 instance Outputable IfaceRule where
920   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
921                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
922     = sep [hsep [doubleQuotes (ftext name), ppr act,
923                  ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
924            nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
925                         ptext (sLit "=") <+> ppr rhs])
926       ]
927
928 instance Outputable IfaceClsInst where
929   ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag
930                     , ifInstCls = cls, ifInstTys = mb_tcs})
931     = hang (ptext (sLit "instance") <+> ppr flag
932                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
933          2 (equals <+> ppr dfun_id)
934
935 instance Outputable IfaceFamInst where
936   ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
937                     , ifFamInstAxiom = tycon_ax})
938     = hang (ptext (sLit "family instance") <+>
939             ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
940          2 (equals <+> ppr tycon_ax)
941
942 ppr_rough :: Maybe IfaceTyCon -> SDoc
943 ppr_rough Nothing   = dot
944 ppr_rough (Just tc) = ppr tc
945 \end{code}
946
947 Note [Result type of a data family GADT]
948 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
949 Consider 
950    data family T a
951    data instance T (p,q) where
952       T1 :: T (Int, Maybe c)
953       T2 :: T (Bool, q)
954
955 The IfaceDecl actually looks like 
956
957    data TPr p q where
958       T1 :: forall p q. forall c. (p~Int,q~Maybe c) => TPr p q
959       T2 :: forall p q. (p~Bool) => TPr p q
960
961 To reconstruct the result types for T1 and T2 that we
962 want to pretty print, we substitute the eq-spec 
963 [p->Int, q->Maybe c] in the arg pattern (p,q) to give
964    T (Int, Maybe c)
965 Remember that in IfaceSyn, the TyCon and DataCon share the same
966 universal type variables.
967
968 ----------------------------- Printing IfaceExpr ------------------------------------
969
970 \begin{code}
971 instance Outputable IfaceExpr where
972     ppr e = pprIfaceExpr noParens e
973
974 noParens :: SDoc -> SDoc
975 noParens pp = pp
976
977 pprParendIfaceExpr :: IfaceExpr -> SDoc
978 pprParendIfaceExpr = pprIfaceExpr parens
979
980 -- | Pretty Print an IfaceExpre
981 --
982 -- The first argument should be a function that adds parens in context that need
983 -- an atomic value (e.g. function args)
984 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
985
986 pprIfaceExpr _       (IfaceLcl v)       = ppr v
987 pprIfaceExpr _       (IfaceExt v)       = ppr v
988 pprIfaceExpr _       (IfaceLit l)       = ppr l
989 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
990 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
991 pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceCoercion co
992
993 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
994 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
995
996 pprIfaceExpr add_par i@(IfaceLam _ _)
997   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
998                   pprIfaceExpr noParens body])
999   where
1000     (bndrs,body) = collect [] i
1001     collect bs (IfaceLam b e) = collect (b:bs) e
1002     collect bs e              = (reverse bs, e)
1003
1004 pprIfaceExpr add_par (IfaceECase scrut ty)
1005   = add_par (sep [ ptext (sLit "case") <+> pprIfaceExpr noParens scrut 
1006                  , ptext (sLit "ret_ty") <+> pprParendIfaceType ty
1007                  , ptext (sLit "of {}") ])
1008
1009 pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
1010   = add_par (sep [ptext (sLit "case") 
1011                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") 
1012                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
1013                   pprIfaceExpr noParens rhs <+> char '}'])
1014
1015 pprIfaceExpr add_par (IfaceCase scrut bndr alts)
1016   = add_par (sep [ptext (sLit "case") 
1017                         <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") 
1018                         <+> ppr bndr <+> char '{',
1019                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
1020
1021 pprIfaceExpr _       (IfaceCast expr co)
1022   = sep [pprParendIfaceExpr expr,
1023          nest 2 (ptext (sLit "`cast`")),
1024          pprParendIfaceCoercion co]
1025
1026 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
1027   = add_par (sep [ptext (sLit "let {"),
1028                   nest 2 (ppr_bind (b, rhs)),
1029                   ptext (sLit "} in"),
1030                   pprIfaceExpr noParens body])
1031
1032 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
1033   = add_par (sep [ptext (sLit "letrec {"),
1034                   nest 2 (sep (map ppr_bind pairs)),
1035                   ptext (sLit "} in"),
1036                   pprIfaceExpr noParens body])
1037
1038 pprIfaceExpr add_par (IfaceTick tickish e)
1039   = add_par (pprIfaceTickish tickish <+> pprIfaceExpr noParens e)
1040
1041 ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
1042 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
1043                          arrow <+> pprIfaceExpr noParens rhs]
1044
1045 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
1046 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
1047
1048 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
1049 ppr_bind (IfLetBndr b ty info, rhs)
1050   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
1051          equals <+> pprIfaceExpr noParens rhs]
1052
1053 ------------------
1054 pprIfaceTickish :: IfaceTickish -> SDoc
1055 pprIfaceTickish (IfaceHpcTick m ix)
1056   = braces (text "tick" <+> ppr m <+> ppr ix)
1057 pprIfaceTickish (IfaceSCC cc tick scope)
1058   = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)
1059
1060 ------------------
1061 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
1062 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
1063                                           nest 2 (pprParendIfaceExpr arg) : args
1064 pprIfaceApp fun                args = sep (pprParendIfaceExpr fun : args)
1065
1066 ------------------
1067 instance Outputable IfaceConAlt where
1068     ppr IfaceDefault      = text "DEFAULT"
1069     ppr (IfaceLitAlt l)   = ppr l
1070     ppr (IfaceDataAlt d)  = ppr d
1071
1072 ------------------
1073 instance Outputable IfaceIdDetails where
1074   ppr IfVanillaId       = empty
1075   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
1076                           <+> if b then ptext (sLit "<naughty>") else empty
1077   ppr (IfDFunId ns)     = ptext (sLit "DFunId") <> brackets (int ns)
1078
1079 instance Outputable IfaceIdInfo where
1080   ppr NoInfo       = empty
1081   ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
1082                      <+> ptext (sLit "-}")
1083
1084 instance Outputable IfaceInfoItem where
1085   ppr (HsUnfold lb unf)     = ptext (sLit "Unfolding")
1086                               <> ppWhen lb (ptext (sLit "(loop-breaker)"))
1087                               <> colon <+> ppr unf
1088   ppr (HsInline prag)       = ptext (sLit "Inline:") <+> ppr prag
1089   ppr (HsArity arity)       = ptext (sLit "Arity:") <+> int arity
1090   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
1091   ppr HsNoCafRefs           = ptext (sLit "HasNoCafRefs")
1092
1093 instance Outputable IfaceUnfolding where
1094   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
1095   ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty)
1096                               <+> parens (ppr e)
1097   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule")
1098                                             <+> ppr (a,uok,bok),
1099                                         pprParendIfaceExpr e]
1100   ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot)
1101                                 2 (sep (map pprParendIfaceExpr es))
1102 \end{code}
1103
1104 %************************************************************************
1105 %*                                                                      *
1106               Finding the Names in IfaceSyn
1107 %*                                                                      *
1108 %************************************************************************
1109
1110 This is used for dependency analysis in MkIface, so that we
1111 fingerprint a declaration before the things that depend on it.  It
1112 is specific to interface-file fingerprinting in the sense that we
1113 don't collect *all* Names: for example, the DFun of an instance is
1114 recorded textually rather than by its fingerprint when
1115 fingerprinting the instance, so DFuns are not dependencies.
1116
1117 \begin{code}
1118 freeNamesIfDecl :: IfaceDecl -> NameSet
1119 freeNamesIfDecl (IfaceId _s t d i) =
1120   freeNamesIfType t &&&
1121   freeNamesIfIdInfo i &&&
1122   freeNamesIfIdDetails d
1123 freeNamesIfDecl IfaceForeign{} =
1124   emptyNameSet
1125 freeNamesIfDecl d@IfaceData{} =
1126   freeNamesIfTvBndrs (ifTyVars d) &&&
1127   freeNamesIfaceTyConParent (ifParent d) &&&
1128   freeNamesIfContext (ifCtxt d) &&&
1129   freeNamesIfConDecls (ifCons d)
1130 freeNamesIfDecl d@IfaceSyn{} =
1131   freeNamesIfTvBndrs (ifTyVars d) &&&
1132   freeNamesIfSynRhs (ifSynRhs d) &&&
1133   freeNamesIfKind (ifSynKind d) -- IA0_NOTE: because of promotion, we
1134                                 -- return names in the kind signature
1135 freeNamesIfDecl d@IfaceClass{} =
1136   freeNamesIfTvBndrs (ifTyVars d) &&&
1137   freeNamesIfContext (ifCtxt d) &&&
1138   fnList freeNamesIfAT     (ifATs d) &&&
1139   fnList freeNamesIfClsSig (ifSigs d)
1140 freeNamesIfDecl d@IfaceAxiom{} =
1141   freeNamesIfTc (ifTyCon d) &&&
1142   fnList freeNamesIfAxBranch (ifAxBranches d)
1143 freeNamesIfDecl d@IfacePatSyn{} =
1144   unitNameSet (ifPatMatcher d) &&&
1145   maybe emptyNameSet unitNameSet (ifPatWrapper d) &&&
1146   freeNamesIfTvBndrs (ifPatUnivTvs d) &&&
1147   freeNamesIfTvBndrs (ifPatExTvs d) &&&
1148   freeNamesIfContext (ifPatProvCtxt d) &&&
1149   freeNamesIfContext (ifPatReqCtxt d) &&&
1150   fnList freeNamesIfType (ifPatArgs d) &&&
1151   freeNamesIfType (ifPatTy d)
1152
1153 freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
1154 freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars = tyvars
1155                                    , ifaxbLHS    = lhs
1156                                    , ifaxbRHS    = rhs }) =
1157   freeNamesIfTvBndrs tyvars &&&
1158   freeNamesIfTcArgs lhs &&&
1159   freeNamesIfType rhs
1160
1161 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
1162 freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
1163 freeNamesIfIdDetails _                 = emptyNameSet
1164
1165 -- All other changes are handled via the version info on the tycon
1166 freeNamesIfSynRhs :: IfaceSynTyConRhs -> NameSet
1167 freeNamesIfSynRhs (IfaceSynonymTyCon ty)            = freeNamesIfType ty
1168 freeNamesIfSynRhs IfaceOpenSynFamilyTyCon           = emptyNameSet
1169 freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax br)
1170   = unitNameSet ax &&& fnList freeNamesIfAxBranch br
1171 freeNamesIfSynRhs IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
1172 freeNamesIfSynRhs IfaceBuiltInSynFamTyCon = emptyNameSet
1173
1174 freeNamesIfContext :: IfaceContext -> NameSet
1175 freeNamesIfContext = fnList freeNamesIfType
1176
1177 freeNamesIfAT :: IfaceAT -> NameSet
1178 freeNamesIfAT (IfaceAT decl mb_def)
1179   = freeNamesIfDecl decl &&&
1180     case mb_def of
1181       Nothing  -> emptyNameSet
1182       Just rhs -> freeNamesIfType rhs
1183
1184 freeNamesIfClsSig :: IfaceClassOp -> NameSet
1185 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
1186
1187 freeNamesIfConDecls :: IfaceConDecls -> NameSet
1188 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
1189 freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
1190 freeNamesIfConDecls _               = emptyNameSet
1191
1192 freeNamesIfConDecl :: IfaceConDecl -> NameSet
1193 freeNamesIfConDecl c
1194   = freeNamesIfTvBndrs (ifConExTvs c) &&&
1195     freeNamesIfContext (ifConCtxt c) &&&
1196     fnList freeNamesIfType (ifConArgTys c) &&&
1197     fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
1198
1199 freeNamesIfKind :: IfaceType -> NameSet
1200 freeNamesIfKind = freeNamesIfType
1201
1202 freeNamesIfTcArgs :: IfaceTcArgs -> NameSet
1203 freeNamesIfTcArgs (ITC_Type t ts) = freeNamesIfType t &&& freeNamesIfTcArgs ts
1204 freeNamesIfTcArgs (ITC_Kind k ks) = freeNamesIfKind k &&& freeNamesIfTcArgs ks
1205 freeNamesIfTcArgs ITC_Nil         = emptyNameSet
1206
1207 freeNamesIfType :: IfaceType -> NameSet
1208 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
1209 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
1210 freeNamesIfType (IfaceTyConApp tc ts) =
1211    freeNamesIfTc tc &&& freeNamesIfTcArgs ts
1212 freeNamesIfType (IfaceLitTy _)        = emptyNameSet
1213 freeNamesIfType (IfaceForAllTy tv t)  =
1214    freeNamesIfTvBndr tv &&& freeNamesIfType t
1215 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
1216 freeNamesIfType (IfaceDFunTy s t)     = freeNamesIfType s &&& freeNamesIfType t
1217
1218 freeNamesIfCoercion :: IfaceCoercion -> NameSet
1219 freeNamesIfCoercion (IfaceReflCo _ t) = freeNamesIfType t
1220 freeNamesIfCoercion (IfaceFunCo _ c1 c2)
1221   = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
1222 freeNamesIfCoercion (IfaceTyConAppCo _ tc cos)
1223   = freeNamesIfTc tc &&& fnList freeNamesIfCoercion cos
1224 freeNamesIfCoercion (IfaceAppCo c1 c2)
1225   = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
1226 freeNamesIfCoercion (IfaceForAllCo tv co)
1227   = freeNamesIfTvBndr tv &&& freeNamesIfCoercion co
1228 freeNamesIfCoercion (IfaceCoVarCo _)
1229   = emptyNameSet
1230 freeNamesIfCoercion (IfaceAxiomInstCo ax _ cos)
1231   = unitNameSet ax &&& fnList freeNamesIfCoercion cos
1232 freeNamesIfCoercion (IfaceUnivCo _ t1 t2)
1233   = freeNamesIfType t1 &&& freeNamesIfType t2
1234 freeNamesIfCoercion (IfaceSymCo c)
1235   = freeNamesIfCoercion c
1236 freeNamesIfCoercion (IfaceTransCo c1 c2)
1237   = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
1238 freeNamesIfCoercion (IfaceNthCo _ co)
1239   = freeNamesIfCoercion co
1240 freeNamesIfCoercion (IfaceLRCo _ co)
1241   = freeNamesIfCoercion co
1242 freeNamesIfCoercion (IfaceInstCo co ty)
1243   = freeNamesIfCoercion co &&& freeNamesIfType ty
1244 freeNamesIfCoercion (IfaceSubCo co)
1245   = freeNamesIfCoercion co
1246 freeNamesIfCoercion (IfaceAxiomRuleCo _ax tys cos)
1247   -- the axiom is just a string, so we don't count it as a name.
1248   = fnList freeNamesIfType tys &&&
1249     fnList freeNamesIfCoercion cos
1250
1251 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
1252 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
1253
1254 freeNamesIfBndr :: IfaceBndr -> NameSet
1255 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
1256 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
1257
1258 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
1259 -- Remember IfaceLetBndr is used only for *nested* bindings
1260 -- The IdInfo can contain an unfolding (in the case of
1261 -- local INLINE pragmas), so look there too
1262 freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
1263                                              &&& freeNamesIfIdInfo info
1264
1265 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
1266 freeNamesIfTvBndr (_fs,k) = freeNamesIfKind k
1267     -- kinds can have Names inside, because of promotion
1268
1269 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
1270 freeNamesIfIdBndr = freeNamesIfTvBndr
1271
1272 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
1273 freeNamesIfIdInfo NoInfo      = emptyNameSet
1274 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
1275
1276 freeNamesItem :: IfaceInfoItem -> NameSet
1277 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
1278 freeNamesItem _              = emptyNameSet
1279
1280 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
1281 freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
1282 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
1283 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
1284 freeNamesIfUnfold (IfDFunUnfold bs es)   = fnList freeNamesIfBndr bs &&& fnList freeNamesIfExpr es
1285
1286 freeNamesIfExpr :: IfaceExpr -> NameSet
1287 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
1288 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
1289 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
1290 freeNamesIfExpr (IfaceCo co)      = freeNamesIfCoercion co
1291 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
1292 freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
1293 freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
1294 freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfCoercion co
1295 freeNamesIfExpr (IfaceTick _ e)   = freeNamesIfExpr e
1296 freeNamesIfExpr (IfaceECase e ty) = freeNamesIfExpr e &&& freeNamesIfType ty
1297 freeNamesIfExpr (IfaceCase s _ alts)
1298   = freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts
1299   where
1300     fn_alt (_con,_bs,r) = freeNamesIfExpr r
1301
1302     -- Depend on the data constructors.  Just one will do!
1303     -- Note [Tracking data constructors]
1304     fn_cons []                            = emptyNameSet
1305     fn_cons ((IfaceDefault    ,_,_) : xs) = fn_cons xs
1306     fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
1307     fn_cons (_                      : _ ) = emptyNameSet
1308
1309 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
1310   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
1311
1312 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
1313   = fnList fn_pair as &&& freeNamesIfExpr x
1314   where
1315     fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
1316
1317 freeNamesIfExpr _ = emptyNameSet
1318
1319 freeNamesIfTc :: IfaceTyCon -> NameSet
1320 freeNamesIfTc tc = unitNameSet (ifaceTyConName tc)
1321 -- ToDo: shouldn't we include IfaceIntTc & co.?
1322
1323 freeNamesIfRule :: IfaceRule -> NameSet
1324 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
1325                            , ifRuleArgs = es, ifRuleRhs = rhs })
1326   = unitNameSet f &&&
1327     fnList freeNamesIfBndr bs &&&
1328     fnList freeNamesIfExpr es &&&
1329     freeNamesIfExpr rhs
1330
1331 freeNamesIfFamInst :: IfaceFamInst -> NameSet
1332 freeNamesIfFamInst (IfaceFamInst { ifFamInstFam = famName
1333                                  , ifFamInstAxiom = axName })
1334   = unitNameSet famName &&&
1335     unitNameSet axName
1336
1337 freeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet
1338 freeNamesIfaceTyConParent IfNoParent = emptyNameSet
1339 freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
1340   = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfTcArgs tys
1341
1342 -- helpers
1343 (&&&) :: NameSet -> NameSet -> NameSet
1344 (&&&) = unionNameSets
1345
1346 fnList :: (a -> NameSet) -> [a] -> NameSet
1347 fnList f = foldr (&&&) emptyNameSet . map f
1348 \end{code}
1349
1350 Note [Tracking data constructors]
1351 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1352 In a case expression
1353    case e of { C a -> ...; ... }
1354 You might think that we don't need to include the datacon C
1355 in the free names, because its type will probably show up in
1356 the free names of 'e'.  But in rare circumstances this may
1357 not happen.   Here's the one that bit me:
1358
1359    module DynFlags where
1360      import {-# SOURCE #-} Packages( PackageState )
1361      data DynFlags = DF ... PackageState ...
1362
1363    module Packages where
1364      import DynFlags
1365      data PackageState = PS ...
1366      lookupModule (df :: DynFlags)
1367         = case df of
1368               DF ...p... -> case p of
1369                                PS ... -> ...
1370
1371 Now, lookupModule depends on DynFlags, but the transitive dependency
1372 on the *locally-defined* type PackageState is not visible. We need
1373 to take account of the use of the data constructor PS in the pattern match.
1374
1375
1376 %************************************************************************
1377 %*                                                                      *
1378                 Binary instances
1379 %*                                                                      *
1380 %************************************************************************
1381
1382 \begin{code}
1383 instance Binary IfaceDecl where
1384     put_ bh (IfaceId name ty details idinfo) = do
1385         putByte bh 0
1386         put_ bh (occNameFS name)
1387         put_ bh ty
1388         put_ bh details
1389         put_ bh idinfo
1390
1391     put_ _ (IfaceForeign _ _) = 
1392         error "Binary.put_(IfaceDecl): IfaceForeign"
1393
1394     put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
1395         putByte bh 2
1396         put_ bh (occNameFS a1)
1397         put_ bh a2
1398         put_ bh a3
1399         put_ bh a4
1400         put_ bh a5
1401         put_ bh a6
1402         put_ bh a7
1403         put_ bh a8
1404         put_ bh a9
1405         put_ bh a10
1406
1407     put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
1408         putByte bh 3
1409         put_ bh (occNameFS a1)
1410         put_ bh a2
1411         put_ bh a3
1412         put_ bh a4
1413         put_ bh a5
1414
1415     put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1416         putByte bh 4
1417         put_ bh a1
1418         put_ bh (occNameFS a2)
1419         put_ bh a3
1420         put_ bh a4
1421         put_ bh a5
1422         put_ bh a6
1423         put_ bh a7
1424         put_ bh a8
1425         put_ bh a9
1426
1427     put_ bh (IfaceAxiom a1 a2 a3 a4) = do
1428         putByte bh 5
1429         put_ bh (occNameFS a1)
1430         put_ bh a2
1431         put_ bh a3
1432         put_ bh a4
1433
1434     put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
1435         putByte bh 6
1436         put_ bh (occNameFS name)
1437         put_ bh a2
1438         put_ bh a3
1439         put_ bh a4
1440         put_ bh a5
1441         put_ bh a6
1442         put_ bh a7
1443         put_ bh a8
1444         put_ bh a9
1445         put_ bh a10
1446
1447     get bh = do
1448         h <- getByte bh
1449         case h of
1450             0 -> do name    <- get bh
1451                     ty      <- get bh
1452                     details <- get bh
1453                     idinfo  <- get bh
1454                     occ <- return $! mkVarOccFS name
1455                     return (IfaceId occ ty details idinfo)
1456             1 -> error "Binary.get(TyClDecl): ForeignType"
1457             2 -> do a1  <- get bh
1458                     a2  <- get bh
1459                     a3  <- get bh
1460                     a4  <- get bh
1461                     a5  <- get bh
1462                     a6  <- get bh
1463                     a7  <- get bh
1464                     a8  <- get bh
1465                     a9  <- get bh
1466                     a10 <- get bh
1467                     occ <- return $! mkTcOccFS a1
1468                     return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
1469             3 -> do a1 <- get bh
1470                     a2 <- get bh
1471                     a3 <- get bh
1472                     a4 <- get bh
1473                     a5 <- get bh
1474                     occ <- return $! mkTcOccFS a1
1475                     return (IfaceSyn occ a2 a3 a4 a5)
1476             4 -> do a1 <- get bh
1477                     a2 <- get bh
1478                     a3 <- get bh
1479                     a4 <- get bh
1480                     a5 <- get bh
1481                     a6 <- get bh
1482                     a7 <- get bh
1483                     a8 <- get bh
1484                     a9 <- get bh
1485                     occ <- return $! mkClsOccFS a2
1486                     return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8 a9)
1487             5 -> do a1 <- get bh
1488                     a2 <- get bh
1489                     a3 <- get bh
1490                     a4 <- get bh
1491                     occ <- return $! mkTcOccFS a1
1492                     return (IfaceAxiom occ a2 a3 a4)
1493             6 -> do a1 <- get bh
1494                     a2 <- get bh
1495                     a3 <- get bh
1496                     a4 <- get bh
1497                     a5 <- get bh
1498                     a6 <- get bh
1499                     a7 <- get bh
1500                     a8 <- get bh
1501                     a9 <- get bh
1502                     a10 <- get bh
1503                     occ <- return $! mkDataOccFS a1
1504                     return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
1505             _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
1506
1507 instance Binary IfaceSynTyConRhs where
1508     put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 0
1509     put_ bh (IfaceClosedSynFamilyTyCon ax br) = putByte bh 1 >> put_ bh ax
1510                                                              >> put_ bh br
1511     put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
1512     put_ bh (IfaceSynonymTyCon ty)            = putByte bh 3 >> put_ bh ty
1513     put_ _ IfaceBuiltInSynFamTyCon
1514         = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" empty
1515
1516     get bh = do { h <- getByte bh
1517                 ; case h of
1518                     0 -> return IfaceOpenSynFamilyTyCon
1519                     1 -> do { ax <- get bh
1520                             ; br <- get bh
1521                             ; return (IfaceClosedSynFamilyTyCon ax br) }
1522                     2 -> return IfaceAbstractClosedSynFamilyTyCon
1523                     _ -> do { ty <- get bh
1524                             ; return (IfaceSynonymTyCon ty) } }
1525
1526 instance Binary IfaceClassOp where
1527     put_ bh (IfaceClassOp n def ty) = do 
1528         put_ bh (occNameFS n)
1529         put_ bh def     
1530         put_ bh ty
1531     get bh = do
1532         n   <- get bh
1533         def <- get bh
1534         ty  <- get bh
1535         occ <- return $! mkVarOccFS n
1536         return (IfaceClassOp occ def ty)
1537
1538 instance Binary IfaceAT where
1539     put_ bh (IfaceAT dec defs) = do
1540         put_ bh dec
1541         put_ bh defs
1542     get bh = do
1543         dec  <- get bh
1544         defs <- get bh
1545         return (IfaceAT dec defs)
1546
1547 instance Binary IfaceAxBranch where
1548     put_ bh (IfaceAxBranch a1 a2 a3 a4 a5) = do
1549         put_ bh a1
1550         put_ bh a2
1551         put_ bh a3
1552         put_ bh a4
1553         put_ bh a5
1554     get bh = do
1555         a1 <- get bh
1556         a2 <- get bh
1557         a3 <- get bh
1558         a4 <- get bh
1559         a5 <- get bh
1560         return (IfaceAxBranch a1 a2 a3 a4 a5)
1561
1562 instance Binary IfaceConDecls where
1563     put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
1564     put_ bh IfDataFamTyCon     = putByte bh 1
1565     put_ bh (IfDataTyCon cs)    = putByte bh 2 >> put_ bh cs
1566     put_ bh (IfNewTyCon c)      = putByte bh 3 >> put_ bh c
1567     get bh = do
1568         h <- getByte bh
1569         case h of
1570             0 -> liftM IfAbstractTyCon $ get bh
1571             1 -> return IfDataFamTyCon
1572             2 -> liftM IfDataTyCon $ get bh
1573             _ -> liftM IfNewTyCon $ get bh
1574
1575 instance Binary IfaceConDecl where
1576     put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1577         put_ bh a1
1578         put_ bh a2
1579         put_ bh a3
1580         put_ bh a4
1581         put_ bh a5
1582         put_ bh a6
1583         put_ bh a7
1584         put_ bh a8
1585         put_ bh a9
1586     get bh = do
1587         a1 <- get bh
1588         a2 <- get bh
1589         a3 <- get bh
1590         a4 <- get bh
1591         a5 <- get bh
1592         a6 <- get bh
1593         a7 <- get bh
1594         a8 <- get bh
1595         a9 <- get bh
1596         return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1597
1598 instance Binary IfaceBang where
1599     put_ bh IfNoBang        = putByte bh 0
1600     put_ bh IfStrict        = putByte bh 1
1601     put_ bh IfUnpack        = putByte bh 2
1602     put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
1603
1604     get bh = do
1605             h <- getByte bh
1606             case h of
1607               0 -> do return IfNoBang
1608               1 -> do return IfStrict
1609               2 -> do return IfUnpack
1610               _ -> do { a <- get bh; return (IfUnpackCo a) }
1611
1612 instance Binary IfaceClsInst where
1613     put_ bh (IfaceClsInst cls tys dfun flag orph) = do
1614         put_ bh cls
1615         put_ bh tys
1616         put_ bh dfun
1617         put_ bh flag
1618         put_ bh orph
1619     get bh = do
1620         cls  <- get bh
1621         tys  <- get bh
1622         dfun <- get bh
1623         flag <- get bh
1624         orph <- get bh
1625         return (IfaceClsInst cls tys dfun flag orph)
1626
1627 instance Binary IfaceFamInst where
1628     put_ bh (IfaceFamInst fam tys name orph) = do
1629         put_ bh fam
1630         put_ bh tys
1631         put_ bh name
1632         put_ bh orph
1633     get bh = do
1634         fam      <- get bh
1635         tys      <- get bh
1636         name     <- get bh
1637         orph     <- get bh
1638         return (IfaceFamInst fam tys name orph)
1639
1640 instance Binary IfaceRule where
1641     put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
1642         put_ bh a1
1643         put_ bh a2
1644         put_ bh a3
1645         put_ bh a4
1646         put_ bh a5
1647         put_ bh a6
1648         put_ bh a7
1649         put_ bh a8
1650     get bh = do
1651         a1 <- get bh
1652         a2 <- get bh
1653         a3 <- get bh
1654         a4 <- get bh
1655         a5 <- get bh
1656         a6 <- get bh
1657         a7 <- get bh
1658         a8 <- get bh
1659         return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)
1660
1661 instance Binary IfaceAnnotation where
1662     put_ bh (IfaceAnnotation a1 a2) = do
1663         put_ bh a1
1664         put_ bh a2
1665     get bh = do
1666         a1 <- get bh
1667         a2 <- get bh
1668         return (IfaceAnnotation a1 a2)
1669
1670 instance Binary IfaceIdDetails where
1671     put_ bh IfVanillaId      = putByte bh 0
1672     put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
1673     put_ bh (IfDFunId n)     = do { putByte bh 2; put_ bh n }
1674     get bh = do
1675         h <- getByte bh
1676         case h of
1677             0 -> return IfVanillaId
1678             1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
1679             _ -> do { n <- get bh; return (IfDFunId n) }
1680
1681 instance Binary IfaceIdInfo where
1682     put_ bh NoInfo      = putByte bh 0
1683     put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
1684
1685     get bh = do
1686         h <- getByte bh
1687         case h of
1688             0 -> return NoInfo
1689             _ -> liftM HasInfo $ lazyGet bh    -- NB lazyGet
1690
1691 instance Binary IfaceInfoItem where
1692     put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa
1693     put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab
1694     put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad
1695     put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad
1696     put_ bh HsNoCafRefs           = putByte bh 4
1697     get bh = do
1698         h <- getByte bh
1699         case h of
1700             0 -> liftM HsArity $ get bh
1701             1 -> liftM HsStrictness $ get bh
1702             2 -> do lb <- get bh
1703                     ad <- get bh
1704                     return (HsUnfold lb ad)
1705             3 -> liftM HsInline $ get bh
1706             _ -> return HsNoCafRefs
1707
1708 instance Binary IfaceUnfolding where
1709     put_ bh (IfCoreUnfold s e) = do
1710         putByte bh 0
1711         put_ bh s
1712         put_ bh e
1713     put_ bh (IfInlineRule a b c d) = do
1714         putByte bh 1
1715         put_ bh a
1716         put_ bh b
1717         put_ bh c
1718         put_ bh d
1719     put_ bh (IfDFunUnfold as bs) = do
1720         putByte bh 2
1721         put_ bh as
1722         put_ bh bs
1723     put_ bh (IfCompulsory e) = do
1724         putByte bh 3
1725         put_ bh e
1726     get bh = do
1727         h <- getByte bh
1728         case h of
1729             0 -> do s <- get bh
1730                     e <- get bh
1731                     return (IfCoreUnfold s e)
1732             1 -> do a <- get bh
1733                     b <- get bh
1734                     c <- get bh
1735                     d <- get bh
1736                     return (IfInlineRule a b c d)
1737             2 -> do as <- get bh
1738                     bs <- get bh
1739                     return (IfDFunUnfold as bs)
1740             _ -> do e <- get bh
1741                     return (IfCompulsory e)
1742
1743
1744 instance Binary IfaceExpr where
1745     put_ bh (IfaceLcl aa) = do
1746         putByte bh 0
1747         put_ bh aa
1748     put_ bh (IfaceType ab) = do
1749         putByte bh 1
1750         put_ bh ab
1751     put_ bh (IfaceCo ab) = do
1752         putByte bh 2
1753         put_ bh ab
1754     put_ bh (IfaceTuple ac ad) = do
1755         putByte bh 3
1756         put_ bh ac
1757         put_ bh ad
1758     put_ bh (IfaceLam ae af) = do
1759         putByte bh 4
1760         put_ bh ae
1761         put_ bh af
1762     put_ bh (IfaceApp ag ah) = do
1763         putByte bh 5
1764         put_ bh ag
1765         put_ bh ah
1766     put_ bh (IfaceCase ai aj ak) = do
1767         putByte bh 6
1768         put_ bh ai
1769         put_ bh aj
1770         put_ bh ak
1771     put_ bh (IfaceLet al am) = do
1772         putByte bh 7
1773         put_ bh al
1774         put_ bh am
1775     put_ bh (IfaceTick an ao) = do
1776         putByte bh 8
1777         put_ bh an
1778         put_ bh ao
1779     put_ bh (IfaceLit ap) = do
1780         putByte bh 9
1781         put_ bh ap
1782     put_ bh (IfaceFCall as at) = do
1783         putByte bh 10
1784         put_ bh as
1785         put_ bh at
1786     put_ bh (IfaceExt aa) = do
1787         putByte bh 11
1788         put_ bh aa
1789     put_ bh (IfaceCast ie ico) = do
1790         putByte bh 12
1791         put_ bh ie
1792         put_ bh ico
1793     put_ bh (IfaceECase a b) = do
1794         putByte bh 13
1795         put_ bh a
1796         put_ bh b
1797     get bh = do
1798         h <- getByte bh
1799         case h of
1800             0 -> do aa <- get bh
1801                     return (IfaceLcl aa)
1802             1 -> do ab <- get bh
1803                     return (IfaceType ab)
1804             2 -> do ab <- get bh
1805                     return (IfaceCo ab)
1806             3 -> do ac <- get bh
1807                     ad <- get bh
1808                     return (IfaceTuple ac ad)
1809             4 -> do ae <- get bh
1810                     af <- get bh
1811                     return (IfaceLam ae af)
1812             5 -> do ag <- get bh
1813                     ah <- get bh
1814                     return (IfaceApp ag ah)
1815             6 -> do ai <- get bh
1816                     aj <- get bh
1817                     ak <- get bh
1818                     return (IfaceCase ai aj ak)
1819             7 -> do al <- get bh
1820                     am <- get bh
1821                     return (IfaceLet al am)
1822             8 -> do an <- get bh
1823                     ao <- get bh
1824                     return (IfaceTick an ao)
1825             9 -> do ap <- get bh
1826                     return (IfaceLit ap)
1827             10 -> do as <- get bh
1828                      at <- get bh
1829                      return (IfaceFCall as at)
1830             11 -> do aa <- get bh
1831                      return (IfaceExt aa)
1832             12 -> do ie <- get bh
1833                      ico <- get bh
1834                      return (IfaceCast ie ico)
1835             13 -> do a <- get bh
1836                      b <- get bh
1837                      return (IfaceECase a b)
1838             _ -> panic ("get IfaceExpr " ++ show h)
1839
1840 instance Binary IfaceTickish where
1841     put_ bh (IfaceHpcTick m ix) = do
1842         putByte bh 0
1843         put_ bh m
1844         put_ bh ix
1845     put_ bh (IfaceSCC cc tick push) = do
1846         putByte bh 1
1847         put_ bh cc
1848         put_ bh tick
1849         put_ bh push
1850
1851     get bh = do
1852         h <- getByte bh
1853         case h of
1854             0 -> do m <- get bh
1855                     ix <- get bh
1856                     return (IfaceHpcTick m ix)
1857             1 -> do cc <- get bh
1858                     tick <- get bh
1859                     push <- get bh
1860                     return (IfaceSCC cc tick push)
1861             _ -> panic ("get IfaceTickish " ++ show h)
1862
1863 instance Binary IfaceConAlt where
1864     put_ bh IfaceDefault      = putByte bh 0
1865     put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa
1866     put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac
1867     get bh = do
1868         h <- getByte bh
1869         case h of
1870             0 -> return IfaceDefault
1871             1 -> liftM IfaceDataAlt $ get bh
1872             _ -> liftM IfaceLitAlt  $ get bh
1873
1874 instance Binary IfaceBinding where
1875     put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab
1876     put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac
1877     get bh = do
1878         h <- getByte bh
1879         case h of
1880             0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }
1881             _ -> do { ac <- get bh; return (IfaceRec ac) }
1882
1883 instance Binary IfaceLetBndr where
1884     put_ bh (IfLetBndr a b c) = do
1885             put_ bh a
1886             put_ bh b
1887             put_ bh c
1888     get bh = do a <- get bh
1889                 b <- get bh
1890                 c <- get bh
1891                 return (IfLetBndr a b c)
1892
1893 instance Binary IfaceTyConParent where
1894     put_ bh IfNoParent = putByte bh 0
1895     put_ bh (IfDataInstance ax pr ty) = do
1896         putByte bh 1
1897         put_ bh ax
1898         put_ bh pr
1899         put_ bh ty
1900     get bh = do
1901         h <- getByte bh
1902         case h of
1903             0 -> return IfNoParent
1904             _ -> do
1905                 ax <- get bh
1906                 pr <- get bh
1907                 ty <- get bh
1908                 return $ IfDataInstance ax pr ty
1909 \end{code}