never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 -}
5
6
7 {-# LANGUAGE LambdaCase #-}
8
9 module GHC.Iface.Syntax (
10 module GHC.Iface.Type,
11
12 IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),
13 IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
14 IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceJoinInfo(..),
15 IfaceBinding(..), IfaceConAlt(..),
16 IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..),
17 IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
18 IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
19 IfaceClassBody(..),
20 IfaceBang(..),
21 IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
22 IfaceAxBranch(..),
23 IfaceTyConParent(..),
24 IfaceCompleteMatch(..),
25 IfaceLFInfo(..),
26
27 -- * Binding names
28 IfaceTopBndr,
29 putIfaceTopBndr, getIfaceTopBndr,
30
31 -- Misc
32 ifaceDeclImplicitBndrs, visibleIfConDecls,
33 ifaceDeclFingerprints,
34
35 -- Free Names
36 freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
37
38 -- Pretty printing
39 pprIfaceExpr,
40 pprIfaceDecl,
41 AltPpr(..), ShowSub(..), ShowHowMuch(..), showToIface, showToHeader
42 ) where
43
44 import GHC.Prelude
45
46 import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey )
47 import GHC.Types.Unique ( hasKey )
48 import GHC.Iface.Type
49 import GHC.Iface.Recomp.Binary
50 import GHC.Core( IsOrphan, isOrphan )
51 import GHC.Types.Demand
52 import GHC.Types.Cpr
53 import GHC.Core.Class
54 import GHC.Types.FieldLabel
55 import GHC.Types.Name.Set
56 import GHC.Core.Coercion.Axiom ( BranchIndex )
57 import GHC.Types.Name
58 import GHC.Types.CostCentre
59 import GHC.Types.Literal
60 import GHC.Types.ForeignCall
61 import GHC.Types.Annotations( AnnPayload, AnnTarget )
62 import GHC.Types.Basic
63 import GHC.Unit.Module
64 import GHC.Types.SrcLoc
65 import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
66 import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders )
67 import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
68 import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
69 import GHC.Builtin.Types ( constraintKindTyConName )
70
71 import GHC.Utils.Lexeme (isLexSym)
72 import GHC.Utils.Fingerprint
73 import GHC.Utils.Binary
74 import GHC.Utils.Binary.Typeable ()
75 import GHC.Utils.Outputable as Outputable
76 import GHC.Utils.Panic
77 import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith,
78 seqList, zipWithEqual )
79
80 import Control.Monad
81 import System.IO.Unsafe
82 import Control.DeepSeq
83
84 infixl 3 &&&
85
86 {-
87 ************************************************************************
88 * *
89 Declarations
90 * *
91 ************************************************************************
92 -}
93
94 -- | A binding top-level 'Name' in an interface file (e.g. the name of an
95 -- 'IfaceDecl').
96 type IfaceTopBndr = Name
97 -- It's convenient to have a Name in the Iface syntax, although in each
98 -- case the namespace is implied by the context. However, having a
99 -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
100 -- very convenient. Moreover, having the key of the binder means that
101 -- we can encode known-key things cleverly in the symbol table. See Note
102 -- [Symbol table representation of Names]
103 --
104 -- We don't serialise the namespace onto the disk though; rather we
105 -- drop it when serialising and add it back in when deserialising.
106
107 getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
108 getIfaceTopBndr bh = get bh
109
110 putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
111 putIfaceTopBndr bh name =
112 case getUserData bh of
113 UserData{ ud_put_binding_name = put_binding_name } ->
114 --pprTrace "putIfaceTopBndr" (ppr name) $
115 put_binding_name bh name
116
117 data IfaceDecl
118 = IfaceId { ifName :: IfaceTopBndr,
119 ifType :: IfaceType,
120 ifIdDetails :: IfaceIdDetails,
121 ifIdInfo :: IfaceIdInfo
122 }
123
124 | IfaceData { ifName :: IfaceTopBndr, -- Type constructor
125 ifBinders :: [IfaceTyConBinder],
126 ifResKind :: IfaceType, -- Result kind of type constructor
127 ifCType :: Maybe CType, -- C type for CAPI FFI
128 ifRoles :: [Role], -- Roles
129 ifCtxt :: IfaceContext, -- The "stupid theta"
130 ifCons :: IfaceConDecls, -- Includes new/data/data family info
131 ifGadtSyntax :: Bool, -- True <=> declared using
132 -- GADT syntax
133 ifParent :: IfaceTyConParent -- The axiom, for a newtype,
134 -- or data/newtype family instance
135 }
136
137 | IfaceSynonym { ifName :: IfaceTopBndr, -- Type constructor
138 ifRoles :: [Role], -- Roles
139 ifBinders :: [IfaceTyConBinder],
140 ifResKind :: IfaceKind, -- Kind of the *result*
141 ifSynRhs :: IfaceType }
142
143 | IfaceFamily { ifName :: IfaceTopBndr, -- Type constructor
144 ifResVar :: Maybe IfLclName, -- Result variable name, used
145 -- only for pretty-printing
146 -- with --show-iface
147 ifBinders :: [IfaceTyConBinder],
148 ifResKind :: IfaceKind, -- Kind of the *tycon*
149 ifFamFlav :: IfaceFamTyConFlav,
150 ifFamInj :: Injectivity } -- injectivity information
151
152 | IfaceClass { ifName :: IfaceTopBndr, -- Name of the class TyCon
153 ifRoles :: [Role], -- Roles
154 ifBinders :: [IfaceTyConBinder],
155 ifFDs :: [FunDep IfLclName], -- Functional dependencies
156 ifBody :: IfaceClassBody -- Methods, superclasses, ATs
157 }
158
159 | IfaceAxiom { ifName :: IfaceTopBndr, -- Axiom name
160 ifTyCon :: IfaceTyCon, -- LHS TyCon
161 ifRole :: Role, -- Role of axiom
162 ifAxBranches :: [IfaceAxBranch] -- Branches
163 }
164
165 | IfacePatSyn { ifName :: IfaceTopBndr, -- Name of the pattern synonym
166 ifPatIsInfix :: Bool,
167 ifPatMatcher :: (IfExtName, Bool),
168 ifPatBuilder :: Maybe (IfExtName, Bool),
169 -- Everything below is redundant,
170 -- but needed to implement pprIfaceDecl
171 ifPatUnivBndrs :: [IfaceForAllSpecBndr],
172 ifPatExBndrs :: [IfaceForAllSpecBndr],
173 ifPatProvCtxt :: IfaceContext,
174 ifPatReqCtxt :: IfaceContext,
175 ifPatArgs :: [IfaceType],
176 ifPatTy :: IfaceType,
177 ifFieldLabels :: [FieldLabel] }
178
179 -- See also 'ClassBody'
180 data IfaceClassBody
181 -- Abstract classes don't specify their body; they only occur in @hs-boot@ and
182 -- @hsig@ files.
183 = IfAbstractClass
184 | IfConcreteClass {
185 ifClassCtxt :: IfaceContext, -- Super classes
186 ifATs :: [IfaceAT], -- Associated type families
187 ifSigs :: [IfaceClassOp], -- Method signatures
188 ifMinDef :: BooleanFormula IfLclName -- Minimal complete definition
189 }
190
191 data IfaceTyConParent
192 = IfNoParent
193 | IfDataInstance
194 IfExtName -- Axiom name
195 IfaceTyCon -- Family TyCon (pretty-printing only, not used in GHC.IfaceToCore)
196 -- see Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr
197 IfaceAppArgs -- Arguments of the family TyCon
198
199 data IfaceFamTyConFlav
200 = IfaceDataFamilyTyCon -- Data family
201 | IfaceOpenSynFamilyTyCon
202 | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
203 -- ^ Name of associated axiom and branches for pretty printing purposes,
204 -- or 'Nothing' for an empty closed family without an axiom
205 -- See Note [Pretty printing via Iface syntax] in "GHC.Types.TyThing.Ppr"
206 | IfaceAbstractClosedSynFamilyTyCon
207 | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
208
209 data IfaceClassOp
210 = IfaceClassOp IfaceTopBndr
211 IfaceType -- Class op type
212 (Maybe (DefMethSpec IfaceType)) -- Default method
213 -- The types of both the class op itself,
214 -- and the default method, are *not* quantified
215 -- over the class variables
216
217 data IfaceAT = IfaceAT -- See GHC.Core.Class.ClassATItem
218 IfaceDecl -- The associated type declaration
219 (Maybe IfaceType) -- Default associated type instance, if any
220
221
222 -- This is just like CoAxBranch
223 data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr]
224 , ifaxbEtaTyVars :: [IfaceTvBndr]
225 , ifaxbCoVars :: [IfaceIdBndr]
226 , ifaxbLHS :: IfaceAppArgs
227 , ifaxbRoles :: [Role]
228 , ifaxbRHS :: IfaceType
229 , ifaxbIncomps :: [BranchIndex] }
230 -- See Note [Storing compatibility] in GHC.Core.Coercion.Axiom
231
232 data IfaceConDecls
233 = IfAbstractTyCon -- c.f TyCon.AbstractTyCon
234 | IfDataTyCon [IfaceConDecl] -- Data type decls
235 | IfNewTyCon IfaceConDecl -- Newtype decls
236
237 -- For IfDataTyCon and IfNewTyCon we store:
238 -- * the data constructor(s);
239 -- The field labels are stored individually in the IfaceConDecl
240 -- (there is some redundancy here, because a field label may occur
241 -- in multiple IfaceConDecls and represent the same field label)
242
243 data IfaceConDecl
244 = IfCon {
245 ifConName :: IfaceTopBndr, -- Constructor name
246 ifConWrapper :: Bool, -- True <=> has a wrapper
247 ifConInfix :: Bool, -- True <=> declared infix
248
249 -- The universal type variables are precisely those
250 -- of the type constructor of this data constructor
251 -- This is *easy* to guarantee when creating the IfCon
252 -- but it's not so easy for the original TyCon/DataCon
253 -- So this guarantee holds for IfaceConDecl, but *not* for DataCon
254
255 ifConExTCvs :: [IfaceBndr], -- Existential ty/covars
256 ifConUserTvBinders :: [IfaceForAllSpecBndr],
257 -- The tyvars, in the order the user wrote them
258 -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the
259 -- set of tyvars (*not* covars) of ifConExTCvs, unioned
260 -- with the set of ifBinders (from the parent IfaceDecl)
261 -- whose tyvars do not appear in ifConEqSpec
262 -- See Note [DataCon user type variable binders] in GHC.Core.DataCon
263 ifConEqSpec :: IfaceEqSpec, -- Equality constraints
264 ifConCtxt :: IfaceContext, -- Non-stupid context
265 ifConArgTys :: [(IfaceMult, IfaceType)],-- Arg types
266 ifConFields :: [FieldLabel], -- ...ditto... (field labels)
267 ifConStricts :: [IfaceBang],
268 -- Empty (meaning all lazy),
269 -- or 1-1 corresp with arg tys
270 -- See Note [Bangs on imported data constructors] in GHC.Types.Id.Make
271 ifConSrcStricts :: [IfaceSrcBang] } -- empty meaning no src stricts
272
273 type IfaceEqSpec = [(IfLclName,IfaceType)]
274
275 -- | This corresponds to an HsImplBang; that is, the final
276 -- implementation decision about the data constructor arg
277 data IfaceBang
278 = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion
279
280 -- | This corresponds to HsSrcBang
281 data IfaceSrcBang
282 = IfSrcBang SrcUnpackedness SrcStrictness
283
284 data IfaceClsInst
285 = IfaceClsInst { ifInstCls :: IfExtName, -- See comments with
286 ifInstTys :: [Maybe IfaceTyCon], -- the defn of ClsInst
287 ifDFun :: IfExtName, -- The dfun
288 ifOFlag :: OverlapFlag, -- Overlap flag
289 ifInstOrph :: IsOrphan } -- See Note [Orphans] in GHC.Core.InstEnv
290 -- There's always a separate IfaceDecl for the DFun, which gives
291 -- its IdInfo with its full type and version number.
292 -- The instance declarations taken together have a version number,
293 -- and we don't want that to wobble gratuitously
294 -- If this instance decl is *used*, we'll record a usage on the dfun;
295 -- and if the head does not change it won't be used if it wasn't before
296
297 -- The ifFamInstTys field of IfaceFamInst contains a list of the rough
298 -- match types
299 data IfaceFamInst
300 = IfaceFamInst { ifFamInstFam :: IfExtName -- Family name
301 , ifFamInstTys :: [Maybe IfaceTyCon] -- See above
302 , ifFamInstAxiom :: IfExtName -- The axiom
303 , ifFamInstOrph :: IsOrphan -- Just like IfaceClsInst
304 }
305
306 data IfaceRule
307 = IfaceRule {
308 ifRuleName :: RuleName,
309 ifActivation :: Activation,
310 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
311 ifRuleHead :: IfExtName, -- Head of lhs
312 ifRuleArgs :: [IfaceExpr], -- Args of LHS
313 ifRuleRhs :: IfaceExpr,
314 ifRuleAuto :: Bool,
315 ifRuleOrph :: IsOrphan -- Just like IfaceClsInst
316 }
317
318 data IfaceAnnotation
319 = IfaceAnnotation {
320 ifAnnotatedTarget :: IfaceAnnTarget,
321 ifAnnotatedValue :: AnnPayload
322 }
323
324 type IfaceAnnTarget = AnnTarget OccName
325
326 data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] (Maybe IfaceTyCon)
327
328 instance Outputable IfaceCompleteMatch where
329 ppr (IfaceCompleteMatch cls mtc) = text "COMPLETE" <> colon <+> ppr cls <+> case mtc of
330 Nothing -> empty
331 Just tc -> dcolon <+> ppr tc
332
333 -- Here's a tricky case:
334 -- * Compile with -O module A, and B which imports A.f
335 -- * Change function f in A, and recompile without -O
336 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
337 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
338 -- but we do not do that now. Instead it's discarded when the
339 -- ModIface is read into the various decl pools.)
340 -- * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
341 -- and so gives a new version.
342
343 type IfaceIdInfo = [IfaceInfoItem]
344
345 data IfaceInfoItem
346 = HsArity Arity
347 | HsDmdSig DmdSig
348 | HsCprSig CprSig
349 | HsInline InlinePragma
350 | HsUnfold Bool -- True <=> isStrongLoopBreaker is true
351 IfaceUnfolding -- See Note [Expose recursive functions]
352 | HsNoCafRefs
353 | HsLevity -- Present <=> never representation-polymorphic
354 | HsLFInfo IfaceLFInfo
355
356 -- NB: Specialisations and rules come in separately and are
357 -- only later attached to the Id. Partial reason: some are orphans.
358
359 data IfaceUnfolding
360 = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
361 -- Possibly could eliminate the Bool here, the information
362 -- is also in the InlinePragma.
363
364 | IfCompulsory IfaceExpr -- default methods and unsafeCoerce#
365 -- for more about unsafeCoerce#, see
366 -- Note [Wiring in unsafeCoerce#] in "GHC.HsToCore"
367
368 | IfInlineRule Arity -- INLINE pragmas
369 Bool -- OK to inline even if *un*-saturated
370 Bool -- OK to inline even if context is boring
371 IfaceExpr
372
373 | IfDFunUnfold [IfaceBndr] [IfaceExpr]
374
375
376 -- We only serialise the IdDetails of top-level Ids, and even then
377 -- we only need a very limited selection. Notably, none of the
378 -- implicit ones are needed here, because they are not put in
379 -- interface files
380
381 data IfaceIdDetails
382 = IfVanillaId
383 | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
384 | IfDFunId
385
386 -- | Iface type for LambdaFormInfo. Fields not relevant for imported Ids are
387 -- omitted in this type.
388 data IfaceLFInfo
389 = IfLFReEntrant !RepArity
390 | IfLFThunk
391 !Bool -- True <=> updatable
392 !Bool -- True <=> might be a function type
393 | IfLFCon !Name
394 | IfLFUnknown !Bool
395 | IfLFUnlifted
396
397 instance Outputable IfaceLFInfo where
398 ppr (IfLFReEntrant arity) =
399 text "LFReEntrant" <+> ppr arity
400
401 ppr (IfLFThunk updatable mb_fun) =
402 text "LFThunk" <+> parens
403 (text "updatable=" <> ppr updatable <+>
404 text "might_be_function=" <+> ppr mb_fun)
405
406 ppr (IfLFCon con) =
407 text "LFCon" <> brackets (ppr con)
408
409 ppr IfLFUnlifted =
410 text "LFUnlifted"
411
412 ppr (IfLFUnknown fun_flag) =
413 text "LFUnknown" <+> ppr fun_flag
414
415 instance Binary IfaceLFInfo where
416 put_ bh (IfLFReEntrant arity) = do
417 putByte bh 0
418 put_ bh arity
419 put_ bh (IfLFThunk updatable mb_fun) = do
420 putByte bh 1
421 put_ bh updatable
422 put_ bh mb_fun
423 put_ bh (IfLFCon con_name) = do
424 putByte bh 2
425 put_ bh con_name
426 put_ bh (IfLFUnknown fun_flag) = do
427 putByte bh 3
428 put_ bh fun_flag
429 put_ bh IfLFUnlifted =
430 putByte bh 4
431 get bh = do
432 tag <- getByte bh
433 case tag of
434 0 -> IfLFReEntrant <$> get bh
435 1 -> IfLFThunk <$> get bh <*> get bh
436 2 -> IfLFCon <$> get bh
437 3 -> IfLFUnknown <$> get bh
438 4 -> pure IfLFUnlifted
439 _ -> panic "Invalid byte"
440
441 {-
442 Note [Versioning of instances]
443 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
444 See [https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#instances]
445
446
447 ************************************************************************
448 * *
449 Functions over declarations
450 * *
451 ************************************************************************
452 -}
453
454 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
455 visibleIfConDecls (IfAbstractTyCon {}) = []
456 visibleIfConDecls (IfDataTyCon cs) = cs
457 visibleIfConDecls (IfNewTyCon c) = [c]
458
459 ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
460 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
461 -- Deeply revolting, because it has to predict what gets bound,
462 -- especially the question of whether there's a wrapper for a datacon
463 -- See Note [Implicit TyThings] in GHC.Driver.Env
464
465 -- N.B. the set of names returned here *must* match the set of
466 -- TyThings returned by GHC.Driver.Env.implicitTyThings, in the sense that
467 -- TyThing.getOccName should define a bijection between the two lists.
468 -- This invariant is used in GHC.IfaceToCore.tc_iface_decl_fingerprint (see note
469 -- [Tricky iface loop])
470 -- The order of the list does not matter.
471
472 ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
473 = case cons of
474 IfAbstractTyCon {} -> []
475 IfNewTyCon cd -> mkNewTyCoOcc (occName tc_name) : ifaceConDeclImplicitBndrs cd
476 IfDataTyCon cds -> concatMap ifaceConDeclImplicitBndrs cds
477
478 ifaceDeclImplicitBndrs (IfaceClass { ifBody = IfAbstractClass })
479 = []
480
481 ifaceDeclImplicitBndrs (IfaceClass { ifName = cls_tc_name
482 , ifBody = IfConcreteClass {
483 ifClassCtxt = sc_ctxt,
484 ifSigs = sigs,
485 ifATs = ats
486 }})
487 = -- (possibly) newtype coercion
488 co_occs ++
489 -- data constructor (DataCon namespace)
490 -- data worker (Id namespace)
491 -- no wrapper (class dictionaries never have a wrapper)
492 [dc_occ, dcww_occ] ++
493 -- associated types
494 [occName (ifName at) | IfaceAT at _ <- ats ] ++
495 -- superclass selectors
496 [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
497 -- operation selectors
498 [occName op | IfaceClassOp op _ _ <- sigs]
499 where
500 cls_tc_occ = occName cls_tc_name
501 n_ctxt = length sc_ctxt
502 n_sigs = length sigs
503 co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
504 | otherwise = []
505 dcww_occ = mkDataConWorkerOcc dc_occ
506 dc_occ = mkClassDataConOcc cls_tc_occ
507 is_newtype = n_sigs + n_ctxt == 1 -- Sigh (keep this synced with buildClass)
508
509 ifaceDeclImplicitBndrs _ = []
510
511 ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
512 ifaceConDeclImplicitBndrs (IfCon {
513 ifConWrapper = has_wrapper, ifConName = con_name })
514 = [occName con_name, work_occ] ++ wrap_occs
515 where
516 con_occ = occName con_name
517 work_occ = mkDataConWorkerOcc con_occ -- Id namespace
518 wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ] -- Id namespace
519 | otherwise = []
520
521 -- -----------------------------------------------------------------------------
522 -- The fingerprints of an IfaceDecl
523
524 -- We better give each name bound by the declaration a
525 -- different fingerprint! So we calculate the fingerprint of
526 -- each binder by combining the fingerprint of the whole
527 -- declaration with the name of the binder. (#5614, #7215)
528 ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)]
529 ifaceDeclFingerprints hash decl
530 = (getOccName decl, hash) :
531 [ (occ, computeFingerprint' (hash,occ))
532 | occ <- ifaceDeclImplicitBndrs decl ]
533 where
534 computeFingerprint' =
535 unsafeDupablePerformIO
536 . computeFingerprint (panic "ifaceDeclFingerprints")
537
538 {-
539 ************************************************************************
540 * *
541 Expressions
542 * *
543 ************************************************************************
544 -}
545
546 data IfaceExpr
547 = IfaceLcl IfLclName
548 | IfaceExt IfExtName
549 | IfaceType IfaceType
550 | IfaceCo IfaceCoercion
551 | IfaceTuple TupleSort [IfaceExpr] -- Saturated; type arguments omitted
552 | IfaceLam IfaceLamBndr IfaceExpr
553 | IfaceApp IfaceExpr IfaceExpr
554 | IfaceCase IfaceExpr IfLclName [IfaceAlt]
555 | IfaceECase IfaceExpr IfaceType -- See Note [Empty case alternatives]
556 | IfaceLet IfaceBinding IfaceExpr
557 | IfaceCast IfaceExpr IfaceCoercion
558 | IfaceLit Literal
559 | IfaceLitRubbish IfaceType -- See GHC.Types.Literal
560 -- Note [Rubbish literals] item (6)
561 | IfaceFCall ForeignCall IfaceType
562 | IfaceTick IfaceTickish IfaceExpr -- from Tick tickish E
563
564 data IfaceTickish
565 = IfaceHpcTick Module Int -- from HpcTick x
566 | IfaceSCC CostCentre Bool Bool -- from ProfNote
567 | IfaceSource RealSrcSpan String -- from SourceNote
568 -- no breakpoints: we never export these into interface files
569
570 data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr
571 -- Note: IfLclName, not IfaceBndr (and same with the case binder)
572 -- We reconstruct the kind/type of the thing from the context
573 -- thus saving bulk in interface files
574
575 data IfaceConAlt = IfaceDefault
576 | IfaceDataAlt IfExtName
577 | IfaceLitAlt Literal
578
579 data IfaceBinding
580 = IfaceNonRec IfaceLetBndr IfaceExpr
581 | IfaceRec [(IfaceLetBndr, IfaceExpr)]
582
583 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
584 -- It's used for *non-top-level* let/rec binders
585 -- See Note [IdInfo on nested let-bindings]
586 data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo
587
588 data IfaceJoinInfo = IfaceNotJoinPoint
589 | IfaceJoinPoint JoinArity
590
591 {-
592 Note [Empty case alternatives]
593 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
594 In Iface syntax an IfaceCase does not record the types of the alternatives,
595 unlike Core syntax Case. But we need this type if the alternatives are empty.
596 Hence IfaceECase. See Note [Empty case alternatives] in GHC.Core.
597
598 Note [Expose recursive functions]
599 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
600 For supercompilation we want to put *all* unfoldings in the interface
601 file, even for functions that are recursive (or big). So we need to
602 know when an unfolding belongs to a loop-breaker so that we can refrain
603 from inlining it (except during supercompilation).
604
605 Note [IdInfo on nested let-bindings]
606 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
607 Occasionally we want to preserve IdInfo on nested let bindings. The one
608 that came up was a NOINLINE pragma on a let-binding inside an INLINE
609 function. The user (Duncan Coutts) really wanted the NOINLINE control
610 to cross the separate compilation boundary.
611
612 In general we retain all info that is left by GHC.Core.Tidy.tidyLetBndr, since
613 that is what is seen by importing module with --make
614
615 Note [Displaying axiom incompatibilities]
616 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
617 With -fprint-axiom-incomps we display which closed type family equations
618 are incompatible with which. This information is sometimes necessary
619 because GHC doesn't try equations in order: any equation can be used when
620 all preceding equations that are incompatible with it do not apply.
621
622 For example, the last "a && a = a" equation in Data.Type.Bool.&& is
623 actually compatible with all previous equations, and can reduce at any
624 time.
625
626 This is displayed as:
627 Prelude> :i Data.Type.Equality.==
628 type family (==) (a :: k) (b :: k) :: Bool
629 where
630 {- #0 -} (==) (f a) (g b) = (f == g) && (a == b)
631 {- #1 -} (==) a a = 'True
632 -- incompatible with: #0
633 {- #2 -} (==) _1 _2 = 'False
634 -- incompatible with: #1, #0
635 The comment after an equation refers to all previous equations (0-indexed)
636 that are incompatible with it.
637
638 ************************************************************************
639 * *
640 Printing IfaceDecl
641 * *
642 ************************************************************************
643 -}
644
645 pprAxBranch :: SDoc -> BranchIndex -> IfaceAxBranch -> SDoc
646 -- The TyCon might be local (just an OccName), or this might
647 -- be a branch for an imported TyCon, so it would be an ExtName
648 -- So it's easier to take an SDoc here
649 --
650 -- This function is used
651 -- to print interface files,
652 -- in debug messages
653 -- in :info F for GHCi, which goes via toConToIfaceDecl on the family tycon
654 -- For user error messages we use Coercion.pprCoAxiom and friends
655 pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs
656 , ifaxbCoVars = _cvs
657 , ifaxbLHS = pat_tys
658 , ifaxbRHS = rhs
659 , ifaxbIncomps = incomps })
660 = assertPpr (null _cvs) (pp_tc $$ ppr _cvs) $
661 hang ppr_binders 2 (hang pp_lhs 2 (equals <+> ppr rhs))
662 $+$
663 nest 4 maybe_incomps
664 where
665 -- See Note [Printing foralls in type family instances] in GHC.Iface.Type
666 ppr_binders = maybe_index <+>
667 pprUserIfaceForAll (map (mkIfaceForAllTvBndr Specified) tvs)
668 pp_lhs = hang pp_tc 2 (pprParendIfaceAppArgs pat_tys)
669
670 -- See Note [Displaying axiom incompatibilities]
671 maybe_index
672 = ppWhenOption sdocPrintAxiomIncomps $
673 text "{-" <+> (text "#" <> ppr idx) <+> text "-}"
674 maybe_incomps
675 = ppWhenOption sdocPrintAxiomIncomps $
676 ppWhen (notNull incomps) $
677 text "--" <+> text "incompatible with:"
678 <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps
679
680 instance Outputable IfaceAnnotation where
681 ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
682
683 instance NamedThing IfaceClassOp where
684 getName (IfaceClassOp n _ _) = n
685
686 instance HasOccName IfaceClassOp where
687 occName = getOccName
688
689 instance NamedThing IfaceConDecl where
690 getName = ifConName
691
692 instance HasOccName IfaceConDecl where
693 occName = getOccName
694
695 instance NamedThing IfaceDecl where
696 getName = ifName
697
698 instance HasOccName IfaceDecl where
699 occName = getOccName
700
701 instance Outputable IfaceDecl where
702 ppr = pprIfaceDecl showToIface
703
704 {-
705 Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
706 The minimal complete definition should only be included if a complete
707 class definition is shown. Since the minimal complete definition is
708 anonymous we can't reuse the same mechanism that is used for the
709 filtering of method signatures. Instead we just check if anything at all is
710 filtered and hide it in that case.
711 -}
712
713 data ShowSub
714 = ShowSub
715 { ss_how_much :: ShowHowMuch
716 , ss_forall :: ShowForAllFlag }
717
718 -- See Note [Printing IfaceDecl binders]
719 -- The alternative pretty printer referred to in the note.
720 newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))
721
722 data ShowHowMuch
723 = ShowHeader AltPpr -- ^Header information only, not rhs
724 | ShowSome [OccName] AltPpr
725 -- ^ Show only some sub-components. Specifically,
726 --
727 -- [@\[\]@] Print all sub-components.
728 -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@;
729 -- elide other sub-components to @...@
730 -- May 14: the list is max 1 element long at the moment
731 | ShowIface
732 -- ^Everything including GHC-internal information (used in --show-iface)
733
734 {-
735 Note [Printing IfaceDecl binders]
736 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
737 The binders in an IfaceDecl are just OccNames, so we don't know what module they
738 come from. But when we pretty-print a TyThing by converting to an IfaceDecl
739 (see GHC.Types.TyThing.Ppr), the TyThing may come from some other module so we really need
740 the module qualifier. We solve this by passing in a pretty-printer for the
741 binders.
742
743 When printing an interface file (--show-iface), we want to print
744 everything unqualified, so we can just print the OccName directly.
745 -}
746
747 instance Outputable ShowHowMuch where
748 ppr (ShowHeader _) = text "ShowHeader"
749 ppr ShowIface = text "ShowIface"
750 ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs
751
752 showToHeader :: ShowSub
753 showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing
754 , ss_forall = ShowForAllWhen }
755
756 showToIface :: ShowSub
757 showToIface = ShowSub { ss_how_much = ShowIface
758 , ss_forall = ShowForAllWhen }
759
760 ppShowIface :: ShowSub -> SDoc -> SDoc
761 ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
762 ppShowIface _ _ = Outputable.empty
763
764 -- show if all sub-components or the complete interface is shown
765 ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
766 ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
767 ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc
768 ppShowAllSubs _ _ = Outputable.empty
769
770 ppShowRhs :: ShowSub -> SDoc -> SDoc
771 ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty
772 ppShowRhs _ doc = doc
773
774 showSub :: HasOccName n => ShowSub -> n -> Bool
775 showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False
776 showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
777 showSub (ShowSub { ss_how_much = _ }) _ = True
778
779 ppr_trim :: [Maybe SDoc] -> [SDoc]
780 -- Collapse a group of Nothings to a single "..."
781 ppr_trim xs
782 = snd (foldr go (False, []) xs)
783 where
784 go (Just doc) (_, so_far) = (False, doc : so_far)
785 go Nothing (True, so_far) = (True, so_far)
786 go Nothing (False, so_far) = (True, text "..." : so_far)
787
788 isIfaceDataInstance :: IfaceTyConParent -> Bool
789 isIfaceDataInstance IfNoParent = False
790 isIfaceDataInstance _ = True
791
792 pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
793 pprClassRoles ss clas binders roles =
794 pprRoles (== Nominal)
795 (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
796 binders
797 roles
798
799 pprClassStandaloneKindSig :: ShowSub -> IfaceTopBndr -> IfaceKind -> SDoc
800 pprClassStandaloneKindSig ss clas =
801 pprStandaloneKindSig (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
802
803 constraintIfaceKind :: IfaceKind
804 constraintIfaceKind =
805 IfaceTyConApp (IfaceTyCon constraintKindTyConName (mkIfaceTyConInfo NotPromoted IfaceNormalTyCon)) IA_Nil
806
807 pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
808 -- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
809 -- See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr
810 pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
811 ifCtxt = context, ifResKind = kind,
812 ifRoles = roles, ifCons = condecls,
813 ifParent = parent,
814 ifGadtSyntax = gadt,
815 ifBinders = binders })
816
817 | gadt = vcat [ pp_roles
818 , pp_ki_sig
819 , pp_nd <+> pp_lhs <+> pp_kind <+> pp_where
820 , nest 2 (vcat pp_cons)
821 , nest 2 $ ppShowIface ss pp_extra ]
822 | otherwise = vcat [ pp_roles
823 , pp_ki_sig
824 , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
825 , nest 2 $ ppShowIface ss pp_extra ]
826 where
827 is_data_instance = isIfaceDataInstance parent
828 -- See Note [Printing foralls in type family instances] in GHC.Iface.Type
829 pp_data_inst_forall :: SDoc
830 pp_data_inst_forall = pprUserIfaceForAll forall_bndrs
831
832 forall_bndrs :: [IfaceForAllBndr]
833 forall_bndrs = [Bndr (binderVar tc_bndr) Specified | tc_bndr <- binders]
834
835 cons = visibleIfConDecls condecls
836 pp_where = ppWhen (gadt && not (null cons)) $ text "where"
837 pp_cons = ppr_trim (map show_con cons) :: [SDoc]
838 pp_kind = ppUnless (if ki_sig_printable
839 then isIfaceTauType kind
840 -- Even in the presence of a standalone kind signature, a non-tau
841 -- result kind annotation cannot be discarded as it determines the arity.
842 -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType
843 else isIfaceLiftedTypeKind kind)
844 (dcolon <+> ppr kind)
845
846 pp_lhs = case parent of
847 IfNoParent -> pprIfaceDeclHead suppress_bndr_sig context ss tycon binders
848 IfDataInstance{}
849 -> text "instance" <+> pp_data_inst_forall
850 <+> pprIfaceTyConParent parent
851
852 pp_roles
853 | is_data_instance = empty
854 | otherwise = pprRoles (== Representational) name_doc binders roles
855 -- Don't display roles for data family instances (yet)
856 -- See discussion on #8672.
857
858 ki_sig_printable =
859 -- If we print a standalone kind signature for a data instance, we leak
860 -- the internal constructor name:
861 --
862 -- type T15827.R:Dka :: forall k. k -> *
863 -- data instance forall k (a :: k). D a = MkD (Proxy a)
864 --
865 -- This T15827.R:Dka is a compiler-generated type constructor for the
866 -- data instance.
867 not is_data_instance
868
869 pp_ki_sig = ppWhen ki_sig_printable $
870 pprStandaloneKindSig name_doc (mkIfaceTyConKind binders kind)
871
872 -- See Note [Suppressing binder signatures] in GHC.Iface.Type
873 suppress_bndr_sig = SuppressBndrSig ki_sig_printable
874
875 name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tycon)
876
877 add_bars [] = Outputable.empty
878 add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
879
880 ok_con dc = showSub ss dc || any (showSub ss . flSelector) (ifConFields dc)
881
882 show_con dc
883 | ok_con dc = Just $ pprIfaceConDecl ss gadt tycon binders parent dc
884 | otherwise = Nothing
885
886 pp_nd = case condecls of
887 IfAbstractTyCon{} -> text "data"
888 IfDataTyCon{} -> text "data"
889 IfNewTyCon{} -> text "newtype"
890
891 pp_extra = vcat [pprCType ctype]
892
893 pprIfaceDecl ss (IfaceClass { ifName = clas
894 , ifRoles = roles
895 , ifFDs = fds
896 , ifBinders = binders
897 , ifBody = IfAbstractClass })
898 = vcat [ pprClassRoles ss clas binders roles
899 , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
900 , text "class" <+> pprIfaceDeclHead suppress_bndr_sig [] ss clas binders <+> pprFundeps fds ]
901 where
902 -- See Note [Suppressing binder signatures] in GHC.Iface.Type
903 suppress_bndr_sig = SuppressBndrSig True
904
905 pprIfaceDecl ss (IfaceClass { ifName = clas
906 , ifRoles = roles
907 , ifFDs = fds
908 , ifBinders = binders
909 , ifBody = IfConcreteClass {
910 ifATs = ats,
911 ifSigs = sigs,
912 ifClassCtxt = context,
913 ifMinDef = minDef
914 }})
915 = vcat [ pprClassRoles ss clas binders roles
916 , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind)
917 , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where
918 , nest 2 (vcat [ vcat asocs, vcat dsigs
919 , ppShowAllSubs ss (pprMinDef minDef)])]
920 where
921 pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
922
923 asocs = ppr_trim $ map maybeShowAssoc ats
924 dsigs = ppr_trim $ map maybeShowSig sigs
925
926 maybeShowAssoc :: IfaceAT -> Maybe SDoc
927 maybeShowAssoc asc@(IfaceAT d _)
928 | showSub ss d = Just $ pprIfaceAT ss asc
929 | otherwise = Nothing
930
931 maybeShowSig :: IfaceClassOp -> Maybe SDoc
932 maybeShowSig sg
933 | showSub ss sg = Just $ pprIfaceClassOp ss sg
934 | otherwise = Nothing
935
936 pprMinDef :: BooleanFormula IfLclName -> SDoc
937 pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
938 text "{-# MINIMAL" <+>
939 pprBooleanFormula
940 (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
941 text "#-}"
942
943 -- See Note [Suppressing binder signatures] in GHC.Iface.Type
944 suppress_bndr_sig = SuppressBndrSig True
945
946 pprIfaceDecl ss (IfaceSynonym { ifName = tc
947 , ifBinders = binders
948 , ifSynRhs = mono_ty
949 , ifResKind = res_kind})
950 = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind)
951 , hang (text "type" <+> pprIfaceDeclHead suppress_bndr_sig [] ss tc binders <+> equals)
952 2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr_tau
953 , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ])
954 ]
955 where
956 (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
957 name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tc)
958
959 -- See Note [Printing type abbreviations] in GHC.Iface.Type
960 ppr_tau | tc `hasKey` liftedTypeKindTyConKey ||
961 tc `hasKey` unrestrictedFunTyConKey
962 = updSDocContext (\ctx -> ctx { sdocPrintTypeAbbreviations = False }) $ ppr tau
963 | otherwise = ppr tau
964
965 -- See Note [Suppressing binder signatures] in GHC.Iface.Type
966 suppress_bndr_sig = SuppressBndrSig True
967
968 pprIfaceDecl ss (IfaceFamily { ifName = tycon
969 , ifFamFlav = rhs, ifBinders = binders
970 , ifResKind = res_kind
971 , ifResVar = res_var, ifFamInj = inj })
972 | IfaceDataFamilyTyCon <- rhs
973 = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind)
974 , text "data family" <+> pprIfaceDeclHead suppress_bndr_sig [] ss tycon binders
975 ]
976
977 | otherwise
978 = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind)
979 , hang (text "type family"
980 <+> pprIfaceDeclHead suppress_bndr_sig [] ss tycon binders
981 <+> ppShowRhs ss (pp_where rhs))
982 2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
983 $$
984 nest 2 (ppShowRhs ss (pp_branches rhs))
985 ]
986 where
987 name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tycon)
988
989 pp_where (IfaceClosedSynFamilyTyCon {}) = text "where"
990 pp_where _ = empty
991
992 pp_inj Nothing _ = empty
993 pp_inj (Just res) inj
994 | Injective injectivity <- inj = hsep [ equals, ppr res
995 , pp_inj_cond res injectivity]
996 | otherwise = hsep [ equals, ppr res ]
997
998 pp_inj_cond res inj = case filterByList inj binders of
999 [] -> empty
1000 tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)]
1001
1002 pp_rhs IfaceDataFamilyTyCon
1003 = ppShowIface ss (text "data")
1004 pp_rhs IfaceOpenSynFamilyTyCon
1005 = ppShowIface ss (text "open")
1006 pp_rhs IfaceAbstractClosedSynFamilyTyCon
1007 = ppShowIface ss (text "closed, abstract")
1008 pp_rhs (IfaceClosedSynFamilyTyCon {})
1009 = empty -- see pp_branches
1010 pp_rhs IfaceBuiltInSynFamTyCon
1011 = ppShowIface ss (text "built-in")
1012
1013 pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
1014 = vcat (unzipWith (pprAxBranch
1015 (pprPrefixIfDeclBndr
1016 (ss_how_much ss)
1017 (occName tycon))
1018 ) $ zip [0..] brs)
1019 $$ ppShowIface ss (text "axiom" <+> ppr ax)
1020 pp_branches _ = Outputable.empty
1021
1022 -- See Note [Suppressing binder signatures] in GHC.Iface.Type
1023 suppress_bndr_sig = SuppressBndrSig True
1024
1025 pprIfaceDecl _ (IfacePatSyn { ifName = name,
1026 ifPatUnivBndrs = univ_bndrs, ifPatExBndrs = ex_bndrs,
1027 ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
1028 ifPatArgs = arg_tys, ifFieldLabels = pat_fldlbls,
1029 ifPatTy = pat_ty} )
1030 = sdocWithContext mk_msg
1031 where
1032 pat_keywrd = text "pattern"
1033 mk_msg sdocCtx
1034 = vcat [ ppr_pat_ty
1035 -- only print this for record pattern synonyms
1036 , if null pat_fldlbls then Outputable.empty
1037 else pat_keywrd <+> pprPrefixOcc name <+> pat_body]
1038 where
1039 ppr_pat_ty =
1040 hang (pat_keywrd <+> pprPrefixOcc name)
1041 2 (dcolon <+> sep [univ_msg
1042 , pprIfaceContextArr req_ctxt
1043 , ppWhen insert_empty_ctxt $ parens empty <+> darrow
1044 , ex_msg
1045 , pprIfaceContextArr prov_ctxt
1046 , pprIfaceType $ foldr (IfaceFunTy VisArg many_ty) pat_ty arg_tys ])
1047 pat_body = braces $ sep $ punctuate comma $ map ppr pat_fldlbls
1048 univ_msg = pprUserIfaceForAll $ tyVarSpecToBinders univ_bndrs
1049 ex_msg = pprUserIfaceForAll $ tyVarSpecToBinders ex_bndrs
1050
1051 insert_empty_ctxt = null req_ctxt
1052 && not (null prov_ctxt && isEmpty sdocCtx ex_msg)
1053
1054 pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
1055 ifIdDetails = details, ifIdInfo = info })
1056 = vcat [ hang (pprPrefixIfDeclBndr (ss_how_much ss) (occName var) <+> dcolon)
1057 2 (pprIfaceSigmaType (ss_forall ss) ty)
1058 , ppShowIface ss (ppr details)
1059 , ppShowIface ss (ppr info) ]
1060
1061 pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
1062 , ifAxBranches = branches })
1063 = hang (text "axiom" <+> ppr name <+> dcolon)
1064 2 (vcat $ unzipWith (pprAxBranch (ppr tycon)) $ zip [0..] branches)
1065
1066 pprCType :: Maybe CType -> SDoc
1067 pprCType Nothing = Outputable.empty
1068 pprCType (Just cType) = text "C type:" <+> ppr cType
1069
1070 -- if, for each role, suppress_if role is True, then suppress the role
1071 -- output
1072 pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTyConBinder]
1073 -> [Role] -> SDoc
1074 pprRoles suppress_if tyCon bndrs roles
1075 = sdocOption sdocPrintExplicitKinds $ \print_kinds ->
1076 let froles = suppressIfaceInvisibles (PrintExplicitKinds print_kinds) bndrs roles
1077 in ppUnless (all suppress_if froles || null froles) $
1078 text "type role" <+> tyCon <+> hsep (map ppr froles)
1079
1080 pprStandaloneKindSig :: SDoc -> IfaceType -> SDoc
1081 pprStandaloneKindSig tyCon ty = text "type" <+> tyCon <+> text "::" <+> ppr ty
1082
1083 pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
1084 pprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name
1085 = pprInfixVar (isSymOcc name) (ppr_bndr name)
1086 pprInfixIfDeclBndr _ name
1087 = pprInfixVar (isSymOcc name) (ppr name)
1088
1089 pprPrefixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
1090 pprPrefixIfDeclBndr (ShowHeader (AltPpr (Just ppr_bndr))) name
1091 = parenSymOcc name (ppr_bndr name)
1092 pprPrefixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name
1093 = parenSymOcc name (ppr_bndr name)
1094 pprPrefixIfDeclBndr _ name
1095 = parenSymOcc name (ppr name)
1096
1097 instance Outputable IfaceClassOp where
1098 ppr = pprIfaceClassOp showToIface
1099
1100 pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
1101 pprIfaceClassOp ss (IfaceClassOp n ty dm)
1102 = pp_sig n ty $$ generic_dm
1103 where
1104 generic_dm | Just (GenericDM dm_ty) <- dm
1105 = text "default" <+> pp_sig n dm_ty
1106 | otherwise
1107 = empty
1108 pp_sig n ty
1109 = pprPrefixIfDeclBndr (ss_how_much ss) (occName n)
1110 <+> dcolon
1111 <+> pprIfaceSigmaType ShowForAllWhen ty
1112
1113 instance Outputable IfaceAT where
1114 ppr = pprIfaceAT showToIface
1115
1116 pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
1117 pprIfaceAT ss (IfaceAT d mb_def)
1118 = vcat [ pprIfaceDecl ss d
1119 , case mb_def of
1120 Nothing -> Outputable.empty
1121 Just rhs -> nest 2 $
1122 text "Default:" <+> ppr rhs ]
1123
1124 instance Outputable IfaceTyConParent where
1125 ppr p = pprIfaceTyConParent p
1126
1127 pprIfaceTyConParent :: IfaceTyConParent -> SDoc
1128 pprIfaceTyConParent IfNoParent
1129 = Outputable.empty
1130 pprIfaceTyConParent (IfDataInstance _ tc tys)
1131 = pprIfaceTypeApp topPrec tc tys
1132
1133 pprIfaceDeclHead :: SuppressBndrSig
1134 -> IfaceContext -> ShowSub -> Name
1135 -> [IfaceTyConBinder] -- of the tycon, for invisible-suppression
1136 -> SDoc
1137 pprIfaceDeclHead suppress_sig context ss tc_occ bndrs
1138 = sdocOption sdocPrintExplicitKinds $ \print_kinds ->
1139 sep [ pprIfaceContextArr context
1140 , pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ)
1141 <+> pprIfaceTyConBinders suppress_sig
1142 (suppressIfaceInvisibles (PrintExplicitKinds print_kinds) bndrs bndrs) ]
1143
1144 pprIfaceConDecl :: ShowSub -> Bool
1145 -> IfaceTopBndr
1146 -> [IfaceTyConBinder]
1147 -> IfaceTyConParent
1148 -> IfaceConDecl -> SDoc
1149 pprIfaceConDecl ss gadt_style tycon tc_binders parent
1150 (IfCon { ifConName = name, ifConInfix = is_infix,
1151 ifConUserTvBinders = user_tvbs,
1152 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
1153 ifConStricts = stricts, ifConFields = fields })
1154 | gadt_style = pp_prefix_con <+> dcolon <+> ppr_gadt_ty
1155 | otherwise = ppr_ex_quant pp_h98_con
1156 where
1157 pp_h98_con
1158 | not (null fields) = pp_prefix_con <+> pp_field_args
1159 | is_infix
1160 , [ty1, ty2] <- pp_args
1161 = sep [ ty1
1162 , pprInfixIfDeclBndr how_much (occName name)
1163 , ty2]
1164 | otherwise = pp_prefix_con <+> sep pp_args
1165
1166 how_much = ss_how_much ss
1167 tys_w_strs :: [(IfaceBang, IfaceType)]
1168 tys_w_strs = zip stricts (map snd arg_tys)
1169 pp_prefix_con = pprPrefixIfDeclBndr how_much (occName name)
1170
1171 -- If we're pretty-printing a H98-style declaration with existential
1172 -- quantification, then user_tvbs will always consist of the universal
1173 -- tyvar binders followed by the existential tyvar binders. So to recover
1174 -- the visibilities of the existential tyvar binders, we can simply drop
1175 -- the universal tyvar binders from user_tvbs.
1176 ex_tvbs = dropList tc_binders user_tvbs
1177 ppr_ex_quant = pprIfaceForAllPartMust (ifaceForAllSpecToBndrs ex_tvbs) ctxt
1178 pp_gadt_res_ty = mk_user_con_res_ty eq_spec
1179 ppr_gadt_ty = pprIfaceForAllPart (ifaceForAllSpecToBndrs user_tvbs) ctxt pp_tau
1180
1181 -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
1182 -- because we don't have a Name for the tycon, only an OccName
1183 pp_tau | null fields
1184 = case pp_args ++ [pp_gadt_res_ty] of
1185 (t:ts) -> fsep (t : zipWithEqual "pprIfaceConDecl" (\(w,_) d -> ppr_arr w <+> d) arg_tys ts)
1186 [] -> panic "pp_con_taus"
1187 | otherwise
1188 = sep [pp_field_args, arrow <+> pp_gadt_res_ty]
1189
1190 -- Constructors are linear by default, but we don't want to show
1191 -- linear arrows when -XLinearTypes is disabled
1192 ppr_arr w = sdocOption sdocLinearTypes (\linearTypes -> if linearTypes
1193 then ppr_fun_arrow w
1194 else arrow)
1195
1196 ppr_bang IfNoBang = whenPprDebug $ char '_'
1197 ppr_bang IfStrict = char '!'
1198 ppr_bang IfUnpack = text "{-# UNPACK #-}"
1199 ppr_bang (IfUnpackCo co) = text "! {-# UNPACK #-}" <>
1200 pprParendIfaceCoercion co
1201
1202 pprFieldArgTy, pprArgTy :: (IfaceBang, IfaceType) -> SDoc
1203 -- If using record syntax, the only reason one would need to parenthesize
1204 -- a compound field type is if it's preceded by a bang pattern.
1205 pprFieldArgTy (bang, ty) = ppr_arg_ty (bang_prec bang) bang ty
1206 -- If not using record syntax, a compound field type might need to be
1207 -- parenthesized if one of the following holds:
1208 --
1209 -- 1. We're using Haskell98 syntax.
1210 -- 2. The field type is preceded with a bang pattern.
1211 pprArgTy (bang, ty) = ppr_arg_ty (max gadt_prec (bang_prec bang)) bang ty
1212
1213 ppr_arg_ty :: PprPrec -> IfaceBang -> IfaceType -> SDoc
1214 ppr_arg_ty prec bang ty = ppr_bang bang <> pprPrecIfaceType prec ty
1215
1216 -- If we're displaying the fields GADT-style, e.g.,
1217 --
1218 -- data Foo a where
1219 -- MkFoo :: (Int -> Int) -> Maybe a -> Foo
1220 --
1221 -- Then we use `funPrec`, since that will ensure `Int -> Int` gets the
1222 -- parentheses that it requires, but simple compound types like `Maybe a`
1223 -- (which don't require parentheses in a function argument position) won't
1224 -- get them, assuming that there are no bang patterns (see bang_prec).
1225 --
1226 -- If we're displaying the fields Haskell98-style, e.g.,
1227 --
1228 -- data Foo a = MkFoo (Int -> Int) (Maybe a)
1229 --
1230 -- Then not only must we parenthesize `Int -> Int`, we must also
1231 -- parenthesize compound fields like (Maybe a). Therefore, we pick
1232 -- `appPrec`, which has higher precedence than `funPrec`.
1233 gadt_prec :: PprPrec
1234 gadt_prec
1235 | gadt_style = funPrec
1236 | otherwise = appPrec
1237
1238 -- The presence of bang patterns or UNPACK annotations requires
1239 -- surrounding the type with parentheses, if needed (#13699)
1240 bang_prec :: IfaceBang -> PprPrec
1241 bang_prec IfNoBang = topPrec
1242 bang_prec IfStrict = appPrec
1243 bang_prec IfUnpack = appPrec
1244 bang_prec IfUnpackCo{} = appPrec
1245
1246 pp_args :: [SDoc] -- No records, e.g., ` Maybe a -> Int -> ...` or
1247 -- `!(Maybe a) -> !Int -> ...`
1248 pp_args = map pprArgTy tys_w_strs
1249
1250 pp_field_args :: SDoc -- Records, e.g., { x :: Maybe a, y :: Int } or
1251 -- { x :: !(Maybe a), y :: !Int }
1252 pp_field_args = braces $ sep $ punctuate comma $ ppr_trim $
1253 zipWith maybe_show_label fields tys_w_strs
1254
1255 maybe_show_label :: FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc
1256 maybe_show_label lbl bty
1257 | showSub ss sel = Just (pprPrefixIfDeclBndr how_much occ
1258 <+> dcolon <+> pprFieldArgTy bty)
1259 | otherwise = Nothing
1260 where
1261 sel = flSelector lbl
1262 occ = mkVarOccFS (flLabel lbl)
1263
1264 mk_user_con_res_ty :: IfaceEqSpec -> SDoc
1265 -- See Note [Result type of a data family GADT]
1266 mk_user_con_res_ty eq_spec
1267 | IfDataInstance _ tc tys <- parent
1268 = pprIfaceType (IfaceTyConApp tc (substIfaceAppArgs gadt_subst tys))
1269 | otherwise
1270 = ppr_tc_app gadt_subst
1271 where
1272 gadt_subst = mkIfaceTySubst eq_spec
1273
1274 -- When pretty-printing a GADT return type, we:
1275 --
1276 -- 1. Take the data tycon binders, extract their variable names and
1277 -- visibilities, and construct suitable arguments from them. (This is
1278 -- the role of mk_tc_app_args.)
1279 -- 2. Apply the GADT substitution constructed from the eq_spec.
1280 -- (See Note [Result type of a data family GADT].)
1281 -- 3. Pretty-print the data type constructor applied to its arguments.
1282 -- This process will omit any invisible arguments, such as coercion
1283 -- variables, if necessary. (See Note
1284 -- [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep.)
1285 ppr_tc_app gadt_subst =
1286 pprPrefixIfDeclBndr how_much (occName tycon)
1287 <+> pprParendIfaceAppArgs
1288 (substIfaceAppArgs gadt_subst (mk_tc_app_args tc_binders))
1289
1290 mk_tc_app_args :: [IfaceTyConBinder] -> IfaceAppArgs
1291 mk_tc_app_args [] = IA_Nil
1292 mk_tc_app_args (Bndr bndr vis:tc_bndrs) =
1293 IA_Arg (IfaceTyVar (ifaceBndrName bndr)) (tyConBndrVisArgFlag vis)
1294 (mk_tc_app_args tc_bndrs)
1295
1296 instance Outputable IfaceRule where
1297 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
1298 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
1299 ifRuleOrph = orph })
1300 = sep [ hsep [ pprRuleName name
1301 , if isOrphan orph then text "[orphan]" else Outputable.empty
1302 , ppr act
1303 , pp_foralls ]
1304 , nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
1305 text "=" <+> ppr rhs]) ]
1306 where
1307 pp_foralls = ppUnless (null bndrs) $ forAllLit <+> pprIfaceBndrs bndrs <> dot
1308
1309 instance Outputable IfaceClsInst where
1310 ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag
1311 , ifInstCls = cls, ifInstTys = mb_tcs
1312 , ifInstOrph = orph })
1313 = hang (text "instance" <+> ppr flag
1314 <+> (if isOrphan orph then text "[orphan]" else Outputable.empty)
1315 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
1316 2 (equals <+> ppr dfun_id)
1317
1318 instance Outputable IfaceFamInst where
1319 ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
1320 , ifFamInstAxiom = tycon_ax, ifFamInstOrph = orph })
1321 = hang (text "family instance"
1322 <+> (if isOrphan orph then text "[orphan]" else Outputable.empty)
1323 <+> ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
1324 2 (equals <+> ppr tycon_ax)
1325
1326 ppr_rough :: Maybe IfaceTyCon -> SDoc
1327 ppr_rough Nothing = dot
1328 ppr_rough (Just tc) = ppr tc
1329
1330 {-
1331 Note [Result type of a data family GADT]
1332 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1333 Consider
1334 data family T a
1335 data instance T (p,q) where
1336 T1 :: T (Int, Maybe c)
1337 T2 :: T (Bool, q)
1338
1339 The IfaceDecl actually looks like
1340
1341 data TPr p q where
1342 T1 :: forall p q. forall c. (p~Int,q~Maybe c) => TPr p q
1343 T2 :: forall p q. (p~Bool) => TPr p q
1344
1345 To reconstruct the result types for T1 and T2 that we
1346 want to pretty print, we substitute the eq-spec
1347 [p->Int, q->Maybe c] in the arg pattern (p,q) to give
1348 T (Int, Maybe c)
1349 Remember that in IfaceSyn, the TyCon and DataCon share the same
1350 universal type variables.
1351
1352 ----------------------------- Printing IfaceExpr ------------------------------------
1353 -}
1354
1355 instance Outputable IfaceExpr where
1356 ppr e = pprIfaceExpr noParens e
1357
1358 noParens :: SDoc -> SDoc
1359 noParens pp = pp
1360
1361 pprParendIfaceExpr :: IfaceExpr -> SDoc
1362 pprParendIfaceExpr = pprIfaceExpr parens
1363
1364 -- | Pretty Print an IfaceExpr
1365 --
1366 -- The first argument should be a function that adds parens in context that need
1367 -- an atomic value (e.g. function args)
1368 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
1369
1370 pprIfaceExpr _ (IfaceLcl v) = ppr v
1371 pprIfaceExpr _ (IfaceExt v) = ppr v
1372 pprIfaceExpr _ (IfaceLit l) = ppr l
1373 pprIfaceExpr _ (IfaceLitRubbish r) = text "RUBBISH" <> parens (ppr r)
1374 pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
1375 pprIfaceExpr _ (IfaceType ty) = char '@' <> pprParendIfaceType ty
1376 pprIfaceExpr _ (IfaceCo co) = text "@~" <> pprParendIfaceCoercion co
1377
1378 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
1379 pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (pprWithCommas ppr as)
1380
1381 pprIfaceExpr add_par i@(IfaceLam _ _)
1382 = add_par (sep [char '\\' <+> sep (map pprIfaceLamBndr bndrs) <+> arrow,
1383 pprIfaceExpr noParens body])
1384 where
1385 (bndrs,body) = collect [] i
1386 collect bs (IfaceLam b e) = collect (b:bs) e
1387 collect bs e = (reverse bs, e)
1388
1389 pprIfaceExpr add_par (IfaceECase scrut ty)
1390 = add_par (sep [ text "case" <+> pprIfaceExpr noParens scrut
1391 , text "ret_ty" <+> pprParendIfaceType ty
1392 , text "of {}" ])
1393
1394 pprIfaceExpr add_par (IfaceCase scrut bndr [IfaceAlt con bs rhs])
1395 = add_par (sep [text "case"
1396 <+> pprIfaceExpr noParens scrut <+> text "of"
1397 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
1398 pprIfaceExpr noParens rhs <+> char '}'])
1399
1400 pprIfaceExpr add_par (IfaceCase scrut bndr alts)
1401 = add_par (sep [text "case"
1402 <+> pprIfaceExpr noParens scrut <+> text "of"
1403 <+> ppr bndr <+> char '{',
1404 nest 2 (sep (map pprIfaceAlt alts)) <+> char '}'])
1405
1406 pprIfaceExpr _ (IfaceCast expr co)
1407 = sep [pprParendIfaceExpr expr,
1408 nest 2 (text "`cast`"),
1409 pprParendIfaceCoercion co]
1410
1411 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
1412 = add_par (sep [text "let {",
1413 nest 2 (ppr_bind (b, rhs)),
1414 text "} in",
1415 pprIfaceExpr noParens body])
1416
1417 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
1418 = add_par (sep [text "letrec {",
1419 nest 2 (sep (map ppr_bind pairs)),
1420 text "} in",
1421 pprIfaceExpr noParens body])
1422
1423 pprIfaceExpr add_par (IfaceTick tickish e)
1424 = add_par (pprIfaceTickish tickish <+> pprIfaceExpr noParens e)
1425
1426 pprIfaceAlt :: IfaceAlt -> SDoc
1427 pprIfaceAlt (IfaceAlt con bs rhs)
1428 = sep [ppr_con_bs con bs, arrow <+> pprIfaceExpr noParens rhs]
1429
1430 ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
1431 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
1432
1433 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
1434 ppr_bind (IfLetBndr b ty info ji, rhs)
1435 = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr ji <+> ppr info),
1436 equals <+> pprIfaceExpr noParens rhs]
1437
1438 ------------------
1439 pprIfaceTickish :: IfaceTickish -> SDoc
1440 pprIfaceTickish (IfaceHpcTick m ix)
1441 = braces (text "tick" <+> ppr m <+> ppr ix)
1442 pprIfaceTickish (IfaceSCC cc tick scope)
1443 = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)
1444 pprIfaceTickish (IfaceSource src _names)
1445 = braces (pprUserRealSpan True src)
1446
1447 ------------------
1448 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
1449 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
1450 nest 2 (pprParendIfaceExpr arg) : args
1451 pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
1452
1453 ------------------
1454 instance Outputable IfaceConAlt where
1455 ppr IfaceDefault = text "DEFAULT"
1456 ppr (IfaceLitAlt l) = ppr l
1457 ppr (IfaceDataAlt d) = ppr d
1458
1459 ------------------
1460 instance Outputable IfaceIdDetails where
1461 ppr IfVanillaId = Outputable.empty
1462 ppr (IfRecSelId tc b) = text "RecSel" <+> ppr tc
1463 <+> if b
1464 then text "<naughty>"
1465 else Outputable.empty
1466 ppr IfDFunId = text "DFunId"
1467
1468 instance Outputable IfaceInfoItem where
1469 ppr (HsUnfold lb unf) = text "Unfolding"
1470 <> ppWhen lb (text "(loop-breaker)")
1471 <> colon <+> ppr unf
1472 ppr (HsInline prag) = text "Inline:" <+> ppr prag
1473 ppr (HsArity arity) = text "Arity:" <+> int arity
1474 ppr (HsDmdSig str) = text "Strictness:" <+> ppr str
1475 ppr (HsCprSig cpr) = text "CPR:" <+> ppr cpr
1476 ppr HsNoCafRefs = text "HasNoCafRefs"
1477 ppr HsLevity = text "Never levity-polymorphic"
1478 ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info
1479
1480 instance Outputable IfaceJoinInfo where
1481 ppr IfaceNotJoinPoint = empty
1482 ppr (IfaceJoinPoint ar) = angleBrackets (text "join" <+> ppr ar)
1483
1484 instance Outputable IfaceUnfolding where
1485 ppr (IfCompulsory e) = text "<compulsory>" <+> parens (ppr e)
1486 ppr (IfCoreUnfold s e) = (if s
1487 then text "<stable>"
1488 else Outputable.empty)
1489 <+> parens (ppr e)
1490 ppr (IfInlineRule a uok bok e) = sep [text "InlineRule"
1491 <+> ppr (a,uok,bok),
1492 pprParendIfaceExpr e]
1493 ppr (IfDFunUnfold bs es) = hang (text "DFun:" <+> sep (map ppr bs) <> dot)
1494 2 (sep (map pprParendIfaceExpr es))
1495
1496 {-
1497 ************************************************************************
1498 * *
1499 Finding the Names in Iface syntax
1500 * *
1501 ************************************************************************
1502
1503 This is used for dependency analysis in GHC.Iface.Make, so that we
1504 fingerprint a declaration before the things that depend on it. It
1505 is specific to interface-file fingerprinting in the sense that we
1506 don't collect *all* Names: for example, the DFun of an instance is
1507 recorded textually rather than by its fingerprint when
1508 fingerprinting the instance, so DFuns are not dependencies.
1509 -}
1510
1511 freeNamesIfDecl :: IfaceDecl -> NameSet
1512 freeNamesIfDecl (IfaceId { ifType = t, ifIdDetails = d, ifIdInfo = i})
1513 = freeNamesIfType t &&&
1514 freeNamesIfIdInfo i &&&
1515 freeNamesIfIdDetails d
1516
1517 freeNamesIfDecl (IfaceData { ifBinders = bndrs, ifResKind = res_k
1518 , ifParent = p, ifCtxt = ctxt, ifCons = cons })
1519 = freeNamesIfVarBndrs bndrs &&&
1520 freeNamesIfType res_k &&&
1521 freeNamesIfaceTyConParent p &&&
1522 freeNamesIfContext ctxt &&&
1523 freeNamesIfConDecls cons
1524
1525 freeNamesIfDecl (IfaceSynonym { ifBinders = bndrs, ifResKind = res_k
1526 , ifSynRhs = rhs })
1527 = freeNamesIfVarBndrs bndrs &&&
1528 freeNamesIfKind res_k &&&
1529 freeNamesIfType rhs
1530
1531 freeNamesIfDecl (IfaceFamily { ifBinders = bndrs, ifResKind = res_k
1532 , ifFamFlav = flav })
1533 = freeNamesIfVarBndrs bndrs &&&
1534 freeNamesIfKind res_k &&&
1535 freeNamesIfFamFlav flav
1536
1537 freeNamesIfDecl (IfaceClass{ ifBinders = bndrs, ifBody = cls_body })
1538 = freeNamesIfVarBndrs bndrs &&&
1539 freeNamesIfClassBody cls_body
1540
1541 freeNamesIfDecl (IfaceAxiom { ifTyCon = tc, ifAxBranches = branches })
1542 = freeNamesIfTc tc &&&
1543 fnList freeNamesIfAxBranch branches
1544
1545 freeNamesIfDecl (IfacePatSyn { ifPatMatcher = (matcher, _)
1546 , ifPatBuilder = mb_builder
1547 , ifPatUnivBndrs = univ_bndrs
1548 , ifPatExBndrs = ex_bndrs
1549 , ifPatProvCtxt = prov_ctxt
1550 , ifPatReqCtxt = req_ctxt
1551 , ifPatArgs = args
1552 , ifPatTy = pat_ty
1553 , ifFieldLabels = lbls })
1554 = unitNameSet matcher &&&
1555 maybe emptyNameSet (unitNameSet . fst) mb_builder &&&
1556 freeNamesIfVarBndrs univ_bndrs &&&
1557 freeNamesIfVarBndrs ex_bndrs &&&
1558 freeNamesIfContext prov_ctxt &&&
1559 freeNamesIfContext req_ctxt &&&
1560 fnList freeNamesIfType args &&&
1561 freeNamesIfType pat_ty &&&
1562 mkNameSet (map flSelector lbls)
1563
1564 freeNamesIfClassBody :: IfaceClassBody -> NameSet
1565 freeNamesIfClassBody IfAbstractClass
1566 = emptyNameSet
1567 freeNamesIfClassBody (IfConcreteClass{ ifClassCtxt = ctxt, ifATs = ats, ifSigs = sigs })
1568 = freeNamesIfContext ctxt &&&
1569 fnList freeNamesIfAT ats &&&
1570 fnList freeNamesIfClsSig sigs
1571
1572 freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
1573 freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars = tyvars
1574 , ifaxbCoVars = covars
1575 , ifaxbLHS = lhs
1576 , ifaxbRHS = rhs })
1577 = fnList freeNamesIfTvBndr tyvars &&&
1578 fnList freeNamesIfIdBndr covars &&&
1579 freeNamesIfAppArgs lhs &&&
1580 freeNamesIfType rhs
1581
1582 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
1583 freeNamesIfIdDetails (IfRecSelId tc _) =
1584 either freeNamesIfTc freeNamesIfDecl tc
1585 freeNamesIfIdDetails _ = emptyNameSet
1586
1587 -- All other changes are handled via the version info on the tycon
1588 freeNamesIfFamFlav :: IfaceFamTyConFlav -> NameSet
1589 freeNamesIfFamFlav IfaceOpenSynFamilyTyCon = emptyNameSet
1590 freeNamesIfFamFlav IfaceDataFamilyTyCon = emptyNameSet
1591 freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon (Just (ax, br)))
1592 = unitNameSet ax &&& fnList freeNamesIfAxBranch br
1593 freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon Nothing) = emptyNameSet
1594 freeNamesIfFamFlav IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
1595 freeNamesIfFamFlav IfaceBuiltInSynFamTyCon = emptyNameSet
1596
1597 freeNamesIfContext :: IfaceContext -> NameSet
1598 freeNamesIfContext = fnList freeNamesIfType
1599
1600 freeNamesIfAT :: IfaceAT -> NameSet
1601 freeNamesIfAT (IfaceAT decl mb_def)
1602 = freeNamesIfDecl decl &&&
1603 case mb_def of
1604 Nothing -> emptyNameSet
1605 Just rhs -> freeNamesIfType rhs
1606
1607 freeNamesIfClsSig :: IfaceClassOp -> NameSet
1608 freeNamesIfClsSig (IfaceClassOp _n ty dm) = freeNamesIfType ty &&& freeNamesDM dm
1609
1610 freeNamesDM :: Maybe (DefMethSpec IfaceType) -> NameSet
1611 freeNamesDM (Just (GenericDM ty)) = freeNamesIfType ty
1612 freeNamesDM _ = emptyNameSet
1613
1614 freeNamesIfConDecls :: IfaceConDecls -> NameSet
1615 freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
1616 freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
1617 freeNamesIfConDecls _ = emptyNameSet
1618
1619 freeNamesIfConDecl :: IfaceConDecl -> NameSet
1620 freeNamesIfConDecl (IfCon { ifConExTCvs = ex_tvs, ifConCtxt = ctxt
1621 , ifConArgTys = arg_tys
1622 , ifConFields = flds
1623 , ifConEqSpec = eq_spec
1624 , ifConStricts = bangs })
1625 = fnList freeNamesIfBndr ex_tvs &&&
1626 freeNamesIfContext ctxt &&&
1627 fnList freeNamesIfType (map fst arg_tys) &&& -- these are multiplicities, represented as types
1628 fnList freeNamesIfType (map snd arg_tys) &&&
1629 mkNameSet (map flSelector flds) &&&
1630 fnList freeNamesIfType (map snd eq_spec) &&& -- equality constraints
1631 fnList freeNamesIfBang bangs
1632
1633 freeNamesIfBang :: IfaceBang -> NameSet
1634 freeNamesIfBang (IfUnpackCo co) = freeNamesIfCoercion co
1635 freeNamesIfBang _ = emptyNameSet
1636
1637 freeNamesIfKind :: IfaceType -> NameSet
1638 freeNamesIfKind = freeNamesIfType
1639
1640 freeNamesIfAppArgs :: IfaceAppArgs -> NameSet
1641 freeNamesIfAppArgs (IA_Arg t _ ts) = freeNamesIfType t &&& freeNamesIfAppArgs ts
1642 freeNamesIfAppArgs IA_Nil = emptyNameSet
1643
1644 freeNamesIfType :: IfaceType -> NameSet
1645 freeNamesIfType (IfaceFreeTyVar _) = emptyNameSet
1646 freeNamesIfType (IfaceTyVar _) = emptyNameSet
1647 freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfAppArgs t
1648 freeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& freeNamesIfAppArgs ts
1649 freeNamesIfType (IfaceTupleTy _ _ ts) = freeNamesIfAppArgs ts
1650 freeNamesIfType (IfaceLitTy _) = emptyNameSet
1651 freeNamesIfType (IfaceForAllTy tv t) = freeNamesIfVarBndr tv &&& freeNamesIfType t
1652 freeNamesIfType (IfaceFunTy _ w s t) = freeNamesIfType s &&& freeNamesIfType t &&& freeNamesIfType w
1653 freeNamesIfType (IfaceCastTy t c) = freeNamesIfType t &&& freeNamesIfCoercion c
1654 freeNamesIfType (IfaceCoercionTy c) = freeNamesIfCoercion c
1655
1656 freeNamesIfMCoercion :: IfaceMCoercion -> NameSet
1657 freeNamesIfMCoercion IfaceMRefl = emptyNameSet
1658 freeNamesIfMCoercion (IfaceMCo co) = freeNamesIfCoercion co
1659
1660 freeNamesIfCoercion :: IfaceCoercion -> NameSet
1661 freeNamesIfCoercion (IfaceReflCo t) = freeNamesIfType t
1662 freeNamesIfCoercion (IfaceGReflCo _ t mco)
1663 = freeNamesIfType t &&& freeNamesIfMCoercion mco
1664 freeNamesIfCoercion (IfaceFunCo _ c_mult c1 c2)
1665 = freeNamesIfCoercion c_mult &&& freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
1666 freeNamesIfCoercion (IfaceTyConAppCo _ tc cos)
1667 = freeNamesIfTc tc &&& fnList freeNamesIfCoercion cos
1668 freeNamesIfCoercion (IfaceAppCo c1 c2)
1669 = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
1670 freeNamesIfCoercion (IfaceForAllCo _ kind_co co)
1671 = freeNamesIfCoercion kind_co &&& freeNamesIfCoercion co
1672 freeNamesIfCoercion (IfaceFreeCoVar _) = emptyNameSet
1673 freeNamesIfCoercion (IfaceCoVarCo _) = emptyNameSet
1674 freeNamesIfCoercion (IfaceHoleCo _) = emptyNameSet
1675 freeNamesIfCoercion (IfaceAxiomInstCo ax _ cos)
1676 = unitNameSet ax &&& fnList freeNamesIfCoercion cos
1677 freeNamesIfCoercion (IfaceUnivCo p _ t1 t2)
1678 = freeNamesIfProv p &&& freeNamesIfType t1 &&& freeNamesIfType t2
1679 freeNamesIfCoercion (IfaceSymCo c)
1680 = freeNamesIfCoercion c
1681 freeNamesIfCoercion (IfaceTransCo c1 c2)
1682 = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
1683 freeNamesIfCoercion (IfaceNthCo _ co)
1684 = freeNamesIfCoercion co
1685 freeNamesIfCoercion (IfaceLRCo _ co)
1686 = freeNamesIfCoercion co
1687 freeNamesIfCoercion (IfaceInstCo co co2)
1688 = freeNamesIfCoercion co &&& freeNamesIfCoercion co2
1689 freeNamesIfCoercion (IfaceKindCo c)
1690 = freeNamesIfCoercion c
1691 freeNamesIfCoercion (IfaceSubCo co)
1692 = freeNamesIfCoercion co
1693 freeNamesIfCoercion (IfaceAxiomRuleCo _ax cos)
1694 -- the axiom is just a string, so we don't count it as a name.
1695 = fnList freeNamesIfCoercion cos
1696
1697 freeNamesIfProv :: IfaceUnivCoProv -> NameSet
1698 freeNamesIfProv (IfacePhantomProv co) = freeNamesIfCoercion co
1699 freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co
1700 freeNamesIfProv (IfacePluginProv _) = emptyNameSet
1701 freeNamesIfProv (IfaceCorePrepProv _) = emptyNameSet
1702
1703 freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet
1704 freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr
1705
1706 freeNamesIfVarBndrs :: [VarBndr IfaceBndr vis] -> NameSet
1707 freeNamesIfVarBndrs = fnList freeNamesIfVarBndr
1708
1709 freeNamesIfBndr :: IfaceBndr -> NameSet
1710 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
1711 freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
1712
1713 freeNamesIfBndrs :: [IfaceBndr] -> NameSet
1714 freeNamesIfBndrs = fnList freeNamesIfBndr
1715
1716 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
1717 -- Remember IfaceLetBndr is used only for *nested* bindings
1718 -- The IdInfo can contain an unfolding (in the case of
1719 -- local INLINE pragmas), so look there too
1720 freeNamesIfLetBndr (IfLetBndr _name ty info _ji) = freeNamesIfType ty
1721 &&& freeNamesIfIdInfo info
1722
1723 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
1724 freeNamesIfTvBndr (_fs,k) = freeNamesIfKind k
1725 -- kinds can have Names inside, because of promotion
1726
1727 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
1728 freeNamesIfIdBndr (_, _fs,k) = freeNamesIfKind k
1729
1730 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
1731 freeNamesIfIdInfo = fnList freeNamesItem
1732
1733 freeNamesItem :: IfaceInfoItem -> NameSet
1734 freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
1735 freeNamesItem (HsLFInfo (IfLFCon n)) = unitNameSet n
1736 freeNamesItem _ = emptyNameSet
1737
1738 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
1739 freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
1740 freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
1741 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
1742 freeNamesIfUnfold (IfDFunUnfold bs es) = freeNamesIfBndrs bs &&& fnList freeNamesIfExpr es
1743
1744 freeNamesIfExpr :: IfaceExpr -> NameSet
1745 freeNamesIfExpr (IfaceExt v) = unitNameSet v
1746 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
1747 freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
1748 freeNamesIfExpr (IfaceCo co) = freeNamesIfCoercion co
1749 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
1750 freeNamesIfExpr (IfaceLam (b,_) body) = freeNamesIfBndr b &&& freeNamesIfExpr body
1751 freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
1752 freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfCoercion co
1753 freeNamesIfExpr (IfaceTick _ e) = freeNamesIfExpr e
1754 freeNamesIfExpr (IfaceECase e ty) = freeNamesIfExpr e &&& freeNamesIfType ty
1755 freeNamesIfExpr (IfaceCase s _ alts)
1756 = freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts
1757 where
1758 fn_alt (IfaceAlt _con _bs r) = freeNamesIfExpr r
1759
1760 -- Depend on the data constructors. Just one will do!
1761 -- Note [Tracking data constructors]
1762 fn_cons [] = emptyNameSet
1763 fn_cons (IfaceAlt IfaceDefault _ _ : xs) = fn_cons xs
1764 fn_cons (IfaceAlt (IfaceDataAlt con) _ _ : _ ) = unitNameSet con
1765 fn_cons (_ : _ ) = emptyNameSet
1766
1767 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
1768 = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
1769
1770 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
1771 = fnList fn_pair as &&& freeNamesIfExpr x
1772 where
1773 fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
1774
1775 freeNamesIfExpr _ = emptyNameSet
1776
1777 freeNamesIfTc :: IfaceTyCon -> NameSet
1778 freeNamesIfTc tc = unitNameSet (ifaceTyConName tc)
1779 -- ToDo: shouldn't we include IfaceIntTc & co.?
1780
1781 freeNamesIfRule :: IfaceRule -> NameSet
1782 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
1783 , ifRuleArgs = es, ifRuleRhs = rhs })
1784 = unitNameSet f &&&
1785 fnList freeNamesIfBndr bs &&&
1786 fnList freeNamesIfExpr es &&&
1787 freeNamesIfExpr rhs
1788
1789 freeNamesIfFamInst :: IfaceFamInst -> NameSet
1790 freeNamesIfFamInst (IfaceFamInst { ifFamInstFam = famName
1791 , ifFamInstAxiom = axName })
1792 = unitNameSet famName &&&
1793 unitNameSet axName
1794
1795 freeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet
1796 freeNamesIfaceTyConParent IfNoParent = emptyNameSet
1797 freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
1798 = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys
1799
1800 -- helpers
1801 (&&&) :: NameSet -> NameSet -> NameSet
1802 (&&&) = unionNameSet
1803
1804 fnList :: (a -> NameSet) -> [a] -> NameSet
1805 fnList f = foldr (&&&) emptyNameSet . map f
1806
1807 {-
1808 Note [Tracking data constructors]
1809 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1810 In a case expression
1811 case e of { C a -> ...; ... }
1812 You might think that we don't need to include the datacon C
1813 in the free names, because its type will probably show up in
1814 the free names of 'e'. But in rare circumstances this may
1815 not happen. Here's the one that bit me:
1816
1817 module DynFlags where
1818 import {-# SOURCE #-} Packages( PackageState )
1819 data DynFlags = DF ... PackageState ...
1820
1821 module Packages where
1822 import GHC.Driver.Session
1823 data PackageState = PS ...
1824 lookupModule (df :: DynFlags)
1825 = case df of
1826 DF ...p... -> case p of
1827 PS ... -> ...
1828
1829 Now, lookupModule depends on DynFlags, but the transitive dependency
1830 on the *locally-defined* type PackageState is not visible. We need
1831 to take account of the use of the data constructor PS in the pattern match.
1832
1833
1834 ************************************************************************
1835 * *
1836 Binary instances
1837 * *
1838 ************************************************************************
1839
1840 Note that there is a bit of subtlety here when we encode names. While
1841 IfaceTopBndrs is really just a synonym for Name, we need to take care to
1842 encode them with {get,put}IfaceTopBndr. The difference becomes important when
1843 we go to fingerprint an IfaceDecl. See Note [Fingerprinting IfaceDecls] for
1844 details.
1845
1846 -}
1847
1848 instance Binary IfaceDecl where
1849 put_ bh (IfaceId name ty details idinfo) = do
1850 putByte bh 0
1851 putIfaceTopBndr bh name
1852 lazyPut bh (ty, details, idinfo)
1853 -- See Note [Lazy deserialization of IfaceId]
1854
1855 put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1856 putByte bh 2
1857 putIfaceTopBndr bh a1
1858 put_ bh a2
1859 put_ bh a3
1860 put_ bh a4
1861 put_ bh a5
1862 put_ bh a6
1863 put_ bh a7
1864 put_ bh a8
1865 put_ bh a9
1866
1867 put_ bh (IfaceSynonym a1 a2 a3 a4 a5) = do
1868 putByte bh 3
1869 putIfaceTopBndr bh a1
1870 put_ bh a2
1871 put_ bh a3
1872 put_ bh a4
1873 put_ bh a5
1874
1875 put_ bh (IfaceFamily a1 a2 a3 a4 a5 a6) = do
1876 putByte bh 4
1877 putIfaceTopBndr bh a1
1878 put_ bh a2
1879 put_ bh a3
1880 put_ bh a4
1881 put_ bh a5
1882 put_ bh a6
1883
1884 -- NB: Written in a funny way to avoid an interface change
1885 put_ bh (IfaceClass {
1886 ifName = a2,
1887 ifRoles = a3,
1888 ifBinders = a4,
1889 ifFDs = a5,
1890 ifBody = IfConcreteClass {
1891 ifClassCtxt = a1,
1892 ifATs = a6,
1893 ifSigs = a7,
1894 ifMinDef = a8
1895 }}) = do
1896 putByte bh 5
1897 put_ bh a1
1898 putIfaceTopBndr bh a2
1899 put_ bh a3
1900 put_ bh a4
1901 put_ bh a5
1902 put_ bh a6
1903 put_ bh a7
1904 put_ bh a8
1905
1906 put_ bh (IfaceAxiom a1 a2 a3 a4) = do
1907 putByte bh 6
1908 putIfaceTopBndr bh a1
1909 put_ bh a2
1910 put_ bh a3
1911 put_ bh a4
1912
1913 put_ bh (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
1914 putByte bh 7
1915 putIfaceTopBndr bh a1
1916 put_ bh a2
1917 put_ bh a3
1918 put_ bh a4
1919 put_ bh a5
1920 put_ bh a6
1921 put_ bh a7
1922 put_ bh a8
1923 put_ bh a9
1924 put_ bh a10
1925 put_ bh a11
1926
1927 put_ bh (IfaceClass {
1928 ifName = a1,
1929 ifRoles = a2,
1930 ifBinders = a3,
1931 ifFDs = a4,
1932 ifBody = IfAbstractClass }) = do
1933 putByte bh 8
1934 putIfaceTopBndr bh a1
1935 put_ bh a2
1936 put_ bh a3
1937 put_ bh a4
1938
1939 get bh = do
1940 h <- getByte bh
1941 case h of
1942 0 -> do name <- get bh
1943 ~(ty, details, idinfo) <- lazyGet bh
1944 -- See Note [Lazy deserialization of IfaceId]
1945 return (IfaceId name ty details idinfo)
1946 1 -> error "Binary.get(TyClDecl): ForeignType"
1947 2 -> do a1 <- getIfaceTopBndr bh
1948 a2 <- get bh
1949 a3 <- get bh
1950 a4 <- get bh
1951 a5 <- get bh
1952 a6 <- get bh
1953 a7 <- get bh
1954 a8 <- get bh
1955 a9 <- get bh
1956 return (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9)
1957 3 -> do a1 <- getIfaceTopBndr bh
1958 a2 <- get bh
1959 a3 <- get bh
1960 a4 <- get bh
1961 a5 <- get bh
1962 return (IfaceSynonym a1 a2 a3 a4 a5)
1963 4 -> do a1 <- getIfaceTopBndr bh
1964 a2 <- get bh
1965 a3 <- get bh
1966 a4 <- get bh
1967 a5 <- get bh
1968 a6 <- get bh
1969 return (IfaceFamily a1 a2 a3 a4 a5 a6)
1970 5 -> do a1 <- get bh
1971 a2 <- getIfaceTopBndr bh
1972 a3 <- get bh
1973 a4 <- get bh
1974 a5 <- get bh
1975 a6 <- get bh
1976 a7 <- get bh
1977 a8 <- get bh
1978 return (IfaceClass {
1979 ifName = a2,
1980 ifRoles = a3,
1981 ifBinders = a4,
1982 ifFDs = a5,
1983 ifBody = IfConcreteClass {
1984 ifClassCtxt = a1,
1985 ifATs = a6,
1986 ifSigs = a7,
1987 ifMinDef = a8
1988 }})
1989 6 -> do a1 <- getIfaceTopBndr bh
1990 a2 <- get bh
1991 a3 <- get bh
1992 a4 <- get bh
1993 return (IfaceAxiom a1 a2 a3 a4)
1994 7 -> do a1 <- getIfaceTopBndr bh
1995 a2 <- get bh
1996 a3 <- get bh
1997 a4 <- get bh
1998 a5 <- get bh
1999 a6 <- get bh
2000 a7 <- get bh
2001 a8 <- get bh
2002 a9 <- get bh
2003 a10 <- get bh
2004 a11 <- get bh
2005 return (IfacePatSyn a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
2006 8 -> do a1 <- getIfaceTopBndr bh
2007 a2 <- get bh
2008 a3 <- get bh
2009 a4 <- get bh
2010 return (IfaceClass {
2011 ifName = a1,
2012 ifRoles = a2,
2013 ifBinders = a3,
2014 ifFDs = a4,
2015 ifBody = IfAbstractClass })
2016 _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
2017
2018 {- Note [Lazy deserialization of IfaceId]
2019 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2020 The use of lazyPut and lazyGet in the IfaceId Binary instance is
2021 purely for performance reasons, to avoid deserializing details about
2022 identifiers that will never be used. It's not involved in tying the
2023 knot in the type checker. It saved ~1% of the total build time of GHC.
2024
2025 When we read an interface file, we extend the PTE, a mapping of Names
2026 to TyThings, with the declarations we have read. The extension of the
2027 PTE is strict in the Names, but not in the TyThings themselves.
2028 GHC.IfaceToCore.tcIfaceDecls calculates the list of (Name, TyThing) bindings
2029 to add to the PTE. For an IfaceId, there's just one binding to add; and
2030 the ty, details, and idinfo fields of an IfaceId are used only in the
2031 TyThing. So by reading those fields lazily we may be able to save the
2032 work of ever having to deserialize them (into IfaceType, etc.).
2033
2034 For IfaceData and IfaceClass, tcIfaceDecls creates extra implicit bindings
2035 (the constructors and field selectors of the data declaration, or the
2036 methods of the class), whose Names depend on more than just the Name
2037 of the type constructor or class itself. So deserializing them lazily
2038 would be more involved. Similar comments apply to the other
2039 constructors of IfaceDecl with the additional point that they probably
2040 represent a small proportion of all declarations.
2041 -}
2042
2043 instance Binary IfaceFamTyConFlav where
2044 put_ bh IfaceDataFamilyTyCon = putByte bh 0
2045 put_ bh IfaceOpenSynFamilyTyCon = putByte bh 1
2046 put_ bh (IfaceClosedSynFamilyTyCon mb) = putByte bh 2 >> put_ bh mb
2047 put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 3
2048 put_ _ IfaceBuiltInSynFamTyCon
2049 = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" Outputable.empty
2050
2051 get bh = do { h <- getByte bh
2052 ; case h of
2053 0 -> return IfaceDataFamilyTyCon
2054 1 -> return IfaceOpenSynFamilyTyCon
2055 2 -> do { mb <- get bh
2056 ; return (IfaceClosedSynFamilyTyCon mb) }
2057 3 -> return IfaceAbstractClosedSynFamilyTyCon
2058 _ -> pprPanic "Binary.get(IfaceFamTyConFlav): Invalid tag"
2059 (ppr (fromIntegral h :: Int)) }
2060
2061 instance Binary IfaceClassOp where
2062 put_ bh (IfaceClassOp n ty def) = do
2063 putIfaceTopBndr bh n
2064 put_ bh ty
2065 put_ bh def
2066 get bh = do
2067 n <- getIfaceTopBndr bh
2068 ty <- get bh
2069 def <- get bh
2070 return (IfaceClassOp n ty def)
2071
2072 instance Binary IfaceAT where
2073 put_ bh (IfaceAT dec defs) = do
2074 put_ bh dec
2075 put_ bh defs
2076 get bh = do
2077 dec <- get bh
2078 defs <- get bh
2079 return (IfaceAT dec defs)
2080
2081 instance Binary IfaceAxBranch where
2082 put_ bh (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7) = do
2083 put_ bh a1
2084 put_ bh a2
2085 put_ bh a3
2086 put_ bh a4
2087 put_ bh a5
2088 put_ bh a6
2089 put_ bh a7
2090 get bh = do
2091 a1 <- get bh
2092 a2 <- get bh
2093 a3 <- get bh
2094 a4 <- get bh
2095 a5 <- get bh
2096 a6 <- get bh
2097 a7 <- get bh
2098 return (IfaceAxBranch a1 a2 a3 a4 a5 a6 a7)
2099
2100 instance Binary IfaceConDecls where
2101 put_ bh IfAbstractTyCon = putByte bh 0
2102 put_ bh (IfDataTyCon cs) = putByte bh 1 >> put_ bh cs
2103 put_ bh (IfNewTyCon c) = putByte bh 2 >> put_ bh c
2104 get bh = do
2105 h <- getByte bh
2106 case h of
2107 0 -> return IfAbstractTyCon
2108 1 -> liftM IfDataTyCon (get bh)
2109 2 -> liftM IfNewTyCon (get bh)
2110 _ -> error "Binary(IfaceConDecls).get: Invalid IfaceConDecls"
2111
2112 instance Binary IfaceConDecl where
2113 put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) = do
2114 putIfaceTopBndr bh a1
2115 put_ bh a2
2116 put_ bh a3
2117 put_ bh a4
2118 put_ bh a5
2119 put_ bh a6
2120 put_ bh a7
2121 put_ bh a8
2122 put_ bh (length a9)
2123 mapM_ (put_ bh) a9
2124 put_ bh a10
2125 put_ bh a11
2126 get bh = do
2127 a1 <- getIfaceTopBndr bh
2128 a2 <- get bh
2129 a3 <- get bh
2130 a4 <- get bh
2131 a5 <- get bh
2132 a6 <- get bh
2133 a7 <- get bh
2134 a8 <- get bh
2135 n_fields <- get bh
2136 a9 <- replicateM n_fields (get bh)
2137 a10 <- get bh
2138 a11 <- get bh
2139 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11)
2140
2141 instance Binary IfaceBang where
2142 put_ bh IfNoBang = putByte bh 0
2143 put_ bh IfStrict = putByte bh 1
2144 put_ bh IfUnpack = putByte bh 2
2145 put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
2146
2147 get bh = do
2148 h <- getByte bh
2149 case h of
2150 0 -> return IfNoBang
2151 1 -> return IfStrict
2152 2 -> return IfUnpack
2153 _ -> IfUnpackCo <$> get bh
2154
2155 instance Binary IfaceSrcBang where
2156 put_ bh (IfSrcBang a1 a2) =
2157 do put_ bh a1
2158 put_ bh a2
2159
2160 get bh =
2161 do a1 <- get bh
2162 a2 <- get bh
2163 return (IfSrcBang a1 a2)
2164
2165 instance Binary IfaceClsInst where
2166 put_ bh (IfaceClsInst cls tys dfun flag orph) = do
2167 put_ bh cls
2168 put_ bh tys
2169 put_ bh dfun
2170 put_ bh flag
2171 put_ bh orph
2172 get bh = do
2173 cls <- get bh
2174 tys <- get bh
2175 dfun <- get bh
2176 flag <- get bh
2177 orph <- get bh
2178 return (IfaceClsInst cls tys dfun flag orph)
2179
2180 instance Binary IfaceFamInst where
2181 put_ bh (IfaceFamInst fam tys name orph) = do
2182 put_ bh fam
2183 put_ bh tys
2184 put_ bh name
2185 put_ bh orph
2186 get bh = do
2187 fam <- get bh
2188 tys <- get bh
2189 name <- get bh
2190 orph <- get bh
2191 return (IfaceFamInst fam tys name orph)
2192
2193 instance Binary IfaceRule where
2194 put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
2195 put_ bh a1
2196 put_ bh a2
2197 put_ bh a3
2198 put_ bh a4
2199 put_ bh a5
2200 put_ bh a6
2201 put_ bh a7
2202 put_ bh a8
2203 get bh = do
2204 a1 <- get bh
2205 a2 <- get bh
2206 a3 <- get bh
2207 a4 <- get bh
2208 a5 <- get bh
2209 a6 <- get bh
2210 a7 <- get bh
2211 a8 <- get bh
2212 return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)
2213
2214 instance Binary IfaceAnnotation where
2215 put_ bh (IfaceAnnotation a1 a2) = do
2216 put_ bh a1
2217 put_ bh a2
2218 get bh = do
2219 a1 <- get bh
2220 a2 <- get bh
2221 return (IfaceAnnotation a1 a2)
2222
2223 instance Binary IfaceIdDetails where
2224 put_ bh IfVanillaId = putByte bh 0
2225 put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
2226 put_ bh IfDFunId = putByte bh 2
2227 get bh = do
2228 h <- getByte bh
2229 case h of
2230 0 -> return IfVanillaId
2231 1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
2232 _ -> return IfDFunId
2233
2234 instance Binary IfaceInfoItem where
2235 put_ bh (HsArity aa) = putByte bh 0 >> put_ bh aa
2236 put_ bh (HsDmdSig ab) = putByte bh 1 >> put_ bh ab
2237 put_ bh (HsUnfold lb ad) = putByte bh 2 >> put_ bh lb >> put_ bh ad
2238 put_ bh (HsInline ad) = putByte bh 3 >> put_ bh ad
2239 put_ bh HsNoCafRefs = putByte bh 4
2240 put_ bh HsLevity = putByte bh 5
2241 put_ bh (HsCprSig cpr) = putByte bh 6 >> put_ bh cpr
2242 put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info
2243
2244 get bh = do
2245 h <- getByte bh
2246 case h of
2247 0 -> liftM HsArity $ get bh
2248 1 -> liftM HsDmdSig $ get bh
2249 2 -> do lb <- get bh
2250 ad <- get bh
2251 return (HsUnfold lb ad)
2252 3 -> liftM HsInline $ get bh
2253 4 -> return HsNoCafRefs
2254 5 -> return HsLevity
2255 6 -> HsCprSig <$> get bh
2256 _ -> HsLFInfo <$> get bh
2257
2258 instance Binary IfaceUnfolding where
2259 put_ bh (IfCoreUnfold s e) = do
2260 putByte bh 0
2261 put_ bh s
2262 put_ bh e
2263 put_ bh (IfInlineRule a b c d) = do
2264 putByte bh 1
2265 put_ bh a
2266 put_ bh b
2267 put_ bh c
2268 put_ bh d
2269 put_ bh (IfDFunUnfold as bs) = do
2270 putByte bh 2
2271 put_ bh as
2272 put_ bh bs
2273 put_ bh (IfCompulsory e) = do
2274 putByte bh 3
2275 put_ bh e
2276 get bh = do
2277 h <- getByte bh
2278 case h of
2279 0 -> do s <- get bh
2280 e <- get bh
2281 return (IfCoreUnfold s e)
2282 1 -> do a <- get bh
2283 b <- get bh
2284 c <- get bh
2285 d <- get bh
2286 return (IfInlineRule a b c d)
2287 2 -> do as <- get bh
2288 bs <- get bh
2289 return (IfDFunUnfold as bs)
2290 _ -> do e <- get bh
2291 return (IfCompulsory e)
2292
2293 instance Binary IfaceAlt where
2294 put_ bh (IfaceAlt a b c) = do
2295 put_ bh a
2296 put_ bh b
2297 put_ bh c
2298 get bh = do
2299 a <- get bh
2300 b <- get bh
2301 c <- get bh
2302 return (IfaceAlt a b c)
2303
2304 instance Binary IfaceExpr where
2305 put_ bh (IfaceLcl aa) = do
2306 putByte bh 0
2307 put_ bh aa
2308 put_ bh (IfaceType ab) = do
2309 putByte bh 1
2310 put_ bh ab
2311 put_ bh (IfaceCo ab) = do
2312 putByte bh 2
2313 put_ bh ab
2314 put_ bh (IfaceTuple ac ad) = do
2315 putByte bh 3
2316 put_ bh ac
2317 put_ bh ad
2318 put_ bh (IfaceLam (ae, os) af) = do
2319 putByte bh 4
2320 put_ bh ae
2321 put_ bh os
2322 put_ bh af
2323 put_ bh (IfaceApp ag ah) = do
2324 putByte bh 5
2325 put_ bh ag
2326 put_ bh ah
2327 put_ bh (IfaceCase ai aj ak) = do
2328 putByte bh 6
2329 put_ bh ai
2330 put_ bh aj
2331 put_ bh ak
2332 put_ bh (IfaceLet al am) = do
2333 putByte bh 7
2334 put_ bh al
2335 put_ bh am
2336 put_ bh (IfaceTick an ao) = do
2337 putByte bh 8
2338 put_ bh an
2339 put_ bh ao
2340 put_ bh (IfaceLit ap) = do
2341 putByte bh 9
2342 put_ bh ap
2343 put_ bh (IfaceFCall as at) = do
2344 putByte bh 10
2345 put_ bh as
2346 put_ bh at
2347 put_ bh (IfaceExt aa) = do
2348 putByte bh 11
2349 put_ bh aa
2350 put_ bh (IfaceCast ie ico) = do
2351 putByte bh 12
2352 put_ bh ie
2353 put_ bh ico
2354 put_ bh (IfaceECase a b) = do
2355 putByte bh 13
2356 put_ bh a
2357 put_ bh b
2358 put_ bh (IfaceLitRubbish r) = do
2359 putByte bh 14
2360 put_ bh r
2361 get bh = do
2362 h <- getByte bh
2363 case h of
2364 0 -> do aa <- get bh
2365 return (IfaceLcl aa)
2366 1 -> do ab <- get bh
2367 return (IfaceType ab)
2368 2 -> do ab <- get bh
2369 return (IfaceCo ab)
2370 3 -> do ac <- get bh
2371 ad <- get bh
2372 return (IfaceTuple ac ad)
2373 4 -> do ae <- get bh
2374 os <- get bh
2375 af <- get bh
2376 return (IfaceLam (ae, os) af)
2377 5 -> do ag <- get bh
2378 ah <- get bh
2379 return (IfaceApp ag ah)
2380 6 -> do ai <- get bh
2381 aj <- get bh
2382 ak <- get bh
2383 return (IfaceCase ai aj ak)
2384 7 -> do al <- get bh
2385 am <- get bh
2386 return (IfaceLet al am)
2387 8 -> do an <- get bh
2388 ao <- get bh
2389 return (IfaceTick an ao)
2390 9 -> do ap <- get bh
2391 return (IfaceLit ap)
2392 10 -> do as <- get bh
2393 at <- get bh
2394 return (IfaceFCall as at)
2395 11 -> do aa <- get bh
2396 return (IfaceExt aa)
2397 12 -> do ie <- get bh
2398 ico <- get bh
2399 return (IfaceCast ie ico)
2400 13 -> do a <- get bh
2401 b <- get bh
2402 return (IfaceECase a b)
2403 14 -> do r <- get bh
2404 return (IfaceLitRubbish r)
2405 _ -> panic ("get IfaceExpr " ++ show h)
2406
2407 instance Binary IfaceTickish where
2408 put_ bh (IfaceHpcTick m ix) = do
2409 putByte bh 0
2410 put_ bh m
2411 put_ bh ix
2412 put_ bh (IfaceSCC cc tick push) = do
2413 putByte bh 1
2414 put_ bh cc
2415 put_ bh tick
2416 put_ bh push
2417 put_ bh (IfaceSource src name) = do
2418 putByte bh 2
2419 put_ bh (srcSpanFile src)
2420 put_ bh (srcSpanStartLine src)
2421 put_ bh (srcSpanStartCol src)
2422 put_ bh (srcSpanEndLine src)
2423 put_ bh (srcSpanEndCol src)
2424 put_ bh name
2425
2426 get bh = do
2427 h <- getByte bh
2428 case h of
2429 0 -> do m <- get bh
2430 ix <- get bh
2431 return (IfaceHpcTick m ix)
2432 1 -> do cc <- get bh
2433 tick <- get bh
2434 push <- get bh
2435 return (IfaceSCC cc tick push)
2436 2 -> do file <- get bh
2437 sl <- get bh
2438 sc <- get bh
2439 el <- get bh
2440 ec <- get bh
2441 let start = mkRealSrcLoc file sl sc
2442 end = mkRealSrcLoc file el ec
2443 name <- get bh
2444 return (IfaceSource (mkRealSrcSpan start end) name)
2445 _ -> panic ("get IfaceTickish " ++ show h)
2446
2447 instance Binary IfaceConAlt where
2448 put_ bh IfaceDefault = putByte bh 0
2449 put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa
2450 put_ bh (IfaceLitAlt ac) = putByte bh 2 >> put_ bh ac
2451 get bh = do
2452 h <- getByte bh
2453 case h of
2454 0 -> return IfaceDefault
2455 1 -> liftM IfaceDataAlt $ get bh
2456 _ -> liftM IfaceLitAlt $ get bh
2457
2458 instance Binary IfaceBinding where
2459 put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab
2460 put_ bh (IfaceRec ac) = putByte bh 1 >> put_ bh ac
2461 get bh = do
2462 h <- getByte bh
2463 case h of
2464 0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }
2465 _ -> do { ac <- get bh; return (IfaceRec ac) }
2466
2467 instance Binary IfaceLetBndr where
2468 put_ bh (IfLetBndr a b c d) = do
2469 put_ bh a
2470 put_ bh b
2471 put_ bh c
2472 put_ bh d
2473 get bh = do a <- get bh
2474 b <- get bh
2475 c <- get bh
2476 d <- get bh
2477 return (IfLetBndr a b c d)
2478
2479 instance Binary IfaceJoinInfo where
2480 put_ bh IfaceNotJoinPoint = putByte bh 0
2481 put_ bh (IfaceJoinPoint ar) = do
2482 putByte bh 1
2483 put_ bh ar
2484 get bh = do
2485 h <- getByte bh
2486 case h of
2487 0 -> return IfaceNotJoinPoint
2488 _ -> liftM IfaceJoinPoint $ get bh
2489
2490 instance Binary IfaceTyConParent where
2491 put_ bh IfNoParent = putByte bh 0
2492 put_ bh (IfDataInstance ax pr ty) = do
2493 putByte bh 1
2494 put_ bh ax
2495 put_ bh pr
2496 put_ bh ty
2497 get bh = do
2498 h <- getByte bh
2499 case h of
2500 0 -> return IfNoParent
2501 _ -> do
2502 ax <- get bh
2503 pr <- get bh
2504 ty <- get bh
2505 return $ IfDataInstance ax pr ty
2506
2507 instance Binary IfaceCompleteMatch where
2508 put_ bh (IfaceCompleteMatch cs mtc) = put_ bh cs >> put_ bh mtc
2509 get bh = IfaceCompleteMatch <$> get bh <*> get bh
2510
2511
2512 {-
2513 ************************************************************************
2514 * *
2515 NFData instances
2516 See Note [Avoiding space leaks in toIface*] in GHC.CoreToIface
2517 * *
2518 ************************************************************************
2519 -}
2520
2521 instance NFData IfaceDecl where
2522 rnf = \case
2523 IfaceId f1 f2 f3 f4 ->
2524 rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4
2525
2526 IfaceData f1 f2 f3 f4 f5 f6 f7 f8 f9 ->
2527 f1 `seq` seqList f2 `seq` f3 `seq` f4 `seq` f5 `seq`
2528 rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` rnf f9
2529
2530 IfaceSynonym f1 f2 f3 f4 f5 ->
2531 rnf f1 `seq` f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5
2532
2533 IfaceFamily f1 f2 f3 f4 f5 f6 ->
2534 rnf f1 `seq` rnf f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5 `seq` f6 `seq` ()
2535
2536 IfaceClass f1 f2 f3 f4 f5 ->
2537 rnf f1 `seq` f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5
2538
2539 IfaceAxiom nm tycon role ax ->
2540 rnf nm `seq`
2541 rnf tycon `seq`
2542 role `seq`
2543 rnf ax
2544
2545 IfacePatSyn f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 ->
2546 rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` f6 `seq`
2547 rnf f7 `seq` rnf f8 `seq` rnf f9 `seq` rnf f10 `seq` f11 `seq` ()
2548
2549 instance NFData IfaceAxBranch where
2550 rnf (IfaceAxBranch f1 f2 f3 f4 f5 f6 f7) =
2551 rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` rnf f6 `seq` rnf f7
2552
2553 instance NFData IfaceClassBody where
2554 rnf = \case
2555 IfAbstractClass -> ()
2556 IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` ()
2557
2558 instance NFData IfaceAT where
2559 rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2
2560
2561 instance NFData IfaceClassOp where
2562 rnf (IfaceClassOp f1 f2 f3) = rnf f1 `seq` rnf f2 `seq` f3 `seq` ()
2563
2564 instance NFData IfaceTyConParent where
2565 rnf = \case
2566 IfNoParent -> ()
2567 IfDataInstance f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3
2568
2569 instance NFData IfaceConDecls where
2570 rnf = \case
2571 IfAbstractTyCon -> ()
2572 IfDataTyCon f1 -> rnf f1
2573 IfNewTyCon f1 -> rnf f1
2574
2575 instance NFData IfaceConDecl where
2576 rnf (IfCon f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11) =
2577 rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` rnf f6 `seq`
2578 rnf f7 `seq` rnf f8 `seq` f9 `seq` rnf f10 `seq` rnf f11
2579
2580 instance NFData IfaceSrcBang where
2581 rnf (IfSrcBang f1 f2) = f1 `seq` f2 `seq` ()
2582
2583 instance NFData IfaceBang where
2584 rnf x = x `seq` ()
2585
2586 instance NFData IfaceIdDetails where
2587 rnf = \case
2588 IfVanillaId -> ()
2589 IfRecSelId (Left tycon) b -> rnf tycon `seq` rnf b
2590 IfRecSelId (Right decl) b -> rnf decl `seq` rnf b
2591 IfDFunId -> ()
2592
2593 instance NFData IfaceInfoItem where
2594 rnf = \case
2595 HsArity a -> rnf a
2596 HsDmdSig str -> seqDmdSig str
2597 HsInline p -> p `seq` () -- TODO: seq further?
2598 HsUnfold b unf -> rnf b `seq` rnf unf
2599 HsNoCafRefs -> ()
2600 HsLevity -> ()
2601 HsCprSig cpr -> cpr `seq` ()
2602 HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further?
2603
2604 instance NFData IfaceUnfolding where
2605 rnf = \case
2606 IfCoreUnfold inlinable expr ->
2607 rnf inlinable `seq` rnf expr
2608 IfCompulsory expr ->
2609 rnf expr
2610 IfInlineRule arity b1 b2 e ->
2611 rnf arity `seq` rnf b1 `seq` rnf b2 `seq` rnf e
2612 IfDFunUnfold bndrs exprs ->
2613 rnf bndrs `seq` rnf exprs
2614
2615 instance NFData IfaceExpr where
2616 rnf = \case
2617 IfaceLcl nm -> rnf nm
2618 IfaceExt nm -> rnf nm
2619 IfaceType ty -> rnf ty
2620 IfaceCo co -> rnf co
2621 IfaceTuple sort exprs -> sort `seq` rnf exprs
2622 IfaceLam bndr expr -> rnf bndr `seq` rnf expr
2623 IfaceApp e1 e2 -> rnf e1 `seq` rnf e2
2624 IfaceCase e nm alts -> rnf e `seq` nm `seq` rnf alts
2625 IfaceECase e ty -> rnf e `seq` rnf ty
2626 IfaceLet bind e -> rnf bind `seq` rnf e
2627 IfaceCast e co -> rnf e `seq` rnf co
2628 IfaceLit l -> l `seq` () -- FIXME
2629 IfaceLitRubbish r -> rnf r `seq` ()
2630 IfaceFCall fc ty -> fc `seq` rnf ty
2631 IfaceTick tick e -> rnf tick `seq` rnf e
2632
2633 instance NFData IfaceAlt where
2634 rnf (IfaceAlt con bndrs rhs) = rnf con `seq` rnf bndrs `seq` rnf rhs
2635
2636 instance NFData IfaceBinding where
2637 rnf = \case
2638 IfaceNonRec bndr e -> rnf bndr `seq` rnf e
2639 IfaceRec binds -> rnf binds
2640
2641 instance NFData IfaceLetBndr where
2642 rnf (IfLetBndr nm ty id_info join_info) =
2643 rnf nm `seq` rnf ty `seq` rnf id_info `seq` rnf join_info
2644
2645 instance NFData IfaceFamTyConFlav where
2646 rnf = \case
2647 IfaceDataFamilyTyCon -> ()
2648 IfaceOpenSynFamilyTyCon -> ()
2649 IfaceClosedSynFamilyTyCon f1 -> rnf f1
2650 IfaceAbstractClosedSynFamilyTyCon -> ()
2651 IfaceBuiltInSynFamTyCon -> ()
2652
2653 instance NFData IfaceJoinInfo where
2654 rnf x = x `seq` ()
2655
2656 instance NFData IfaceTickish where
2657 rnf = \case
2658 IfaceHpcTick m i -> rnf m `seq` rnf i
2659 IfaceSCC cc b1 b2 -> cc `seq` rnf b1 `seq` rnf b2
2660 IfaceSource src str -> src `seq` rnf str
2661
2662 instance NFData IfaceConAlt where
2663 rnf = \case
2664 IfaceDefault -> ()
2665 IfaceDataAlt nm -> rnf nm
2666 IfaceLitAlt lit -> lit `seq` ()
2667
2668 instance NFData IfaceCompleteMatch where
2669 rnf (IfaceCompleteMatch f1 mtc) = rnf f1 `seq` rnf mtc
2670
2671 instance NFData IfaceRule where
2672 rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) =
2673 rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` f8 `seq` ()
2674
2675 instance NFData IfaceFamInst where
2676 rnf (IfaceFamInst f1 f2 f3 f4) =
2677 rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` ()
2678
2679 instance NFData IfaceClsInst where
2680 rnf (IfaceClsInst f1 f2 f3 f4 f5) =
2681 f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` ()
2682
2683 instance NFData IfaceAnnotation where
2684 rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` ()