2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
8
module IfaceType, -- Re-export all this
10
IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
11
IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
12
IfaceBinding(..), IfaceConAlt(..),
13
IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
14
IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
15
IfaceInst(..), IfaceFamInst(..),
18
ifaceDeclSubBndrs, visibleIfConDecls,
21
freeNamesIfDecl, freeNamesIfRule,
24
pprIfaceExpr, pprIfaceDeclHead
27
#include "HsVersions.h"
49
%************************************************************************
51
Data type declarations
53
%************************************************************************
57
= IfaceId { ifName :: OccName,
59
ifIdDetails :: IfaceIdDetails,
60
ifIdInfo :: IfaceIdInfo }
62
| IfaceData { ifName :: OccName, -- Type constructor
63
ifTyVars :: [IfaceTvBndr], -- Type variables
64
ifCtxt :: IfaceContext, -- The "stupid theta"
65
ifCons :: IfaceConDecls, -- Includes new/data info
66
ifRec :: RecFlag, -- Recursive or not?
67
ifGadtSyntax :: Bool, -- True <=> declared using
69
ifGeneric :: Bool, -- True <=> generic converter
70
-- functions available
71
-- We need this for imported
72
-- data decls, since the
73
-- imported modules may have
75
-- different flags to the
76
-- current compilation unit
77
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
78
-- Just <=> instance of family
80
-- ifCons /= IfOpenDataTyCon
81
-- for family instances
84
| IfaceSyn { ifName :: OccName, -- Type constructor
85
ifTyVars :: [IfaceTvBndr], -- Type variables
86
ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
87
ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
88
-- Nothing for an open family
89
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
90
-- Just <=> instance of family
91
-- Invariant: ifOpenSyn == False
92
-- for family instances
95
| IfaceClass { ifCtxt :: IfaceContext, -- Context...
96
ifName :: OccName, -- Name of the class
97
ifTyVars :: [IfaceTvBndr], -- Type variables
98
ifFDs :: [FunDep FastString], -- Functional dependencies
99
ifATs :: [IfaceDecl], -- Associated type families
100
ifSigs :: [IfaceClassOp], -- Method signatures
101
ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
104
| IfaceForeign { ifName :: OccName, -- Needs expanding when we move
106
ifExtName :: Maybe FastString }
108
data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
109
-- Nothing => no default method
110
-- Just False => ordinary polymorphic default method
111
-- Just True => generic default method
114
= IfAbstractTyCon -- No info
115
| IfOpenDataTyCon -- Open data family
116
| IfDataTyCon [IfaceConDecl] -- data type decls
117
| IfNewTyCon IfaceConDecl -- newtype decls
119
visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
120
visibleIfConDecls IfAbstractTyCon = []
121
visibleIfConDecls IfOpenDataTyCon = []
122
visibleIfConDecls (IfDataTyCon cs) = cs
123
visibleIfConDecls (IfNewTyCon c) = [c]
127
ifConOcc :: OccName, -- Constructor name
128
ifConWrapper :: Bool, -- True <=> has a wrapper
129
ifConInfix :: Bool, -- True <=> declared infix
130
ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars
131
ifConExTvs :: [IfaceTvBndr], -- Existential tyvars
132
ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints
133
ifConCtxt :: IfaceContext, -- Non-stupid context
134
ifConArgTys :: [IfaceType], -- Arg types
135
ifConFields :: [OccName], -- ...ditto... (field labels)
136
ifConStricts :: [HsBang]} -- Empty (meaning all lazy),
137
-- or 1-1 corresp with arg tys
140
= IfaceInst { ifInstCls :: Name, -- See comments with
141
ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
142
ifDFun :: Name, -- The dfun
143
ifOFlag :: OverlapFlag, -- Overlap flag
144
ifInstOrph :: Maybe OccName } -- See Note [Orphans]
145
-- There's always a separate IfaceDecl for the DFun, which gives
146
-- its IdInfo with its full type and version number.
147
-- The instance declarations taken together have a version number,
148
-- and we don't want that to wobble gratuitously
149
-- If this instance decl is *used*, we'll record a usage on the dfun;
150
-- and if the head does not change it won't be used if it wasn't before
153
= IfaceFamInst { ifFamInstFam :: Name -- Family tycon
154
, ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
155
, ifFamInstTyCon :: IfaceTyCon -- Instance decl
160
ifRuleName :: RuleName,
161
ifActivation :: Activation,
162
ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
163
ifRuleHead :: Name, -- Head of lhs
164
ifRuleArgs :: [IfaceExpr], -- Args of LHS
165
ifRuleRhs :: IfaceExpr,
167
ifRuleOrph :: Maybe OccName -- Just like IfaceInst
172
ifAnnotatedTarget :: IfaceAnnTarget,
173
ifAnnotatedValue :: Serialized
176
type IfaceAnnTarget = AnnTarget OccName
178
-- We only serialise the IdDetails of top-level Ids, and even then
179
-- we only need a very limited selection. Notably, none of the
180
-- implicit ones are needed here, becuase they are not put it
185
| IfRecSelId IfaceTyCon Bool
189
= NoInfo -- When writing interface file without -O
190
| HasInfo [IfaceInfoItem] -- Has info, and here it is
192
-- Here's a tricky case:
193
-- * Compile with -O module A, and B which imports A.f
194
-- * Change function f in A, and recompile without -O
195
-- * When we read in old A.hi we read in its IdInfo (as a thunk)
196
-- (In earlier GHCs we used to drop IdInfo immediately on reading,
197
-- but we do not do that now. Instead it's discarded when the
198
-- ModIface is read into the various decl pools.)
199
-- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
200
-- and so gives a new version.
204
| HsStrictness StrictSig
205
| HsInline InlinePragma
206
| HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true
207
IfaceUnfolding -- See Note [Expose recursive functions]
210
-- NB: Specialisations and rules come in separately and are
211
-- only later attached to the Id. Partial reason: some are orphans.
214
= IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
215
-- Possibly could eliminate the Bool here, the information
216
-- is also in the InlinePragma.
218
| IfCompulsory IfaceExpr -- Only used for default methods, in fact
220
| IfInlineRule Arity -- INLINE pragmas
221
Bool -- OK to inline even if *un*-saturated
222
Bool -- OK to inline even if context is boring
225
| IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
226
-- can simplify to a function in another module.
228
| IfDFunUnfold [IfaceExpr]
230
--------------------------------
232
= IfaceLcl FastString
234
| IfaceType IfaceType
235
| IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
236
| IfaceLam IfaceBndr IfaceExpr
237
| IfaceApp IfaceExpr IfaceExpr
238
| IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
239
| IfaceLet IfaceBinding IfaceExpr
240
| IfaceNote IfaceNote IfaceExpr
241
| IfaceCast IfaceExpr IfaceCoercion
243
| IfaceFCall ForeignCall IfaceType
244
| IfaceTick Module Int
246
data IfaceNote = IfaceSCC CostCentre
247
| IfaceCoreNote String
249
type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
250
-- Note: FastString, not IfaceBndr (and same with the case binder)
251
-- We reconstruct the kind/type of the thing from the context
252
-- thus saving bulk in interface files
254
data IfaceConAlt = IfaceDefault
256
| IfaceTupleAlt Boxity
257
| IfaceLitAlt Literal
260
= IfaceNonRec IfaceLetBndr IfaceExpr
261
| IfaceRec [(IfaceLetBndr, IfaceExpr)]
263
-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
264
-- It's used for *non-top-level* let/rec binders
265
-- See Note [IdInfo on nested let-bindings]
266
data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
269
Note [Expose recursive functions]
270
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
271
For supercompilation we want to put *all* unfoldings in the interface
272
file, even for functions that are recursive (or big). So we need to
273
know when an unfolding belongs to a loop-breaker so that we can refrain
274
from inlining it (except during supercompilation).
276
Note [IdInfo on nested let-bindings]
277
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278
Occasionally we want to preserve IdInfo on nested let bindings. The one
279
that came up was a NOINLINE pragma on a let-binding inside an INLINE
280
function. The user (Duncan Coutts) really wanted the NOINLINE control
281
to cross the separate compilation boundary.
283
So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
284
Currently we only actually retain InlinePragInfo, but in principle we could
288
Note [Orphans]: the ifInstOrph and ifRuleOrph fields
289
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
290
If a module contains any "orphans", then its interface file is read
291
regardless, so that its instances are not missed.
293
Roughly speaking, an instance is an orphan if its head (after the =>)
294
mentions nothing defined in this module. Functional dependencies
295
complicate the situation though. Consider
297
module M where { class C a b | a -> b }
299
and suppose we are compiling module X:
304
instance C Int T where ...
306
This instance is an orphan, because when compiling a third module Y we
307
might get a constraint (C Int v), and we'd want to improve v to T. So
308
we must make sure X's instances are loaded, even if we do not directly
311
More precisely, an instance is an orphan iff
313
If there are no fundeps, then at least of the names in
314
the instance head is locally defined.
316
If there are fundeps, then for every fundep, at least one of the
317
names free in a *non-determined* part of the instance head is
318
defined in this module.
320
(Note that these conditions hold trivially if the class is locally
323
Note [Versioning of instances]
324
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
325
Now consider versioning. If we *use* an instance decl in one compilation,
326
we'll depend on the dfun id for that instance, so we'll recompile if it changes.
327
But suppose we *don't* (currently) use an instance! We must recompile if
328
the instance is changed in such a way that it becomes important. (This would
329
only matter with overlapping instances, else the importing module wouldn't have
330
compiled before and the recompilation check is irrelevant.)
332
The is_orph field is set to (Just n) if the instance is not an orphan.
333
The 'n' is *any* of the locally-defined names mentioned anywhere in the
334
instance head. This name is used for versioning; the instance decl is
335
considered part of the defn of this 'n'.
337
I'm worried about whether this works right if we pick a name from
338
a functionally-dependent part of the instance decl. E.g.
340
module M where { class C a b | a -> b }
342
and suppose we are compiling module X:
348
instance C S T where ...
350
If we base the instance verion on T, I'm worried that changing S to S'
351
would change T's version, but not S or S'. But an importing module might
352
not depend on T, and so might not be recompiled even though the new instance
353
(C S' T) might be relevant. I have not been able to make a concrete example,
354
and it seems deeply obscure, so I'm going to leave it for now.
357
Note [Versioning of rules]
358
~~~~~~~~~~~~~~~~~~~~~~~~~~
359
A rule that is not an orphan has an ifRuleOrph field of (Just n), where
360
n appears on the LHS of the rule; any change in the rule changes the version of n.
364
-- -----------------------------------------------------------------------------
367
ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
368
-- *Excludes* the 'main' name, but *includes* the implicitly-bound names
369
-- Deeply revolting, because it has to predict what gets bound,
370
-- especially the question of whether there's a wrapper for a datacon
372
-- N.B. the set of names returned here *must* match the set of
373
-- TyThings returned by HscTypes.implicitTyThings, in the sense that
374
-- TyThing.getOccName should define a bijection between the two lists.
375
-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
376
-- The order of the list does not matter.
377
ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon} = []
380
ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
381
ifCons = IfNewTyCon (
382
IfCon { ifConOcc = con_occ }),
383
ifFamInst = famInst})
384
= -- implicit coerion and (possibly) family instance coercion
385
(mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
386
-- data constructor and worker (newtypes don't have a wrapper)
387
[con_occ, mkDataConWorkerOcc con_occ]
390
ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
391
ifCons = IfDataTyCon cons,
392
ifFamInst = famInst})
393
= -- (possibly) family instance coercion;
394
-- there is no implicit coercion for non-newtypes
395
famInstCo famInst tc_occ
396
-- for each data constructor in order,
397
-- data constructor, worker, and (possibly) wrapper
398
++ concatMap dc_occs cons
401
| has_wrapper = [con_occ, work_occ, wrap_occ]
402
| otherwise = [con_occ, work_occ]
404
con_occ = ifConOcc con_decl -- DataCon namespace
405
wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace
406
work_occ = mkDataConWorkerOcc con_occ -- Id namespace
407
has_wrapper = ifConWrapper con_decl -- This is the reason for
408
-- having the ifConWrapper field!
410
ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
411
ifSigs = sigs, ifATs = ats })
412
= -- dictionary datatype:
415
-- (possibly) newtype coercion
417
-- data constructor (DataCon namespace)
418
-- data worker (Id namespace)
419
-- no wrapper (class dictionaries never have a wrapper)
420
[dc_occ, dcww_occ] ++
422
[ifName at | at <- ats ] ++
423
-- superclass selectors
424
[mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] ++
425
-- operation selectors
426
[op | IfaceClassOp op _ _ <- sigs]
428
n_ctxt = length sc_ctxt
430
tc_occ = mkClassTyConOcc cls_occ
431
dc_occ = mkClassDataConOcc cls_occ
432
co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
434
dcww_occ = mkDataConWorkerOcc dc_occ
435
is_newtype = n_sigs + n_ctxt == 1 -- Sigh
437
ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
438
ifFamInst = famInst})
439
= famInstCo famInst tc_occ
441
ifaceDeclSubBndrs _ = []
443
-- coercion for data/newtype family instances
444
famInstCo :: Maybe (IfaceTyCon, [IfaceType]) -> OccName -> [OccName]
445
famInstCo Nothing _ = []
446
famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
448
----------------------------- Printing IfaceDecl ------------------------------
450
instance Outputable IfaceDecl where
453
pprIfaceDecl :: IfaceDecl -> SDoc
454
pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
455
ifIdDetails = details, ifIdInfo = info})
456
= sep [ ppr var <+> dcolon <+> ppr ty,
457
nest 2 (ppr details),
460
pprIfaceDecl (IfaceForeign {ifName = tycon})
461
= hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
463
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
464
ifSynRhs = Just mono_ty,
465
ifFamInst = mbFamInst})
466
= hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
467
4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
469
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
470
ifSynRhs = Nothing, ifSynKind = kind })
471
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
472
4 (dcolon <+> ppr kind)
474
pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
475
ifTyVars = tyvars, ifCons = condecls,
476
ifRec = isrec, ifFamInst = mbFamInst})
477
= hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
478
4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
479
pprFamily mbFamInst])
481
pp_nd = case condecls of
482
IfAbstractTyCon -> ptext (sLit "data")
483
IfOpenDataTyCon -> ptext (sLit "data family")
484
IfDataTyCon _ -> ptext (sLit "data")
485
IfNewTyCon _ -> ptext (sLit "newtype")
487
pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
488
ifFDs = fds, ifATs = ats, ifSigs = sigs,
490
= hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
491
4 (vcat [pprRec isrec,
495
pprRec :: RecFlag -> SDoc
496
pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
498
pprGen :: Bool -> SDoc
499
pprGen True = ptext (sLit "Generics: yes")
500
pprGen False = ptext (sLit "Generics: no")
502
pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
503
pprFamily Nothing = ptext (sLit "FamilyInstance: none")
504
pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
506
instance Outputable IfaceClassOp where
507
ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
509
pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
510
pprIfaceDeclHead context thing tyvars
511
= hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
512
pprIfaceTvBndrs tyvars]
514
pp_condecls :: OccName -> IfaceConDecls -> SDoc
515
pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}")
516
pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
517
pp_condecls _ IfOpenDataTyCon = empty
518
pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
519
(map (pprIfaceConDecl tc) cs))
521
pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
523
(IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
524
ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
525
ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
526
ifConStricts = strs, ifConFields = fields })
528
if is_infix then ptext (sLit "Infix") else empty,
529
if has_wrap then ptext (sLit "HasWrapper") else empty,
530
ppUnless (null strs) $
531
nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
532
ppUnless (null fields) $
533
nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
535
ppr_bang HsNoBang = char '_' -- Want to see these
536
ppr_bang bang = ppr bang
538
main_payload = ppr name <+> dcolon <+>
539
pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
541
eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
542
| (tv,ty) <- eq_spec]
544
-- A bit gruesome this, but we can't form the full con_tau, and ppr it,
545
-- because we don't have a Name for the tycon, only an OccName
546
pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
547
(t:ts) -> fsep (t : map (arrow <+>) ts)
548
[] -> panic "pp_con_taus"
550
pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
552
instance Outputable IfaceRule where
553
ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
554
ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
555
= sep [hsep [doubleQuotes (ftext name), ppr act,
556
ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
557
nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
558
ptext (sLit "=") <+> ppr rhs])
561
instance Outputable IfaceInst where
562
ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
563
ifInstCls = cls, ifInstTys = mb_tcs})
564
= hang (ptext (sLit "instance") <+> ppr flag
565
<+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
566
2 (equals <+> ppr dfun_id)
568
instance Outputable IfaceFamInst where
569
ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
570
ifFamInstTyCon = tycon_id})
571
= hang (ptext (sLit "family instance") <+>
572
ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
573
2 (equals <+> ppr tycon_id)
575
ppr_rough :: Maybe IfaceTyCon -> SDoc
576
ppr_rough Nothing = dot
577
ppr_rough (Just tc) = ppr tc
581
----------------------------- Printing IfaceExpr ------------------------------------
584
instance Outputable IfaceExpr where
585
ppr e = pprIfaceExpr noParens e
587
pprParendIfaceExpr :: IfaceExpr -> SDoc
588
pprParendIfaceExpr = pprIfaceExpr parens
590
pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
591
-- The function adds parens in context that need
592
-- an atomic value (e.g. function args)
594
pprIfaceExpr _ (IfaceLcl v) = ppr v
595
pprIfaceExpr _ (IfaceExt v) = ppr v
596
pprIfaceExpr _ (IfaceLit l) = ppr l
597
pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
598
pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
599
pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
601
pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
602
pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
604
pprIfaceExpr add_par e@(IfaceLam _ _)
605
= add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
606
pprIfaceExpr noParens body])
608
(bndrs,body) = collect [] e
609
collect bs (IfaceLam b e) = collect (b:bs) e
610
collect bs e = (reverse bs, e)
612
pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
613
= add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
614
<+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
615
<+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
616
pprIfaceExpr noParens rhs <+> char '}'])
618
pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
619
= add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
620
<+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
621
<+> ppr bndr <+> char '{',
622
nest 2 (sep (map ppr_alt alts)) <+> char '}'])
624
pprIfaceExpr _ (IfaceCast expr co)
625
= sep [pprParendIfaceExpr expr,
626
nest 2 (ptext (sLit "`cast`")),
627
pprParendIfaceType co]
629
pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
630
= add_par (sep [ptext (sLit "let {"),
631
nest 2 (ppr_bind (b, rhs)),
633
pprIfaceExpr noParens body])
635
pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
636
= add_par (sep [ptext (sLit "letrec {"),
637
nest 2 (sep (map ppr_bind pairs)),
639
pprIfaceExpr noParens body])
641
pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
643
ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
644
ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
645
arrow <+> pprIfaceExpr noParens rhs]
647
ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
648
ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
649
ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
651
ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
652
ppr_bind (IfLetBndr b ty info, rhs)
653
= sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
654
equals <+> pprIfaceExpr noParens rhs]
657
pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
658
pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
659
pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
662
instance Outputable IfaceNote where
663
ppr (IfaceSCC cc) = pprCostCentreCore cc
664
ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
667
instance Outputable IfaceConAlt where
668
ppr IfaceDefault = text "DEFAULT"
669
ppr (IfaceLitAlt l) = ppr l
670
ppr (IfaceDataAlt d) = ppr d
671
ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"
672
-- IfaceTupleAlt is handled by the case-alternative printer
675
instance Outputable IfaceIdDetails where
676
ppr IfVanillaId = empty
677
ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
678
<+> if b then ptext (sLit "<naughty>") else empty
679
ppr IfDFunId = ptext (sLit "DFunId")
681
instance Outputable IfaceIdInfo where
683
ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
685
instance Outputable IfaceInfoItem where
686
ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
688
ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
689
ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
690
ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
691
ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
693
instance Outputable IfaceUnfolding where
694
ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
695
ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
696
ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
697
pprParendIfaceExpr e]
698
ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr
699
<+> parens (ptext (sLit "arity") <+> int a)
700
ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
701
<+> brackets (pprWithCommas pprParendIfaceExpr ns)
704
-- -----------------------------------------------------------------------------
705
-- Finding the Names in IfaceSyn
707
-- This is used for dependency analysis in MkIface, so that we
708
-- fingerprint a declaration before the things that depend on it. It
709
-- is specific to interface-file fingerprinting in the sense that we
710
-- don't collect *all* Names: for example, the DFun of an instance is
711
-- recorded textually rather than by its fingerprint when
712
-- fingerprinting the instance, so DFuns are not dependencies.
714
freeNamesIfDecl :: IfaceDecl -> NameSet
715
freeNamesIfDecl (IfaceId _s t d i) =
716
freeNamesIfType t &&&
717
freeNamesIfIdInfo i &&&
718
freeNamesIfIdDetails d
719
freeNamesIfDecl IfaceForeign{} =
721
freeNamesIfDecl d@IfaceData{} =
722
freeNamesIfTvBndrs (ifTyVars d) &&&
723
freeNamesIfTcFam (ifFamInst d) &&&
724
freeNamesIfContext (ifCtxt d) &&&
725
freeNamesIfConDecls (ifCons d)
726
freeNamesIfDecl d@IfaceSyn{} =
727
freeNamesIfTvBndrs (ifTyVars d) &&&
728
freeNamesIfSynRhs (ifSynRhs d) &&&
729
freeNamesIfTcFam (ifFamInst d)
730
freeNamesIfDecl d@IfaceClass{} =
731
freeNamesIfTvBndrs (ifTyVars d) &&&
732
freeNamesIfContext (ifCtxt d) &&&
733
freeNamesIfDecls (ifATs d) &&&
734
fnList freeNamesIfClsSig (ifSigs d)
736
freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
737
freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
738
freeNamesIfIdDetails _ = emptyNameSet
740
-- All other changes are handled via the version info on the tycon
741
freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
742
freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
743
freeNamesIfSynRhs Nothing = emptyNameSet
745
freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
746
freeNamesIfTcFam (Just (tc,tys)) =
747
freeNamesIfTc tc &&& fnList freeNamesIfType tys
748
freeNamesIfTcFam Nothing =
751
freeNamesIfContext :: IfaceContext -> NameSet
752
freeNamesIfContext = fnList freeNamesIfPredType
754
freeNamesIfDecls :: [IfaceDecl] -> NameSet
755
freeNamesIfDecls = fnList freeNamesIfDecl
757
freeNamesIfClsSig :: IfaceClassOp -> NameSet
758
freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
760
freeNamesIfConDecls :: IfaceConDecls -> NameSet
761
freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
762
freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
763
freeNamesIfConDecls _ = emptyNameSet
765
freeNamesIfConDecl :: IfaceConDecl -> NameSet
766
freeNamesIfConDecl c =
767
freeNamesIfTvBndrs (ifConUnivTvs c) &&&
768
freeNamesIfTvBndrs (ifConExTvs c) &&&
769
freeNamesIfContext (ifConCtxt c) &&&
770
fnList freeNamesIfType (ifConArgTys c) &&&
771
fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
773
freeNamesIfPredType :: IfacePredType -> NameSet
774
freeNamesIfPredType (IfaceClassP cl tys) =
775
unitNameSet cl &&& fnList freeNamesIfType tys
776
freeNamesIfPredType (IfaceIParam _n ty) =
778
freeNamesIfPredType (IfaceEqPred ty1 ty2) =
779
freeNamesIfType ty1 &&& freeNamesIfType ty2
781
freeNamesIfType :: IfaceType -> NameSet
782
freeNamesIfType (IfaceTyVar _) = emptyNameSet
783
freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
784
freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
785
freeNamesIfType (IfaceTyConApp tc ts) =
786
freeNamesIfTc tc &&& fnList freeNamesIfType ts
787
freeNamesIfType (IfaceForAllTy tv t) =
788
freeNamesIfTvBndr tv &&& freeNamesIfType t
789
freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
791
freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
792
freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
794
freeNamesIfBndr :: IfaceBndr -> NameSet
795
freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
796
freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
798
freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
799
-- Remember IfaceLetBndr is used only for *nested* bindings
800
-- The cut-down IdInfo never contains any Names, but the type may!
801
freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
803
freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
804
freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
805
-- kinds can have Names inside, when the Kind is an equality predicate
807
freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
808
freeNamesIfIdBndr = freeNamesIfTvBndr
810
freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
811
freeNamesIfIdInfo NoInfo = emptyNameSet
812
freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
814
freeNamesItem :: IfaceInfoItem -> NameSet
815
freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
816
freeNamesItem _ = emptyNameSet
818
freeNamesIfUnfold :: IfaceUnfolding -> NameSet
819
freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
820
freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
821
freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
822
freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
823
freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
825
freeNamesIfExpr :: IfaceExpr -> NameSet
826
freeNamesIfExpr (IfaceExt v) = unitNameSet v
827
freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
828
freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
829
freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
830
freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
831
freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
832
freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
833
freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
835
freeNamesIfExpr (IfaceCase s _ ty alts)
837
&&& fnList fn_alt alts &&& fn_cons alts
838
&&& freeNamesIfType ty
840
fn_alt (_con,_bs,r) = freeNamesIfExpr r
842
-- Depend on the data constructors. Just one will do!
843
-- Note [Tracking data constructors]
844
fn_cons [] = emptyNameSet
845
fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts
846
fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
847
fn_cons (_ : _ ) = emptyNameSet
849
freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
850
= freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
852
freeNamesIfExpr (IfaceLet (IfaceRec as) x)
853
= fnList fn_pair as &&& freeNamesIfExpr x
855
fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
857
freeNamesIfExpr _ = emptyNameSet
860
freeNamesIfTc :: IfaceTyCon -> NameSet
861
freeNamesIfTc (IfaceTc tc) = unitNameSet tc
862
-- ToDo: shouldn't we include IfaceIntTc & co.?
863
freeNamesIfTc _ = emptyNameSet
865
freeNamesIfRule :: IfaceRule -> NameSet
866
freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
867
, ifRuleArgs = es, ifRuleRhs = rhs })
869
fnList freeNamesIfBndr bs &&&
870
fnList freeNamesIfExpr es &&&
874
(&&&) :: NameSet -> NameSet -> NameSet
875
(&&&) = unionNameSets
877
fnList :: (a -> NameSet) -> [a] -> NameSet
878
fnList f = foldr (&&&) emptyNameSet . map f
881
Note [Tracking data constructors]
882
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
884
case e of { C a -> ...; ... }
885
You might think that we don't need to include the datacon C
886
in the free names, because its type will probably show up in
887
the free names of 'e'. But in rare circumstances this may
888
not happen. Here's the one that bit me:
890
module DynFlags where
891
import {-# SOURCE #-} Packages( PackageState )
892
data DynFlags = DF ... PackageState ...
894
module Packages where
896
data PackageState = PS ...
897
lookupModule (df :: DynFlags)
899
DF ...p... -> case p of
902
Now, lookupModule depends on DynFlags, but the transitive dependency
903
on the *locally-defined* type PackageState is not visible. We need
904
to take account of the use of the data constructor PS in the pattern match.
added
removed
compiler/iface/IfaceSyn.lhs
