Smarter HsType pretty-print for promoted datacons
[ghc.git] / compiler / basicTypes / IdInfo.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4
5 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
6
7 (And a pretty good illustration of quite a few things wrong with
8 Haskell. [WDP 94/11])
9 -}
10
11 {-# LANGUAGE CPP #-}
12 {-# LANGUAGE FlexibleContexts #-}
13
14 module IdInfo (
15 -- * The IdDetails type
16 IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,
17 JoinArity, isJoinIdDetails_maybe,
18 RecSelParent(..),
19
20 -- * The IdInfo type
21 IdInfo, -- Abstract
22 vanillaIdInfo, noCafIdInfo,
23
24 -- ** The OneShotInfo type
25 OneShotInfo(..),
26 oneShotInfo, noOneShotInfo, hasNoOneShotInfo,
27 setOneShotInfo,
28
29 -- ** Zapping various forms of Info
30 zapLamInfo, zapFragileInfo,
31 zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,
32 zapTailCallInfo, zapCallArityInfo, zapUnfolding,
33
34 -- ** The ArityInfo type
35 ArityInfo,
36 unknownArity,
37 arityInfo, setArityInfo, ppArityInfo,
38
39 callArityInfo, setCallArityInfo,
40
41 -- ** Demand and strictness Info
42 strictnessInfo, setStrictnessInfo,
43 demandInfo, setDemandInfo, pprStrictness,
44
45 -- ** Unfolding Info
46 unfoldingInfo, setUnfoldingInfo,
47
48 -- ** The InlinePragInfo type
49 InlinePragInfo,
50 inlinePragInfo, setInlinePragInfo,
51
52 -- ** The OccInfo type
53 OccInfo(..),
54 isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
55 occInfo, setOccInfo,
56
57 InsideLam, OneBranch,
58 insideLam, notInsideLam, oneBranch, notOneBranch,
59
60 TailCallInfo(..),
61 tailCallInfo, isAlwaysTailCalled,
62
63 -- ** The RuleInfo type
64 RuleInfo(..),
65 emptyRuleInfo,
66 isEmptyRuleInfo, ruleInfoFreeVars,
67 ruleInfoRules, setRuleInfoHead,
68 ruleInfo, setRuleInfo,
69
70 -- ** The CAFInfo type
71 CafInfo(..),
72 ppCafInfo, mayHaveCafRefs,
73 cafInfo, setCafInfo,
74
75 -- ** Tick-box Info
76 TickBoxOp(..), TickBoxId,
77
78 -- ** Levity info
79 LevityInfo, levityInfo, setNeverLevPoly, setLevityInfoWithType,
80 isNeverLevPolyIdInfo
81 ) where
82
83 #include "HsVersions.h"
84
85 import GhcPrelude
86
87 import CoreSyn
88
89 import Class
90 import {-# SOURCE #-} PrimOp (PrimOp)
91 import Name
92 import VarSet
93 import BasicTypes
94 import DataCon
95 import TyCon
96 import PatSyn
97 import Type
98 import ForeignCall
99 import Outputable
100 import Module
101 import Demand
102 import Util
103
104 -- infixl so you can say (id `set` a `set` b)
105 infixl 1 `setRuleInfo`,
106 `setArityInfo`,
107 `setInlinePragInfo`,
108 `setUnfoldingInfo`,
109 `setOneShotInfo`,
110 `setOccInfo`,
111 `setCafInfo`,
112 `setStrictnessInfo`,
113 `setDemandInfo`,
114 `setNeverLevPoly`,
115 `setLevityInfoWithType`
116
117 {-
118 ************************************************************************
119 * *
120 IdDetails
121 * *
122 ************************************************************************
123 -}
124
125 -- | Identifier Details
126 --
127 -- The 'IdDetails' of an 'Id' give stable, and necessary,
128 -- information about the Id.
129 data IdDetails
130 = VanillaId
131
132 -- | The 'Id' for a record selector
133 | RecSelId
134 { sel_tycon :: RecSelParent
135 , sel_naughty :: Bool -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
136 -- data T = forall a. MkT { x :: a }
137 } -- See Note [Naughty record selectors] in TcTyClsDecls
138
139 | DataConWorkId DataCon -- ^ The 'Id' is for a data constructor /worker/
140 | DataConWrapId DataCon -- ^ The 'Id' is for a data constructor /wrapper/
141
142 -- [the only reasons we need to know is so that
143 -- a) to support isImplicitId
144 -- b) when desugaring a RecordCon we can get
145 -- from the Id back to the data con]
146 | ClassOpId Class -- ^ The 'Id' is a superclass selector,
147 -- or class operation of a class
148
149 | PrimOpId PrimOp -- ^ The 'Id' is for a primitive operator
150 | FCallId ForeignCall -- ^ The 'Id' is for a foreign call.
151 -- Type will be simple: no type families, newtypes, etc
152
153 | TickBoxOpId TickBoxOp -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
154
155 | DFunId Bool -- ^ A dictionary function.
156 -- Bool = True <=> the class has only one method, so may be
157 -- implemented with a newtype, so it might be bad
158 -- to be strict on this dictionary
159
160 | CoVarId -- ^ A coercion variable
161 -- This only covers /un-lifted/ coercions, of type
162 -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants
163 | JoinId JoinArity -- ^ An 'Id' for a join point taking n arguments
164 -- Note [Join points] in CoreSyn
165
166 -- | Recursive Selector Parent
167 data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving Eq
168 -- Either `TyCon` or `PatSyn` depending
169 -- on the origin of the record selector.
170 -- For a data type family, this is the
171 -- /instance/ 'TyCon' not the family 'TyCon'
172
173 instance Outputable RecSelParent where
174 ppr p = case p of
175 RecSelData ty_con -> ppr ty_con
176 RecSelPatSyn ps -> ppr ps
177
178 -- | Just a synonym for 'CoVarId'. Written separately so it can be
179 -- exported in the hs-boot file.
180 coVarDetails :: IdDetails
181 coVarDetails = CoVarId
182
183 -- | Check if an 'IdDetails' says 'CoVarId'.
184 isCoVarDetails :: IdDetails -> Bool
185 isCoVarDetails CoVarId = True
186 isCoVarDetails _ = False
187
188 isJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity
189 isJoinIdDetails_maybe (JoinId join_arity) = Just join_arity
190 isJoinIdDetails_maybe _ = Nothing
191
192 instance Outputable IdDetails where
193 ppr = pprIdDetails
194
195 pprIdDetails :: IdDetails -> SDoc
196 pprIdDetails VanillaId = empty
197 pprIdDetails other = brackets (pp other)
198 where
199 pp VanillaId = panic "pprIdDetails"
200 pp (DataConWorkId _) = text "DataCon"
201 pp (DataConWrapId _) = text "DataConWrapper"
202 pp (ClassOpId {}) = text "ClassOp"
203 pp (PrimOpId _) = text "PrimOp"
204 pp (FCallId _) = text "ForeignCall"
205 pp (TickBoxOpId _) = text "TickBoxOp"
206 pp (DFunId nt) = text "DFunId" <> ppWhen nt (text "(nt)")
207 pp (RecSelId { sel_naughty = is_naughty })
208 = brackets $ text "RecSel" <>
209 ppWhen is_naughty (text "(naughty)")
210 pp CoVarId = text "CoVarId"
211 pp (JoinId arity) = text "JoinId" <> parens (int arity)
212
213 {-
214 ************************************************************************
215 * *
216 \subsection{The main IdInfo type}
217 * *
218 ************************************************************************
219 -}
220
221 -- | Identifier Information
222 --
223 -- An 'IdInfo' gives /optional/ information about an 'Id'. If
224 -- present it never lies, but it may not be present, in which case there
225 -- is always a conservative assumption which can be made.
226 --
227 -- Two 'Id's may have different info even though they have the same
228 -- 'Unique' (and are hence the same 'Id'); for example, one might lack
229 -- the properties attached to the other.
230 --
231 -- Most of the 'IdInfo' gives information about the value, or definition, of
232 -- the 'Id', independent of its usage. Exceptions to this
233 -- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'.
234 --
235 -- Performance note: when we update 'IdInfo', we have to reallocate this
236 -- entire record, so it is a good idea not to let this data structure get
237 -- too big.
238 data IdInfo
239 = IdInfo {
240 arityInfo :: !ArityInfo, -- ^ 'Id' arity
241 ruleInfo :: RuleInfo, -- ^ Specialisations of the 'Id's function which exist
242 -- See Note [Specialisations and RULES in IdInfo]
243 unfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding
244 cafInfo :: CafInfo, -- ^ 'Id' CAF info
245 oneShotInfo :: OneShotInfo, -- ^ Info about a lambda-bound variable, if the 'Id' is one
246 inlinePragInfo :: InlinePragma, -- ^ Any inline pragma atached to the 'Id'
247 occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program
248
249 strictnessInfo :: StrictSig, -- ^ A strictness signature
250
251 demandInfo :: Demand, -- ^ ID demand information
252 callArityInfo :: !ArityInfo, -- ^ How this is called.
253 -- n <=> all calls have at least n arguments
254
255 levityInfo :: LevityInfo -- ^ when applied, will this Id ever have a levity-polymorphic type?
256 }
257
258 -- Setters
259
260 setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
261 setRuleInfo info sp = sp `seq` info { ruleInfo = sp }
262 setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
263 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
264 setOccInfo :: IdInfo -> OccInfo -> IdInfo
265 setOccInfo info oc = oc `seq` info { occInfo = oc }
266 -- Try to avoid space leaks by seq'ing
267
268 setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
269 setUnfoldingInfo info uf
270 = -- We don't seq the unfolding, as we generate intermediate
271 -- unfoldings which are just thrown away, so evaluating them is a
272 -- waste of time.
273 -- seqUnfolding uf `seq`
274 info { unfoldingInfo = uf }
275
276 setArityInfo :: IdInfo -> ArityInfo -> IdInfo
277 setArityInfo info ar = info { arityInfo = ar }
278 setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
279 setCallArityInfo info ar = info { callArityInfo = ar }
280 setCafInfo :: IdInfo -> CafInfo -> IdInfo
281 setCafInfo info caf = info { cafInfo = caf }
282
283 setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
284 setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb }
285
286 setDemandInfo :: IdInfo -> Demand -> IdInfo
287 setDemandInfo info dd = dd `seq` info { demandInfo = dd }
288
289 setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
290 setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
291
292 -- | Basic 'IdInfo' that carries no useful information whatsoever
293 vanillaIdInfo :: IdInfo
294 vanillaIdInfo
295 = IdInfo {
296 cafInfo = vanillaCafInfo,
297 arityInfo = unknownArity,
298 ruleInfo = emptyRuleInfo,
299 unfoldingInfo = noUnfolding,
300 oneShotInfo = NoOneShotInfo,
301 inlinePragInfo = defaultInlinePragma,
302 occInfo = noOccInfo,
303 demandInfo = topDmd,
304 strictnessInfo = nopSig,
305 callArityInfo = unknownArity,
306 levityInfo = NoLevityInfo
307 }
308
309 -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
310 noCafIdInfo :: IdInfo
311 noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs
312 -- Used for built-in type Ids in MkId.
313
314 {-
315 ************************************************************************
316 * *
317 \subsection[arity-IdInfo]{Arity info about an @Id@}
318 * *
319 ************************************************************************
320
321 For locally-defined Ids, the code generator maintains its own notion
322 of their arities; so it should not be asking... (but other things
323 besides the code-generator need arity info!)
324 -}
325
326 -- | Arity Information
327 --
328 -- An 'ArityInfo' of @n@ tells us that partial application of this
329 -- 'Id' to up to @n-1@ value arguments does essentially no work.
330 --
331 -- That is not necessarily the same as saying that it has @n@ leading
332 -- lambdas, because coerces may get in the way.
333 --
334 -- The arity might increase later in the compilation process, if
335 -- an extra lambda floats up to the binding site.
336 type ArityInfo = Arity
337
338 -- | It is always safe to assume that an 'Id' has an arity of 0
339 unknownArity :: Arity
340 unknownArity = 0
341
342 ppArityInfo :: Int -> SDoc
343 ppArityInfo 0 = empty
344 ppArityInfo n = hsep [text "Arity", int n]
345
346 {-
347 ************************************************************************
348 * *
349 \subsection{Inline-pragma information}
350 * *
351 ************************************************************************
352 -}
353
354 -- | Inline Pragma Information
355 --
356 -- Tells when the inlining is active.
357 -- When it is active the thing may be inlined, depending on how
358 -- big it is.
359 --
360 -- If there was an @INLINE@ pragma, then as a separate matter, the
361 -- RHS will have been made to look small with a Core inline 'Note'
362 --
363 -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
364 -- entirely as a way to inhibit inlining until we want it
365 type InlinePragInfo = InlinePragma
366
367 {-
368 ************************************************************************
369 * *
370 Strictness
371 * *
372 ************************************************************************
373 -}
374
375 pprStrictness :: StrictSig -> SDoc
376 pprStrictness sig = ppr sig
377
378 {-
379 ************************************************************************
380 * *
381 RuleInfo
382 * *
383 ************************************************************************
384
385 Note [Specialisations and RULES in IdInfo]
386 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
387 Generally speaking, a GlobalId has an *empty* RuleInfo. All their
388 RULES are contained in the globally-built rule-base. In principle,
389 one could attach the to M.f the RULES for M.f that are defined in M.
390 But we don't do that for instance declarations and so we just treat
391 them all uniformly.
392
393 The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
394 jsut for convenience really.
395
396 However, LocalIds may have non-empty RuleInfo. We treat them
397 differently because:
398 a) they might be nested, in which case a global table won't work
399 b) the RULE might mention free variables, which we use to keep things alive
400
401 In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off
402 and put in the global list.
403 -}
404
405 -- | Rule Information
406 --
407 -- Records the specializations of this 'Id' that we know about
408 -- in the form of rewrite 'CoreRule's that target them
409 data RuleInfo
410 = RuleInfo
411 [CoreRule]
412 DVarSet -- Locally-defined free vars of *both* LHS and RHS
413 -- of rules. I don't think it needs to include the
414 -- ru_fn though.
415 -- Note [Rule dependency info] in OccurAnal
416
417 -- | Assume that no specilizations exist: always safe
418 emptyRuleInfo :: RuleInfo
419 emptyRuleInfo = RuleInfo [] emptyDVarSet
420
421 isEmptyRuleInfo :: RuleInfo -> Bool
422 isEmptyRuleInfo (RuleInfo rs _) = null rs
423
424 -- | Retrieve the locally-defined free variables of both the left and
425 -- right hand sides of the specialization rules
426 ruleInfoFreeVars :: RuleInfo -> DVarSet
427 ruleInfoFreeVars (RuleInfo _ fvs) = fvs
428
429 ruleInfoRules :: RuleInfo -> [CoreRule]
430 ruleInfoRules (RuleInfo rules _) = rules
431
432 -- | Change the name of the function the rule is keyed on on all of the 'CoreRule's
433 setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
434 setRuleInfoHead fn (RuleInfo rules fvs)
435 = RuleInfo (map (setRuleIdName fn) rules) fvs
436
437 {-
438 ************************************************************************
439 * *
440 \subsection[CG-IdInfo]{Code generator-related information}
441 * *
442 ************************************************************************
443 -}
444
445 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.hs).
446
447 -- | Constant applicative form Information
448 --
449 -- Records whether an 'Id' makes Constant Applicative Form references
450 data CafInfo
451 = MayHaveCafRefs -- ^ Indicates that the 'Id' is for either:
452 --
453 -- 1. A function or static constructor
454 -- that refers to one or more CAFs, or
455 --
456 -- 2. A real live CAF
457
458 | NoCafRefs -- ^ A function or static constructor
459 -- that refers to no CAFs.
460 deriving (Eq, Ord)
461
462 -- | Assumes that the 'Id' has CAF references: definitely safe
463 vanillaCafInfo :: CafInfo
464 vanillaCafInfo = MayHaveCafRefs
465
466 mayHaveCafRefs :: CafInfo -> Bool
467 mayHaveCafRefs MayHaveCafRefs = True
468 mayHaveCafRefs _ = False
469
470 instance Outputable CafInfo where
471 ppr = ppCafInfo
472
473 ppCafInfo :: CafInfo -> SDoc
474 ppCafInfo NoCafRefs = text "NoCafRefs"
475 ppCafInfo MayHaveCafRefs = empty
476
477 {-
478 ************************************************************************
479 * *
480 \subsection{Bulk operations on IdInfo}
481 * *
482 ************************************************************************
483 -}
484
485 -- | This is used to remove information on lambda binders that we have
486 -- setup as part of a lambda group, assuming they will be applied all at once,
487 -- but turn out to be part of an unsaturated lambda as in e.g:
488 --
489 -- > (\x1. \x2. e) arg1
490 zapLamInfo :: IdInfo -> Maybe IdInfo
491 zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
492 | is_safe_occ occ && is_safe_dmd demand
493 = Nothing
494 | otherwise
495 = Just (info {occInfo = safe_occ, demandInfo = topDmd})
496 where
497 -- The "unsafe" occ info is the ones that say I'm not in a lambda
498 -- because that might not be true for an unsaturated lambda
499 is_safe_occ occ | isAlwaysTailCalled occ = False
500 is_safe_occ (OneOcc { occ_in_lam = in_lam }) = in_lam
501 is_safe_occ _other = True
502
503 safe_occ = case occ of
504 OneOcc{} -> occ { occ_in_lam = True
505 , occ_tail = NoTailCallInfo }
506 IAmALoopBreaker{}
507 -> occ { occ_tail = NoTailCallInfo }
508 _other -> occ
509
510 is_safe_dmd dmd = not (isStrictDmd dmd)
511
512 -- | Remove all demand info on the 'IdInfo'
513 zapDemandInfo :: IdInfo -> Maybe IdInfo
514 zapDemandInfo info = Just (info {demandInfo = topDmd})
515
516 -- | Remove usage (but not strictness) info on the 'IdInfo'
517 zapUsageInfo :: IdInfo -> Maybe IdInfo
518 zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})
519
520 -- | Remove usage environment info from the strictness signature on the 'IdInfo'
521 zapUsageEnvInfo :: IdInfo -> Maybe IdInfo
522 zapUsageEnvInfo info
523 | hasDemandEnvSig (strictnessInfo info)
524 = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)})
525 | otherwise
526 = Nothing
527
528 zapUsedOnceInfo :: IdInfo -> Maybe IdInfo
529 zapUsedOnceInfo info
530 = Just $ info { strictnessInfo = zapUsedOnceSig (strictnessInfo info)
531 , demandInfo = zapUsedOnceDemand (demandInfo info) }
532
533 zapFragileInfo :: IdInfo -> Maybe IdInfo
534 -- ^ Zap info that depends on free variables
535 zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf })
536 = new_unf `seq` -- The unfolding field is not (currently) strict, so we
537 -- force it here to avoid a (zapFragileUnfolding unf) thunk
538 -- which might leak space
539 Just (info `setRuleInfo` emptyRuleInfo
540 `setUnfoldingInfo` new_unf
541 `setOccInfo` zapFragileOcc occ)
542 where
543 new_unf = zapFragileUnfolding unf
544
545 zapFragileUnfolding :: Unfolding -> Unfolding
546 zapFragileUnfolding unf
547 | isFragileUnfolding unf = noUnfolding
548 | otherwise = unf
549
550 zapUnfolding :: Unfolding -> Unfolding
551 -- Squash all unfolding info, preserving only evaluated-ness
552 zapUnfolding unf | isEvaldUnfolding unf = evaldUnfolding
553 | otherwise = noUnfolding
554
555 zapTailCallInfo :: IdInfo -> Maybe IdInfo
556 zapTailCallInfo info
557 = case occInfo info of
558 occ | isAlwaysTailCalled occ -> Just (info `setOccInfo` safe_occ)
559 | otherwise -> Nothing
560 where
561 safe_occ = occ { occ_tail = NoTailCallInfo }
562
563 zapCallArityInfo :: IdInfo -> IdInfo
564 zapCallArityInfo info = setCallArityInfo info 0
565
566 {-
567 ************************************************************************
568 * *
569 \subsection{TickBoxOp}
570 * *
571 ************************************************************************
572 -}
573
574 type TickBoxId = Int
575
576 -- | Tick box for Hpc-style coverage
577 data TickBoxOp
578 = TickBox Module {-# UNPACK #-} !TickBoxId
579
580 instance Outputable TickBoxOp where
581 ppr (TickBox mod n) = text "tick" <+> ppr (mod,n)
582
583 {-
584 ************************************************************************
585 * *
586 Levity
587 * *
588 ************************************************************************
589
590 Note [Levity info]
591 ~~~~~~~~~~~~~~~~~~
592
593 Ids store whether or not they can be levity-polymorphic at any amount
594 of saturation. This is helpful in optimizing the levity-polymorphism check
595 done in the desugarer, where we can usually learn that something is not
596 levity-polymorphic without actually figuring out its type. See
597 isExprLevPoly in CoreUtils for where this info is used. Storing
598 this is required to prevent perf/compiler/T5631 from blowing up.
599
600 -}
601
602 -- See Note [Levity info]
603 data LevityInfo = NoLevityInfo -- always safe
604 | NeverLevityPolymorphic
605 deriving Eq
606
607 instance Outputable LevityInfo where
608 ppr NoLevityInfo = text "NoLevityInfo"
609 ppr NeverLevityPolymorphic = text "NeverLevityPolymorphic"
610
611 -- | Marks an IdInfo describing an Id that is never levity polymorphic (even when
612 -- applied). The Type is only there for checking that it's really never levity
613 -- polymorphic
614 setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo
615 setNeverLevPoly info ty
616 = ASSERT2( not (resultIsLevPoly ty), ppr ty )
617 info { levityInfo = NeverLevityPolymorphic }
618
619 setLevityInfoWithType :: IdInfo -> Type -> IdInfo
620 setLevityInfoWithType info ty
621 | not (resultIsLevPoly ty)
622 = info { levityInfo = NeverLevityPolymorphic }
623 | otherwise
624 = info
625
626 isNeverLevPolyIdInfo :: IdInfo -> Bool
627 isNeverLevPolyIdInfo info
628 | NeverLevityPolymorphic <- levityInfo info = True
629 | otherwise = False