never executed always true always false
1 {-# LANGUAGE ViewPatterns #-}
2 {-# LANGUAGE BinaryLiterals #-}
3 {-# LANGUAGE PatternSynonyms #-}
4
5 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
6
7 {-
8 (c) The University of Glasgow 2006
9 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
10 -}
11
12 -- | A language to express the evaluation context of an expression as a
13 -- 'Demand' and track how an expression evaluates free variables and arguments
14 -- in turn as a 'DmdType'.
15 --
16 -- Lays out the abstract domain for "GHC.Core.Opt.DmdAnal".
17 module GHC.Types.Demand (
18 -- * Demands
19 Boxity(..),
20 Card(C_00, C_01, C_0N, C_10, C_11, C_1N), CardNonAbs, CardNonOnce,
21 Demand(AbsDmd, BotDmd, (:*)),
22 SubDemand(Prod, Poly), mkProd, viewProd, unboxSubDemand,
23 -- ** Algebra
24 absDmd, topDmd, botDmd, seqDmd, topSubDmd,
25 -- *** Least upper bound
26 lubCard, lubDmd, lubSubDmd,
27 -- *** Plus
28 plusCard, plusDmd, plusSubDmd,
29 -- *** Multiply
30 multCard, multDmd, multSubDmd,
31 -- ** Predicates on @Card@inalities and @Demand@s
32 isAbs, isUsedOnce, isStrict,
33 isAbsDmd, isUsedOnceDmd, isStrUsedDmd, isStrictDmd,
34 isTopDmd, isWeakDmd,
35 -- ** Special demands
36 evalDmd,
37 -- *** Demands used in PrimOp signatures
38 lazyApply1Dmd, lazyApply2Dmd, strictOnceApply1Dmd, strictManyApply1Dmd,
39 -- ** Other @Demand@ operations
40 oneifyCard, oneifyDmd, strictifyDmd, strictifyDictDmd, mkWorkerDemand,
41 peelCallDmd, peelManyCalls, mkCalledOnceDmd, mkCalledOnceDmds,
42 -- ** Extracting one-shot information
43 argOneShots, argsOneShots, saturatedByOneShots,
44
45 -- * Demand environments
46 DmdEnv, emptyDmdEnv,
47 keepAliveDmdEnv, reuseEnv,
48
49 -- * Divergence
50 Divergence(..), topDiv, botDiv, exnDiv, lubDivergence, isDeadEndDiv,
51
52 -- * Demand types
53 DmdType(..), dmdTypeDepth,
54 -- ** Algebra
55 nopDmdType, botDmdType,
56 lubDmdType, plusDmdType, multDmdType,
57 -- *** PlusDmdArg
58 PlusDmdArg, mkPlusDmdArg, toPlusDmdArg,
59 -- ** Other operations
60 peelFV, findIdDemand, addDemand, splitDmdTy, deferAfterPreciseException,
61 keepAliveDmdType,
62
63 -- * Demand signatures
64 DmdSig(..), mkDmdSigForArity, mkClosedDmdSig,
65 splitDmdSig, dmdSigDmdEnv, hasDemandEnvSig,
66 nopSig, botSig, isTopSig, isDeadEndSig, appIsDeadEnd,
67 -- ** Handling arity adjustments
68 prependArgsDmdSig, etaConvertDmdSig,
69
70 -- * Demand transformers from demand signatures
71 DmdTransformer, dmdTransformSig, dmdTransformDataConSig, dmdTransformDictSelSig,
72
73 -- * Trim to a type shape
74 TypeShape(..), trimToType, trimBoxity,
75
76 -- * @seq@ing stuff
77 seqDemand, seqDemandList, seqDmdType, seqDmdSig,
78
79 -- * Zapping usage information
80 zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig
81 ) where
82
83 import GHC.Prelude
84
85 import GHC.Types.Var ( Var, Id )
86 import GHC.Types.Var.Env
87 import GHC.Types.Var.Set
88 import GHC.Types.Unique.FM
89 import GHC.Types.Basic
90 import GHC.Data.Maybe ( orElse )
91
92 import GHC.Core.Type ( Type )
93 import GHC.Core.TyCon ( isNewTyCon, isClassTyCon )
94 import GHC.Core.DataCon ( splitDataProductType_maybe )
95 import GHC.Core.Multiplicity ( scaledThing )
96
97 import GHC.Utils.Binary
98 import GHC.Utils.Misc
99 import GHC.Utils.Outputable
100 import GHC.Utils.Panic
101 import GHC.Utils.Panic.Plain
102
103 import Data.Function
104
105 import GHC.Utils.Trace
106 _ = pprTrace -- Tired of commenting out the import all the time
107
108 {-
109 ************************************************************************
110 * *
111 Boxity: Whether the box of something is used
112 * *
113 ************************************************************************
114 -}
115
116 {- Note [Strictness and Unboxing]
117 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
118 If an argument is used strictly by the function body, we may use use
119 call-by-value instead of call-by-need for that argument. What's more, we may
120 unbox an argument that is used strictly, discarding the box at the call site.
121 This can reduce allocations of the program drastically if the box really isn't
122 needed in the function body. Here's an example:
123 ```
124 even :: Int -> Bool
125 even (I# 0) = True
126 even (I# 1) = False
127 even (I# n) = even (I# (n -# 2))
128 ```
129 All three code paths of 'even' are (a) strict in the argument, and (b)
130 immediately discard the boxed 'Int'. Now if we have a call site like
131 `even (I# 42)`, then it would be terrible to allocate the 'I#' box for the
132 argument only to tear it apart immediately in the body of 'even'! Hence,
133 worker/wrapper will allocate a wrapper for 'even' that not only uses
134 call-by-value for the argument (e.g., `case I# 42 of b { $weven b }`), but also
135 *unboxes* the argument, resulting in
136 ```
137 even :: Int -> Bool
138 even (I# n) = $weven n
139 $weven :: Int# -> Bool
140 $weven 0 = True
141 $weven 1 = False
142 $weven n = $weven (n -# 2)
143 ```
144 And now the box in `even (I# 42)` will cancel away after inlining the wrapper.
145
146 As far as the permission to unbox is concerned, *evaluatedness* of the argument
147 is the important trait. Unboxing implies eager evaluation of an argument and
148 we don't want to change the termination properties of the function. One way
149 to ensure that is to unbox strict arguments only, but strictness is only a
150 sufficient condition for evaluatedness.
151 See Note [Unboxing evaluated arguments] in "GHC.Core.Opt.WorkWrap.Utils", where
152 we manage to unbox *strict fields* of unboxed arguments that the function is not
153 actually strict in, simply by realising that those fields have to be evaluated.
154
155 Note [Boxity analysis]
156 ~~~~~~~~~~~~~~~~~~~~~~
157 Alas, we don't want to unbox *every* strict argument
158 (as Note [Strictness and Unboxing] might suggest).
159 Here's an example (from T19871):
160 ```
161 data Huge = H Bool Bool ... Bool
162 ann :: Huge -> (Bool, Huge)
163 ann h@(Huge True _ ... _) = (False, h)
164 ann h = (True, h)
165 ```
166 Unboxing 'h' yields
167 ```
168 $wann :: Bool -> Bool -> ... -> Bool -> (Bool, Huge)
169 $wann True b2 ... bn = (False, Huge True b2 ... bn)
170 $wann b1 b2 ... bn = (True, Huge b1 b2 ... bn)
171 ```
172 The pair constructor really needs its fields boxed. But '$wann' doesn't get
173 passed 'h' anymore, only its components! Ergo it has to reallocate the 'Huge'
174 box, in a process called "reboxing". After w/w, call sites like
175 `case ... of Just h -> ann h` pay for the allocation of the additional box.
176 In earlier versions of GHC we simply accepted that reboxing would sometimes
177 happen, but we found some cases where it made a big difference: #19407, for
178 example.
179
180 We therefore perform a simple syntactic boxity analysis that piggy-backs on
181 demand analysis in order to determine whether the box of a strict argument is
182 always discarded in the function body, in which case we can pass it unboxed
183 without risking regressions such as in 'ann' above. But as soon as one use needs
184 the box, we want Boxed to win over any Unboxed uses.
185 (We don't adhere to that in 'lubBoxity', see Note [lubBoxity and plusBoxity].)
186
187 The demand signature (cf. Note [Demand notation]) will say whether it uses
188 its arguments boxed or unboxed. Indeed it does so for every sub-component of
189 the argument demand. Here's an example:
190 ```
191 f :: (Int, Int) -> Bool
192 f (a, b) = even (a + b) -- demand signature: <1!P(1!L,1!L)>
193 ```
194 The '!' indicates places where we want to unbox, the lack thereof indicates the
195 box is used by the function. Boxity flags are part of the 'Poly' and 'Prod'
196 'SubDemand's, see Note [Why Boxity in SubDemand and not in Demand?].
197 The given demand signature says "Unbox the pair and then nestedly unbox its
198 two fields". By contrast, the demand signature of 'ann' above would look like
199 <1P(1L,L,...,L)>, lacking any '!'.
200
201 A demand signature like <1P(1!L)> -- Boxed outside but Unboxed in the field --
202 doesn't make a lot of sense, as we can never unbox the field without unboxing
203 the containing record. See Note [Finalising boxity for demand signature] in
204 "GHC.Core.Opt.WorkWrap.Utils" for how we avoid to spread this and other kinds of
205 misinformed boxities.
206
207 Due to various practical reasons, Boxity Analysis is not conservative at times.
208 Here are reasons for too much optimism:
209
210 * Note [Function body boxity and call sites] is an observation about when it is
211 beneficial to unbox a parameter that is returned from a function.
212 Note [Unboxed demand on function bodies returning small products] derives
213 a heuristic from the former Note, pretending that all call sites of a
214 function need returned small products Unboxed.
215 * Note [lubBoxity and plusBoxity] describes why we optimistically let Unboxed
216 win when combining different case alternatives.
217
218 Boxity analysis fixes a number of issues:
219 #19871, #19407, #4267, #16859, #18907, #13331
220
221 Note [Function body boxity and call sites]
222 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
223 Consider (from T5949)
224 ```
225 f n p = case n of
226 0 -> p :: (a, b)
227 _ -> f (n-1) p
228 -- Worker/wrapper split if we decide to unbox:
229 $wf n x y = case n of
230 0 -> (# x, y #)
231 _ -> $wf (n-1) x y
232 f n (x,y) = case $wf n x y of (# r, s #) -> (r,s)
233 ```
234 When is it better to /not/ to unbox 'p'? That depends on the callers of 'f'!
235 If all call sites
236
237 1. Wouldn't need to allocate fresh boxes for 'p', and
238 2. Needed the result pair of 'f' boxed
239
240 Only then we'd see an increase in allocation resulting from unboxing. But as
241 soon as only one of (1) or (2) holds, it really doesn't matter if 'f' unboxes
242 'p' (and its result, it's important that CPR follows suit). For example
243 ```
244 res = ... case f m (field t) of (r1,r2) -> ... -- (1) holds
245 arg = ... [ f m (x,y) ] ... -- (2) holds
246 ```
247 Because one of the boxes in the call site can cancel away:
248 ```
249 res = ... case field1 t of (x1,x2) ->
250 case field2 t of (y1,y2) ->
251 case $wf x1 x2 y1 y2 of (#r1,r2#) -> ...
252 arg = ... [ case $wf x1 x2 y1 y2 of (#r1,r2#) -> (r1,r2) ] ...
253 ```
254 And when call sites neither have arg boxes (1) nor need the result boxed (2),
255 then hesitating to unbox means /more/ allocation in the call site because of the
256 need for fresh argument boxes.
257
258 Summary: If call sites that satisfy both (1) and (2) occur more often than call
259 sites that satisfy neither condition, then it's best /not/ to unbox 'p'.
260
261 Note [Unboxed demand on function bodies returning small products]
262 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
263 Note [Boxity analysis] achieves its biggest wins when we avoid reboxing huge
264 records. But when we return small products from a function, we often get faster
265 programs by pretending that the caller unboxes the result. Long version:
266
267 Observation: Big record arguments (e.g., DynFlags) tend to be modified much less
268 frequently than small records (e.g., Int).
269 Result: Big records tend to be passed around boxed (unmodified) much more
270 frequently than small records.
271 Consequnce: The larger the record, the more likely conditions (1) and (2) from
272 Note [Function body boxity and call sites] are met, in which case
273 unboxing returned parameters leads to reboxing.
274
275 So we put an Unboxed demand on function bodies returning small products and a
276 Boxed demand on the others. What is regarded a small product is controlled by
277 the -fdmd-unbox-width flag.
278
279 This also manages to unbox functions like
280 ```
281 sum z [] = z
282 sum (I# n) ((I# x):xs) = sum (I# (n +# x)) xs
283 ```
284 where we can unbox 'z' on the grounds that it's but a small box anyway. That in
285 turn means that the I# allocation in the recursive call site can cancel away and
286 we get a non-allocating loop, nice and tight.
287 Note that this is the typical case in "Observation" above: A small box is
288 unboxed, modified, the result reboxed for the recursive call.
289
290 Originally, this came up in binary-trees' check' function and #4267 which
291 (similarly) features a strict fold over a tree. We'd also regress in join004 and
292 join007 if we didn't assume an optimistic Unboxed demand on the function body.
293 T17932 features a (non-recursive) function that returns a large record, e.g.,
294 ```
295 flags (Options f x) = <huge> `seq` f
296 ```
297 and here we won't unbox 'f' because it has 5 fields (which is larger than the
298 default -fdmd-unbox-width threshold).
299
300 Why not focus on putting Unboxed demands on all recursive function?
301 Then we'd unbox
302 ```
303 flags 0 (Options f x) = <huge> `seq` f
304 flags n o = flags (n-1) o
305 ```
306 and that seems hardly useful.
307 (NB: Similar to 'f' from Note [Preserving Boxity of results is rarely a win],
308 but there we only had 2 fields.)
309
310 Note [lubBoxity and plusBoxity]
311 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
312 Should 'Boxed' win in 'lubBoxity' and 'plusBoxity'?
313 The first intuition is Yes, because that would be the conservative choice:
314 Responding 'Boxed' when there's the slightest chance we might need the box means
315 we'll never need to rebox a value.
316
317 For 'plusBoxity' the choice of 'boxedWins' is clear: When we need a value to be
318 Boxed and Unboxed /in the same trace/, then we clearly need it to be Boxed.
319
320 But if we chose 'boxedWins' for 'lubBoxity', we'd regress T3586. Smaller example
321 ```
322 sumIO :: Int -> Int -> IO Int
323 sumIO 0 !z = return z
324 sumIO n !z = sumIO (n-1) (z+n)
325 ```
326 We really want 'z' to unbox here. Yet its use in the returned unboxed pair
327 is fundamentally a Boxed one! CPR would manage to unbox it, but DmdAnal runs
328 before that. There is an Unboxed use in the recursive call to 'go' though.
329 So we choose 'unboxedWins' for 'lubBoxity' to collect this win.
330
331 Choosing 'unboxedWins' is not conservative. There clearly is ample room for
332 examples that get worse by our choice. Here's a simple one (from T19871):
333 ```
334 data Huge = H { f1 :: Bool, ... many fields ... }
335 update :: Huge -> (Bool, Huge)
336 update h@(Huge{f1=True}) = (False, h{f1=False})
337 update h = (True, h)
338 ```
339 Here, we decide to unbox 'h' because it's used Unboxed in the first branch.
340
341 Note that this is fundamentally working around a phase problem, namely that the
342 results of boxity analysis depend on CPR analysis (and vice versa, of course).
343 -}
344
345 boxedWins :: Boxity -> Boxity -> Boxity
346 boxedWins Unboxed Unboxed = Unboxed
347 boxedWins _ !_ = Boxed
348
349 unboxedWins :: Boxity -> Boxity -> Boxity
350 unboxedWins Boxed Boxed = Boxed
351 unboxedWins _ !_ = Unboxed
352
353 lubBoxity :: Boxity -> Boxity -> Boxity
354 -- See Note [Boxity analysis] for the lattice.
355 -- See Note [lubBoxity and plusBoxity].
356 lubBoxity = unboxedWins
357
358 plusBoxity :: Boxity -> Boxity -> Boxity
359 -- See Note [lubBoxity and plusBoxity].
360 plusBoxity = boxedWins
361
362 {-
363 ************************************************************************
364 * *
365 Card: Combining Strictness and Usage
366 * *
367 ************************************************************************
368 -}
369
370 {- Note [Evaluation cardinalities]
371 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
372 The demand analyser uses an (abstraction of) /evaluation cardinality/ of type
373 Card, to specify how many times a term is evaluated. A Card C_lu
374 represents an /interval/ of possible cardinalities [l..u], meaning
375
376 * Evaluated /at least/ 'l' times (strictness).
377 Hence 'l' is either 0 (lazy)
378 or 1 (strict)
379
380 * Evaluated /at most/ 'u' times (usage).
381 Hence 'u' is either 0 (not used at all),
382 or 1 (used at most once)
383 or n (no information)
384
385 Intervals describe sets, so the underlying lattice is the powerset lattice.
386
387 Usually l<=u, but we also have C_10, the interval [1,0], the empty interval,
388 denoting the empty set. This is the bottom element of the lattice.
389
390 See Note [Demand notation] for the notation we use for each of the constructors.
391
392 Note [Bit vector representation for Card]
393 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
394 While the 6 inhabitants of Card admit an efficient representation as an
395 enumeration, implementing operations such as lubCard, plusCard and multCard
396 leads to unreasonably bloated code. This was the old defn for lubCard, for
397 example:
398
399 -- Handle C_10 (bot)
400 lubCard C_10 n = n -- bot
401 lubCard n C_10 = n -- bot
402 -- Handle C_0N (top)
403 lubCard C_0N _ = C_0N -- top
404 lubCard _ C_0N = C_0N -- top
405 -- Handle C_11
406 lubCard C_00 C_11 = C_01 -- {0} ∪ {1} = {0,1}
407 lubCard C_11 C_00 = C_01 -- {0} ∪ {1} = {0,1}
408 lubCard C_11 n = n -- {1} is a subset of all other intervals
409 lubCard n C_11 = n -- {1} is a subset of all other intervals
410 -- Handle C_1N
411 lubCard C_1N C_1N = C_1N -- reflexivity
412 lubCard _ C_1N = C_0N -- {0} ∪ {1,n} = top
413 lubCard C_1N _ = C_0N -- {0} ∪ {1,n} = top
414 -- Handle C_01
415 lubCard C_01 _ = C_01 -- {0} ∪ {0,1} = {0,1}
416 lubCard _ C_01 = C_01 -- {0} ∪ {0,1} = {0,1}
417 -- Handle C_00
418 lubCard C_00 C_00 = C_00 -- reflexivity
419
420 There's a much more compact way to encode these operations if Card is
421 represented not as distinctly denoted intervals, but as the subset of the set
422 of all cardinalities {0,1,n} instead. We represent such a subset as a bit vector
423 of length 3 (which fits in an Int). That's actually pretty common for such
424 powerset lattices.
425 There's one bit per denoted cardinality that is set iff that cardinality is part
426 of the denoted set, with n being the most significand bit (index 2) and 0 being
427 represented by the least significand bit (index 0).
428
429 How does that help? Well, for one, lubCard just becomes
430
431 lubCard (Card a) (Card b) = Card (a .|. b)
432
433 The other operations, 'plusCard' and 'multCard', become significantly more
434 tricky, but immensely more compact. It's all straight-line code with a few bit
435 twiddling instructions now!
436
437 Note [Algebraic specification for plusCard and multCard]
438 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
439 The representation change in Note [Bit vector representation for Card] admits
440 very dense definitions of 'plusCard' and 'multCard' in terms of bit twiddling,
441 but the connection to the algebraic operations they implement is lost.
442 It's helpful to have a written specification of what 'plusCard' and 'multCard'
443 here that says what they should compute.
444
445 * plusCard: a@[l1,u1] + b@[l2,u2] = r@[l1+l2,u1+u2].
446 - In terms of sets, 0 ∈ r iff 0 ∈ a and 0 ∈ b.
447 Examples: set in C_00 + C_00, C_01 + C_0N, but not in C_10 + C_00
448 - In terms of sets, 1 ∈ r iff 1 ∈ a or 1 ∈ b.
449 Examples: set in C_01 + C_00, C_0N + C_0N, but not in C_10 + C_00
450 - In terms of sets, n ∈ r iff n ∈ a or n ∈ b, or (1 ∈ a and 1 ∈ b),
451 so not unlike add with carry.
452 Examples: set in C_01 + C_01, C_01 + C_0N, but not in C_10 + C_01
453 - Handy special cases:
454 o 'plusCard C_10' bumps up the strictness of its argument, just like
455 'lubCard C_00' lazifies it, without touching upper bounds.
456 o Similarly, 'plusCard C_0N' discards usage information
457 (incl. absence) but leaves strictness alone.
458
459 * multCard: a@[l1,u1] * b@[l2,u2] = r@[l1*l2,u1*u2].
460 - In terms of sets, 0 ∈ r iff 0 ∈ a or 0 ∈ b.
461 Examples: set in C_00 * C_10, C_01 * C_1N, but not in C_10 * C_1N
462 - In terms of sets, 1 ∈ r iff 1 ∈ a and 1 ∈ b.
463 Examples: set in C_01 * C_01, C_01 * C_1N, but not in C_11 * C_10
464 - In terms of sets, n ∈ r iff 1 ∈ r and (n ∈ a or n ∈ b).
465 Examples: set in C_1N * C_01, C_1N * C_0N, but not in C_10 * C_1N
466 - Handy special cases:
467 o 'multCard C_1N c' is the same as 'plusCard c c' and
468 drops used-once info. But unlike 'plusCard C_0N', it leaves absence
469 and strictness.
470 o 'multCard C_01' drops strictness info, like 'lubCard C_00'.
471 o 'multCard C_0N' does both; it discards all strictness and used-once
472 info and retains only absence info.
473 -}
474
475
476 -- | Describes an interval of /evaluation cardinalities/.
477 -- See Note [Evaluation cardinalities]
478 -- See Note [Bit vector representation for Card]
479 newtype Card = Card Int
480 deriving Eq
481
482 -- | A subtype of 'Card' for which the upper bound is never 0 (no 'C_00' or
483 -- 'C_10'). The only four inhabitants are 'C_01', 'C_0N', 'C_11', 'C_1N'.
484 -- Membership can be tested with 'isCardNonAbs'.
485 -- See 'D' and 'Call' for use sites and explanation.
486 type CardNonAbs = Card
487
488 -- | A subtype of 'Card' for which the upper bound is never 1 (no 'C_01' or
489 -- 'C_11'). The only four inhabitants are 'C_00', 'C_0N', 'C_10', 'C_1N'.
490 -- Membership can be tested with 'isCardNonOnce'.
491 -- See 'Poly' for use sites and explanation.
492 type CardNonOnce = Card
493
494 -- | Absent, {0}. Pretty-printed as A.
495 pattern C_00 :: Card
496 pattern C_00 = Card 0b001
497 -- | Bottom, {}. Pretty-printed as A.
498 pattern C_10 :: Card
499 pattern C_10 = Card 0b000
500 -- | Strict and used once, {1}. Pretty-printed as 1.
501 pattern C_11 :: Card
502 pattern C_11 = Card 0b010
503 -- | Used at most once, {0,1}. Pretty-printed as M.
504 pattern C_01 :: Card
505 pattern C_01 = Card 0b011
506 -- | Strict and used (possibly) many times, {1,n}. Pretty-printed as S.
507 pattern C_1N :: Card
508 pattern C_1N = Card 0b110
509 -- | Every possible cardinality; the top element, {0,1,n}. Pretty-printed as L.
510 pattern C_0N :: Card
511 pattern C_0N = Card 0b111
512
513 {-# COMPLETE C_00, C_01, C_0N, C_10, C_11, C_1N :: Card #-}
514
515 _botCard, topCard :: Card
516 _botCard = C_10
517 topCard = C_0N
518
519 -- | True <=> lower bound is 1.
520 isStrict :: Card -> Bool
521 -- See Note [Bit vector representation for Card]
522 isStrict (Card c) = c .&. 0b001 == 0 -- simply check 0 bit is not set
523
524 -- | True <=> upper bound is 0.
525 isAbs :: Card -> Bool
526 -- See Note [Bit vector representation for Card]
527 isAbs (Card c) = c .&. 0b110 == 0 -- simply check 1 and n bit are not set
528
529 -- | True <=> upper bound is 1.
530 isUsedOnce :: Card -> Bool
531 -- See Note [Bit vector representation for Card]
532 isUsedOnce (Card c) = c .&. 0b100 == 0 -- simply check n bit is not set
533
534 -- | Is this a 'CardNonAbs'?
535 isCardNonAbs :: Card -> Bool
536 isCardNonAbs = not . isAbs
537
538 -- | Is this a 'CardNonOnce'?
539 isCardNonOnce :: Card -> Bool
540 isCardNonOnce n = isAbs n || not (isUsedOnce n)
541
542 -- | Intersect with [0,1].
543 oneifyCard :: Card -> Card
544 oneifyCard C_0N = C_01
545 oneifyCard C_1N = C_11
546 oneifyCard c = c
547
548 -- | Denotes '∪' on 'Card'.
549 lubCard :: Card -> Card -> Card
550 -- See Note [Bit vector representation for Card]
551 lubCard (Card a) (Card b) = Card (a .|. b) -- main point of the bit-vector encoding!
552
553 -- | Denotes '+' on lower and upper bounds of 'Card'.
554 plusCard :: Card -> Card -> Card
555 -- See Note [Algebraic specification for plusCard and multCard]
556 plusCard (Card a) (Card b)
557 = Card (bit0 .|. bit1 .|. bitN)
558 where
559 bit0 = (a .&. b) .&. 0b001
560 bit1 = (a .|. b) .&. 0b010
561 bitN = ((a .|. b) .|. shiftL (a .&. b) 1) .&. 0b100
562
563 -- | Denotes '*' on lower and upper bounds of 'Card'.
564 multCard :: Card -> Card -> Card
565 -- See Note [Algebraic specification for plusCard and multCard]
566 multCard (Card a) (Card b)
567 = Card (bit0 .|. bit1 .|. bitN)
568 where
569 bit0 = (a .|. b) .&. 0b001
570 bit1 = (a .&. b) .&. 0b010
571 bitN = (a .|. b) .&. shiftL bit1 1 .&. 0b100
572
573 {-
574 ************************************************************************
575 * *
576 Demand: Evaluation contexts
577 * *
578 ************************************************************************
579 -}
580
581 -- | A demand describes a /scaled evaluation context/, e.g. how many times
582 -- and how deep the denoted thing is evaluated.
583 --
584 -- The "how many" component is represented by a 'Card'inality.
585 -- The "how deep" component is represented by a 'SubDemand'.
586 -- Examples (using Note [Demand notation]):
587 --
588 -- * 'seq' puts demand @1A@ on its first argument: It evaluates the argument
589 -- strictly (@1@), but not any deeper (@A@).
590 -- * 'fst' puts demand @1P(1L,A)@ on its argument: It evaluates the argument
591 -- pair strictly and the first component strictly, but no nested info
592 -- beyond that (@L@). Its second argument is not used at all.
593 -- * '$' puts demand @1C1(L)@ on its first argument: It calls (@C@) the
594 -- argument function with one argument, exactly once (@1@). No info
595 -- on how the result of that call is evaluated (@L@).
596 -- * 'maybe' puts demand @MCM(L)@ on its second argument: It evaluates
597 -- the argument function at most once ((M)aybe) and calls it once when
598 -- it is evaluated.
599 -- * @fst p + fst p@ puts demand @SP(SL,A)@ on @p@: It's @1P(1L,A)@
600 -- multiplied by two, so we get @S@ (used at least once, possibly multiple
601 -- times).
602 --
603 -- This data type is quite similar to @'Scaled' 'SubDemand'@, but it's scaled
604 -- by 'Card', which is an /interval/ on 'Multiplicity', the upper bound of
605 -- which could be used to infer uniqueness types. Also we treat 'AbsDmd' and
606 -- 'BotDmd' specially, as the concept of a 'SubDemand' doesn't apply when there
607 -- isn't any evaluation at all. If you don't care, simply use '(:*)'.
608 data Demand
609 = BotDmd
610 -- ^ A bottoming demand, produced by a diverging function, hence there is no
611 -- 'SubDemand' that describes how it was evaluated.
612 | AbsDmd
613 -- ^ An absent demand: Evaluated exactly 0 times ('C_00'), hence there is no
614 -- 'SubDemand' that describes how it was evaluated.
615 | D !CardNonAbs !SubDemand
616 -- ^ Don't use this internal data constructor; use '(:*)' instead.
617 deriving Eq
618
619 -- | Only meant to be used in the pattern synonym below!
620 viewDmdPair :: Demand -> (Card, SubDemand)
621 viewDmdPair BotDmd = (C_10, botSubDmd)
622 viewDmdPair AbsDmd = (C_00, seqSubDmd)
623 viewDmdPair (D n sd) = (n, sd)
624
625 -- | @c :* sd@ is a demand that says \"evaluated @c@ times, and each time it
626 -- was evaluated, it was at least as deep as @sd@\".
627 --
628 -- Matching on this pattern synonym is a complete match.
629 -- If the matched demand was 'AbsDmd', it will match as @C_00 :* seqSubDmd@.
630 -- If the matched demand was 'BotDmd', it will match as @C_10 :* botSubDmd@.
631 -- The builder of this pattern synonym simply /discards/ the 'SubDemand' if the
632 -- 'Card' was absent and returns 'AbsDmd' or 'BotDmd' instead. It will assert
633 -- that the discarded sub-demand was 'seqSubDmd' and 'botSubDmd', respectively.
634 --
635 -- Call sites should consider whether they really want to look at the
636 -- 'SubDemand' of an absent demand and match on 'AbsDmd' and/or 'BotDmd'
637 -- otherwise. Really, any other 'SubDemand' would be allowed and
638 -- might work better, depending on context.
639 pattern (:*) :: HasDebugCallStack => Card -> SubDemand -> Demand
640 pattern n :* sd <- (viewDmdPair -> (n, sd)) where
641 C_10 :* sd = BotDmd & assertPpr (sd == botSubDmd) (text "B /=" <+> ppr sd)
642 C_00 :* sd = AbsDmd & assertPpr (sd == seqSubDmd) (text "A /=" <+> ppr sd)
643 n :* sd = D n sd & assertPpr (isCardNonAbs n) (ppr n $$ ppr sd)
644 {-# COMPLETE (:*) #-}
645
646 -- | A sub-demand describes an /evaluation context/, e.g. how deep the
647 -- denoted thing is evaluated. See 'Demand' for examples.
648 --
649 -- The nested 'SubDemand' @d@ of a 'Call' @Cn(d)@ is /relative/ to a single such call.
650 -- E.g. The expression @f 1 2 + f 3 4@ puts call demand @SCS(C1(L))@ on @f@:
651 -- @f@ is called exactly twice (@S@), each time exactly once (@1@) with an
652 -- additional argument.
653 --
654 -- The nested 'Demand's @dn@ of a 'Prod' @P(d1,d2,...)@ apply /absolutely/:
655 -- If @dn@ is a used once demand (cf. 'isUsedOnce'), then that means that
656 -- the denoted sub-expression is used once in the entire evaluation context
657 -- described by the surrounding 'Demand'. E.g., @LP(ML)@ means that the
658 -- field of the denoted expression is used at most once, although the
659 -- entire expression might be used many times.
660 --
661 -- See Note [Call demands are relative]
662 -- and Note [Demand notation].
663 -- See also Note [Why Boxity in SubDemand and not in Demand?].
664 data SubDemand
665 = Poly !Boxity !CardNonOnce
666 -- ^ Polymorphic demand, the denoted thing is evaluated arbitrarily deep,
667 -- with the specified cardinality at every level. The 'Boxity' applies only
668 -- to the outer evaluation context; inner evaluation context can be regarded
669 -- as 'Boxed'. See Note [Boxity in Poly] for why we want it to carry 'Boxity'.
670 -- Expands to 'Call' via 'viewCall' and to 'Prod' via 'viewProd'.
671 --
672 -- @Poly b n@ is semantically equivalent to @Prod b [n :* Poly Boxed n, ...]@
673 -- or @Call n (Poly Boxed n)@. 'viewCall' and 'viewProd' do these rewrites.
674 --
675 -- In Note [Demand notation]: @L === P(L,L,...)@ and @L === CL(L)@,
676 -- @B === P(B,B,...)@ and @B === CB(B)@,
677 -- @!A === !P(A,A,...)@ and @!A === !CA(A)@,
678 -- and so on.
679 --
680 -- We'll only see 'Poly' with 'C_10' (B), 'C_00' (A), 'C_0N' (L) and sometimes
681 -- 'C_1N' (S) through 'plusSubDmd', never 'C_01' (M) or 'C_11' (1) (grep the
682 -- source code). Hence 'CardNonOnce', which is closed under 'lub' and 'plus'.
683 | Call !CardNonAbs !SubDemand
684 -- ^ @Call n sd@ describes the evaluation context of @n@ function
685 -- applications, where every individual result is evaluated according to @sd@.
686 -- @sd@ is /relative/ to a single call, see Note [Call demands are relative].
687 -- That Note also explains why it doesn't make sense for @n@ to be absent,
688 -- hence we forbid it with 'CardNonAbs'. Absent call demands can still be
689 -- expressed with 'Poly'.
690 -- Used only for values of function type. Use the smart constructor 'mkCall'
691 -- whenever possible!
692 | Prod !Boxity ![Demand]
693 -- ^ @Prod b ds@ describes the evaluation context of a case scrutinisation
694 -- on an expression of product type, where the product components are
695 -- evaluated according to @ds@. The 'Boxity' @b@ says whether or not the box
696 -- of the product was used.
697
698 -- | We have to respect Poly rewrites through 'viewCall' and 'viewProd'.
699 instance Eq SubDemand where
700 d1 == d2 = case d1 of
701 Prod b1 ds1
702 | Just (b2, ds2) <- viewProd (length ds1) d2 -> b1 == b2 && ds1 == ds2
703 Call n1 sd1
704 | Just (n2, sd2) <- viewCall d2 -> n1 == n2 && sd1 == sd2
705 Poly b1 n1
706 | Poly b2 n2 <- d2 -> b1 == b2 && n1 == n2
707 _ -> False
708
709 topSubDmd, botSubDmd, seqSubDmd :: SubDemand
710 topSubDmd = Poly Boxed C_0N
711 botSubDmd = Poly Unboxed C_10
712 seqSubDmd = Poly Unboxed C_00
713
714 -- | The uniform field demand when viewing a 'Poly' as a 'Prod', as in
715 -- 'viewProd'.
716 polyFieldDmd :: CardNonOnce -> Demand
717 polyFieldDmd C_00 = AbsDmd
718 polyFieldDmd C_10 = BotDmd
719 polyFieldDmd C_0N = topDmd
720 polyFieldDmd n = C_1N :* Poly Boxed C_1N & assertPpr (isCardNonOnce n) (ppr n)
721
722 -- | A smart constructor for 'Prod', applying rewrite rules along the semantic
723 -- equality @Prod b [n :* Poly Boxed n, ...] === Poly b n@, simplifying to
724 -- 'Poly' 'SubDemand's when possible. Examples:
725 --
726 -- * Rewrites @P(L,L)@ (e.g., arguments @Boxed@, @[L,L]@) to @L@
727 -- * Rewrites @!P(L,L)@ (e.g., arguments @Unboxed@, @[L,L]@) to @!L@
728 -- * Does not rewrite @P(1L)@, @P(L!L)@ or @P(L,A)@
729 --
730 mkProd :: Boxity -> [Demand] -> SubDemand
731 mkProd b ds
732 | all (== AbsDmd) ds = Poly b C_00
733 | all (== BotDmd) ds = Poly b C_10
734 | dmd@(n :* Poly Boxed m):_ <- ds -- don't rewrite P(L!L)
735 , n == m -- don't rewrite P(1L)
736 , all (== dmd) ds -- don't rewrite P(L,A)
737 = Poly b n
738 | otherwise = Prod b ds
739
740 -- | @viewProd n sd@ interprets @sd@ as a 'Prod' of arity @n@, expanding 'Poly'
741 -- demands as necessary.
742 viewProd :: Arity -> SubDemand -> Maybe (Boxity, [Demand])
743 -- It's quite important that this function is optimised well;
744 -- it is used by lubSubDmd and plusSubDmd.
745 viewProd n (Prod b ds)
746 | ds `lengthIs` n = Just (b, ds)
747 -- Note the strict application to replicate: This makes sure we don't allocate
748 -- a thunk for it, inlines it and lets case-of-case fire at call sites.
749 viewProd n (Poly b card)
750 | let !ds = replicate n $! polyFieldDmd card
751 = Just (b, ds)
752 viewProd _ _
753 = Nothing
754 {-# INLINE viewProd #-} -- we want to fuse away the replicate and the allocation
755 -- for Arity. Otherwise, #18304 bites us.
756
757 -- | A smart constructor for 'Call', applying rewrite rules along the semantic
758 -- equality @Call n (Poly n) === Poly n@, simplifying to 'Poly' 'SubDemand's
759 -- when possible.
760 mkCall :: CardNonAbs -> SubDemand -> SubDemand
761 mkCall C_1N sd@(Poly Boxed C_1N) = sd
762 mkCall C_0N sd@(Poly Boxed C_0N) = sd
763 mkCall n cd = assertPpr (isCardNonAbs n) (ppr n $$ ppr cd) $
764 Call n cd
765
766 -- | @viewCall sd@ interprets @sd@ as a 'Call', expanding 'Poly' subdemands as
767 -- necessary.
768 viewCall :: SubDemand -> Maybe (Card, SubDemand)
769 viewCall (Call n sd) = Just (n :: Card, sd)
770 viewCall (Poly _ n) = Just (n :: Card, Poly Boxed n)
771 viewCall _ = Nothing
772
773 topDmd, absDmd, botDmd, seqDmd :: Demand
774 topDmd = C_0N :* topSubDmd
775 absDmd = AbsDmd
776 botDmd = BotDmd
777 seqDmd = C_11 :* seqSubDmd
778
779 -- | Sets 'Boxity' to 'Unboxed' for non-'Call' sub-demands.
780 unboxSubDemand :: SubDemand -> SubDemand
781 unboxSubDemand (Poly _ n) = Poly Unboxed n
782 unboxSubDemand (Prod _ ds) = mkProd Unboxed ds
783 unboxSubDemand sd@Call{} = sd
784
785 -- | Denotes '∪' on 'SubDemand'.
786 lubSubDmd :: SubDemand -> SubDemand -> SubDemand
787 -- Handle botSubDmd (just an optimisation, the general case would do the same)
788 lubSubDmd (Poly Unboxed C_10) d2 = d2
789 lubSubDmd d1 (Poly Unboxed C_10) = d1
790 -- Handle Prod
791 lubSubDmd (Prod b1 ds1) (Poly b2 n2)
792 | let !d = polyFieldDmd n2
793 = mkProd (lubBoxity b1 b2) (strictMap (lubDmd d) ds1)
794 lubSubDmd (Prod b1 ds1) (Prod b2 ds2)
795 | equalLength ds1 ds2
796 = mkProd (lubBoxity b1 b2) (strictZipWith lubDmd ds1 ds2)
797 -- Handle Call
798 lubSubDmd (Call n1 sd1) sd2@(Poly _ n2)
799 -- See Note [Call demands are relative]
800 | isAbs n2 = mkCall (lubCard n2 n1) sd1
801 | otherwise = mkCall (lubCard n2 n1) (lubSubDmd sd1 sd2)
802 lubSubDmd (Call n1 d1) (Call n2 d2)
803 | otherwise = mkCall (lubCard n1 n2) (lubSubDmd d1 d2)
804 -- Handle Poly. Exploit reflexivity (so we'll match the Prod or Call cases again).
805 lubSubDmd (Poly b1 n1) (Poly b2 n2) = Poly (lubBoxity b1 b2) (lubCard n1 n2)
806 lubSubDmd sd1@Poly{} sd2 = lubSubDmd sd2 sd1
807 -- Otherwise (Call `lub` Prod) return Top
808 lubSubDmd _ _ = topSubDmd
809
810 -- | Denotes '∪' on 'Demand'.
811 lubDmd :: Demand -> Demand -> Demand
812 lubDmd (n1 :* sd1) (n2 :* sd2) = lubCard n1 n2 :* lubSubDmd sd1 sd2
813
814 -- | Denotes '+' on 'SubDemand'.
815 plusSubDmd :: SubDemand -> SubDemand -> SubDemand
816 -- Handle seqSubDmd (just an optimisation, the general case would do the same)
817 plusSubDmd (Poly Unboxed C_00) d2 = d2
818 plusSubDmd d1 (Poly Unboxed C_00) = d1
819 -- Handle Prod
820 plusSubDmd (Prod b1 ds1) (Poly b2 n2)
821 | let !d = polyFieldDmd n2
822 = mkProd (plusBoxity b1 b2) (strictMap (plusDmd d) ds1)
823 plusSubDmd (Prod b1 ds1) (Prod b2 ds2)
824 | equalLength ds1 ds2
825 = mkProd (plusBoxity b1 b2) (strictZipWith plusDmd ds1 ds2)
826 -- Handle Call
827 plusSubDmd (Call n1 sd1) sd2@(Poly _ n2)
828 -- See Note [Call demands are relative]
829 | isAbs n2 = mkCall (plusCard n2 n1) sd1
830 | otherwise = mkCall (plusCard n2 n1) (lubSubDmd sd1 sd2)
831 plusSubDmd (Call n1 sd1) (Call n2 sd2)
832 | otherwise = mkCall (plusCard n1 n2) (lubSubDmd sd1 sd2)
833 -- Handle Poly. Exploit reflexivity (so we'll match the Prod or Call cases again).
834 plusSubDmd (Poly b1 n1) (Poly b2 n2) = Poly (plusBoxity b1 b2) (plusCard n1 n2)
835 plusSubDmd sd1@Poly{} sd2 = plusSubDmd sd2 sd1
836 -- Otherwise (Call `lub` Prod) return Top
837 plusSubDmd _ _ = topSubDmd
838
839 -- | Denotes '+' on 'Demand'.
840 plusDmd :: Demand -> Demand -> Demand
841 plusDmd (n1 :* sd1) (n2 :* sd2) = plusCard n1 n2 :* plusSubDmd sd1 sd2
842
843 multSubDmd :: Card -> SubDemand -> SubDemand
844 multSubDmd C_11 sd = sd
845 multSubDmd C_00 _ = seqSubDmd
846 multSubDmd C_10 (Poly _ n) = if isStrict n then botSubDmd else seqSubDmd
847 multSubDmd C_10 (Call n _) = if isStrict n then botSubDmd else seqSubDmd
848 multSubDmd n (Poly b m) = Poly b (multCard n m)
849 multSubDmd n (Call n' sd) = mkCall (multCard n n') sd -- See Note [Call demands are relative]
850 multSubDmd n (Prod b ds) = mkProd b (strictMap (multDmd n) ds)
851
852 multDmd :: Card -> Demand -> Demand
853 -- The first two lines compute the same result as the last line, but won't
854 -- trigger the assertion in `:*` for input like `multDmd B 1L`, which would call
855 -- `B :* A`. We want to return `B` in these cases.
856 multDmd C_10 (n :* _) = if isStrict n then BotDmd else AbsDmd
857 multDmd n (C_10 :* _) = if isStrict n then BotDmd else AbsDmd
858 multDmd n (m :* sd) = multCard n m :* multSubDmd n sd
859
860 -- | Used to suppress pretty-printing of an uninformative demand
861 isTopDmd :: Demand -> Bool
862 isTopDmd dmd = dmd == topDmd
863
864 isAbsDmd :: Demand -> Bool
865 isAbsDmd (n :* _) = isAbs n
866
867 -- | Contrast with isStrictUsedDmd. See Note [Strict demands]
868 isStrictDmd :: Demand -> Bool
869 isStrictDmd (n :* _) = isStrict n
870
871 -- | Not absent and used strictly. See Note [Strict demands]
872 isStrUsedDmd :: Demand -> Bool
873 isStrUsedDmd (n :* _) = isStrict n && not (isAbs n)
874
875 -- | Is the value used at most once?
876 isUsedOnceDmd :: Demand -> Bool
877 isUsedOnceDmd (n :* _) = isUsedOnce n
878
879 -- | We try to avoid tracking weak free variable demands in strictness
880 -- signatures for analysis performance reasons.
881 -- See Note [Lazy and unleashable free variables] in "GHC.Core.Opt.DmdAnal".
882 isWeakDmd :: Demand -> Bool
883 isWeakDmd dmd@(n :* _) = not (isStrict n) && is_plus_idem_dmd dmd
884 where
885 -- @is_plus_idem_* thing@ checks whether @thing `plus` thing = thing@,
886 -- e.g. if @thing@ is idempotent wrt. to @plus@.
887 -- is_plus_idem_card n = plusCard n n == n
888 is_plus_idem_card = isCardNonOnce
889 -- is_plus_idem_dmd dmd = plusDmd dmd dmd == dmd
890 is_plus_idem_dmd AbsDmd = True
891 is_plus_idem_dmd BotDmd = True
892 is_plus_idem_dmd (n :* sd) = is_plus_idem_card n && is_plus_idem_sub_dmd sd
893 -- is_plus_idem_sub_dmd sd = plusSubDmd sd sd == sd
894 is_plus_idem_sub_dmd (Poly _ n) = assert (isCardNonOnce n) True
895 is_plus_idem_sub_dmd (Prod _ ds) = all is_plus_idem_dmd ds
896 is_plus_idem_sub_dmd (Call n _) = is_plus_idem_card n -- See Note [Call demands are relative]
897
898 evalDmd :: Demand
899 evalDmd = C_1N :* topSubDmd
900
901 -- | First argument of 'GHC.Exts.maskAsyncExceptions#': @1C1(L)@.
902 -- Called exactly once.
903 strictOnceApply1Dmd :: Demand
904 strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd
905
906 -- | First argument of 'GHC.Exts.atomically#': @SCS(L)@.
907 -- Called at least once, possibly many times.
908 strictManyApply1Dmd :: Demand
909 strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd
910
911 -- | First argument of catch#: @MCM(L)@.
912 -- Evaluates its arg lazily, but then applies it exactly once to one argument.
913 lazyApply1Dmd :: Demand
914 lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd
915
916 -- | Second argument of catch#: @MCM(C1(L))@.
917 -- Calls its arg lazily, but then applies it exactly once to an additional argument.
918 lazyApply2Dmd :: Demand
919 lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd)
920
921 -- | Make a 'Demand' evaluated at-most-once.
922 oneifyDmd :: Demand -> Demand
923 oneifyDmd AbsDmd = AbsDmd
924 oneifyDmd BotDmd = BotDmd
925 oneifyDmd (n :* sd) = oneifyCard n :* sd
926
927 -- | Make a 'Demand' evaluated at-least-once (e.g. strict).
928 strictifyDmd :: Demand -> Demand
929 strictifyDmd AbsDmd = seqDmd
930 strictifyDmd BotDmd = BotDmd
931 strictifyDmd (n :* sd) = plusCard C_10 n :* sd
932
933 -- | If the argument is a used non-newtype dictionary, give it strict demand.
934 -- Also split the product type & demand and recur in order to similarly
935 -- strictify the argument's contained used non-newtype superclass dictionaries.
936 -- We use the demand as our recursive measure to guarantee termination.
937 strictifyDictDmd :: Type -> Demand -> Demand
938 strictifyDictDmd ty (n :* Prod b ds)
939 | not (isAbs n)
940 , Just field_tys <- as_non_newtype_dict ty
941 = C_1N :* mkProd b (zipWith strictifyDictDmd field_tys ds)
942 -- main idea: ensure it's strict
943 where
944 -- | Return a TyCon and a list of field types if the given
945 -- type is a non-newtype dictionary type
946 as_non_newtype_dict ty
947 | Just (tycon, _arg_tys, _data_con, map scaledThing -> inst_con_arg_tys)
948 <- splitDataProductType_maybe ty
949 , not (isNewTyCon tycon)
950 , isClassTyCon tycon
951 = Just inst_con_arg_tys
952 | otherwise
953 = Nothing
954 strictifyDictDmd _ dmd = dmd
955
956 -- | Wraps the 'SubDemand' with a one-shot call demand: @d@ -> @C1(d)@.
957 mkCalledOnceDmd :: SubDemand -> SubDemand
958 mkCalledOnceDmd sd = mkCall C_11 sd
959
960 -- | @mkCalledOnceDmds n d@ returns @C1(C1...(C1 d))@ where there are @n@ @C1@'s.
961 mkCalledOnceDmds :: Arity -> SubDemand -> SubDemand
962 mkCalledOnceDmds arity sd = iterate mkCalledOnceDmd sd !! arity
963
964 -- | Peels one call level from the sub-demand, and also returns how many
965 -- times we entered the lambda body.
966 peelCallDmd :: SubDemand -> (Card, SubDemand)
967 peelCallDmd sd = viewCall sd `orElse` (topCard, topSubDmd)
968
969 -- Peels multiple nestings of 'Call' sub-demands and also returns
970 -- whether it was unsaturated in the form of a 'Card'inality, denoting
971 -- how many times the lambda body was entered.
972 -- See Note [Demands from unsaturated function calls].
973 peelManyCalls :: Int -> SubDemand -> Card
974 peelManyCalls 0 _ = C_11
975 -- See Note [Call demands are relative]
976 peelManyCalls n (viewCall -> Just (m, sd)) = m `multCard` peelManyCalls (n-1) sd
977 peelManyCalls _ _ = C_0N
978
979 -- See Note [Demand on the worker] in GHC.Core.Opt.WorkWrap
980 mkWorkerDemand :: Int -> Demand
981 mkWorkerDemand n = C_01 :* go n
982 where go 0 = topSubDmd
983 go n = Call C_01 $ go (n-1)
984
985 argsOneShots :: DmdSig -> Arity -> [[OneShotInfo]]
986 -- ^ See Note [Computing one-shot info]
987 argsOneShots (DmdSig (DmdType _ arg_ds _)) n_val_args
988 | unsaturated_call = []
989 | otherwise = go arg_ds
990 where
991 unsaturated_call = arg_ds `lengthExceeds` n_val_args
992
993 go [] = []
994 go (arg_d : arg_ds) = argOneShots arg_d `cons` go arg_ds
995
996 -- Avoid list tail like [ [], [], [] ]
997 cons [] [] = []
998 cons a as = a:as
999
1000 argOneShots :: Demand -- ^ depending on saturation
1001 -> [OneShotInfo]
1002 -- ^ See Note [Computing one-shot info]
1003 argOneShots AbsDmd = [] -- This defn conflicts with 'saturatedByOneShots',
1004 argOneShots BotDmd = [] -- according to which we should return
1005 -- @repeat OneShotLam@ here...
1006 argOneShots (_ :* sd) = go sd -- See Note [Call demands are relative]
1007 where
1008 go (Call n sd)
1009 | isUsedOnce n = OneShotLam : go sd
1010 | otherwise = NoOneShotInfo : go sd
1011 go _ = []
1012
1013 -- |
1014 -- @saturatedByOneShots n CM(CM(...)) = True@
1015 -- <=>
1016 -- There are at least n nested CM(..) calls.
1017 -- See Note [Demand on the worker] in GHC.Core.Opt.WorkWrap
1018 saturatedByOneShots :: Int -> Demand -> Bool
1019 saturatedByOneShots _ AbsDmd = True
1020 saturatedByOneShots _ BotDmd = True
1021 saturatedByOneShots n (_ :* sd) = isUsedOnce (peelManyCalls n sd)
1022
1023 {- Note [Strict demands]
1024 ~~~~~~~~~~~~~~~~~~~~~~~~
1025 'isStrUsedDmd' returns true only of demands that are
1026 both strict
1027 and used
1028
1029 In particular, it is False for <B> (i.e. strict and not used,
1030 cardinality C_10), which can and does arise in, say (#7319)
1031 f x = raise# <some exception>
1032 Then 'x' is not used, so f gets strictness <B> -> .
1033 Now the w/w generates
1034 fx = let x <B> = absentError "unused"
1035 in raise <some exception>
1036 At this point we really don't want to convert to
1037 fx = case absentError "unused" of x -> raise <some exception>
1038 Since the program is going to diverge, this swaps one error for another,
1039 but it's really a bad idea to *ever* evaluate an absent argument.
1040 In #7319 we get
1041 T7319.exe: Oops! Entered absent arg w_s1Hd{v} [lid] [base:GHC.Base.String{tc 36u}]
1042
1043 Note [Call demands are relative]
1044 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1045 The expression @if b then 0 else f 1 2 + f 3 4@ uses @f@ according to the demand
1046 @LCL(C1(P(L)))@, meaning
1047
1048 "f is called multiple times or not at all (CL), but each time it
1049 is called, it's called with *exactly one* (C1) more argument.
1050 Whenever it is called with two arguments, we have no info on how often
1051 the field of the product result is used (L)."
1052
1053 So the 'SubDemand' nested in a 'Call' demand is relative to exactly one call.
1054 And that extends to the information we have how its results are used in each
1055 call site. Consider (#18903)
1056
1057 h :: Int -> Int
1058 h m =
1059 let g :: Int -> (Int,Int)
1060 g 1 = (m, 0)
1061 g n = (2 * n, 2 `div` n)
1062 {-# NOINLINE g #-}
1063 in case m of
1064 1 -> 0
1065 2 -> snd (g m)
1066 _ -> uncurry (+) (g m)
1067
1068 We want to give @g@ the demand @MCM(P(MP(L),1P(L)))@, so we see that in each call
1069 site of @g@, we are strict in the second component of the returned pair.
1070
1071 This relative cardinality leads to an otherwise unexpected call to 'lubSubDmd'
1072 in 'plusSubDmd', but if you do the math it's just the right thing.
1073
1074 There's one more subtlety: Since the nested demand is relative to exactly one
1075 call, in the case where we have *at most zero calls* (e.g. CA(...)), the premise
1076 is hurt and we can assume that the nested demand is 'botSubDmd'. That ensures
1077 that @g@ above actually gets the @1P(L)@ demand on its second pair component,
1078 rather than the lazy @MP(L)@ if we 'lub'bed with an absent demand.
1079
1080 Note [Computing one-shot info]
1081 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1082 Consider a call
1083 f (\pqr. e1) (\xyz. e2) e3
1084 where f has usage signature
1085 <CM(CL(CM(L)))><CM(L)><L>
1086 Then argsOneShots returns a [[OneShotInfo]] of
1087 [[OneShot,NoOneShotInfo,OneShot], [OneShot]]
1088 The occurrence analyser propagates this one-shot infor to the
1089 binders \pqr and \xyz;
1090 see Note [Use one-shot information] in "GHC.Core.Opt.OccurAnal".
1091
1092 Note [Boxity in Poly]
1093 ~~~~~~~~~~~~~~~~~~~~~
1094 To support Note [Boxity analysis], it makes sense that 'Prod' carries a
1095 'Boxity'. But why does 'Poly' have to carry a 'Boxity', too? Shouldn't all
1096 'Poly's be 'Boxed'? Couldn't we simply use 'Prod Unboxed' when we need to
1097 express an unboxing demand?
1098
1099 'botSubDmd' (B) needs to be the bottom of the lattice, so it needs to be an
1100 Unboxed demand. Similarly, 'seqSubDmd' (A) is an Unboxed demand.
1101 So why not say that Polys with absent cardinalities have Unboxed boxity?
1102 That doesn't work, because we also need the boxed equivalents. Here's an example
1103 for A (function 'absent' in T19871):
1104 ```
1105 f _ True = 1
1106 f a False = a `seq` 2
1107 -- demand on a: MA, the A is short for `Poly Boxed C_00`
1108
1109 g a = a `seq` f a True
1110 -- demand on a: SA, which is `Poly Boxed C_00`
1111
1112 h True p = g p -- SA on p (inherited from g)
1113 h False p@(x,y) = x+y -- S!P(1!L,1!L) on p
1114 ```
1115 (Caveat: Since Unboxed wins in lubBoxity, we'll unbox here anyway.)
1116 If A is treated as Unboxed, we get reboxing in the call site to 'g'.
1117 So we obviously would need a Boxed variant of A. Rather than introducing a lot
1118 of special cases, we just carry the Boxity in 'Poly'. Plus, we could most likely
1119 find examples like the above for any other cardinality.
1120
1121 Note [Why Boxity in SubDemand and not in Demand?]
1122 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1123 In #19871, we started out by storing 'Boxity' in 'SubDemand', in the 'Prod'
1124 constructor only. But then we found that we weren't able to express the unboxing
1125 'seqSubDmd', because that one really is a `Poly C_00` sub-demand.
1126 We then tried to store the Boxity in 'Demand' instead, for these reasons:
1127
1128 1. The whole boxity-of-seq business comes to a satisfying conclusion
1129 2. Putting Boxity in the SubDemand is weird to begin with, because it
1130 describes the box and not its fields, just as the evaluation cardinality
1131 of a Demand describes how often the box is used. It makes more sense that
1132 Card and Boxity travel together. Also the alternative would have been to
1133 store Boxity with Poly, which is even weirder and more redundant.
1134
1135 But then we regressed in T7837 (grep #19871 for boring specifics), which needed
1136 to transfer an ambient unboxed *demand* on a dictionary selector to its argument
1137 dictionary, via a 'Call' sub-demand `C1(sd)`, as
1138 Note [Demand transformer for a dictionary selector] explains. Annoyingly,
1139 the boxity info has to be stored in the *sub-demand* `sd`! There's no demand
1140 to store the boxity in. So we bit the bullet and now we store Boxity in
1141 'SubDemand', both in 'Prod' *and* 'Poly'. See also Note [Boxity in Poly].
1142 -}
1143
1144 {- *********************************************************************
1145 * *
1146 Divergence: Whether evaluation surely diverges
1147 * *
1148 ********************************************************************* -}
1149
1150 -- | 'Divergence' characterises whether something surely diverges.
1151 -- Models a subset lattice of the following exhaustive set of divergence
1152 -- results:
1153 --
1154 -- [n] nontermination (e.g. loops)
1155 -- [i] throws imprecise exception
1156 -- [p] throws precise exceTtion
1157 -- [c] converges (reduces to WHNF).
1158 --
1159 -- The different lattice elements correspond to different subsets, indicated by
1160 -- juxtaposition of indicators (e.g. __nc__ definitely doesn't throw an
1161 -- exception, and may or may not reduce to WHNF).
1162 --
1163 -- @
1164 -- Dunno (nipc)
1165 -- |
1166 -- ExnOrDiv (nip)
1167 -- |
1168 -- Diverges (ni)
1169 -- @
1170 --
1171 -- As you can see, we don't distinguish __n__ and __i__.
1172 -- See Note [Precise exceptions and strictness analysis] for why __p__ is so
1173 -- special compared to __i__.
1174 data Divergence
1175 = Diverges -- ^ Definitely throws an imprecise exception or diverges.
1176 | ExnOrDiv -- ^ Definitely throws a *precise* exception, an imprecise
1177 -- exception or diverges. Never converges, hence 'isDeadEndDiv'!
1178 -- See scenario 1 in Note [Precise exceptions and strictness analysis].
1179 | Dunno -- ^ Might diverge, throw any kind of exception or converge.
1180 deriving Eq
1181
1182 lubDivergence :: Divergence -> Divergence -> Divergence
1183 lubDivergence Diverges div = div
1184 lubDivergence div Diverges = div
1185 lubDivergence ExnOrDiv ExnOrDiv = ExnOrDiv
1186 lubDivergence _ _ = Dunno
1187 -- This needs to commute with defaultFvDmd, i.e.
1188 -- defaultFvDmd (r1 `lubDivergence` r2) = defaultFvDmd r1 `lubDmd` defaultFvDmd r2
1189 -- (See Note [Default demand on free variables and arguments] for why)
1190
1191 -- | See Note [Asymmetry of 'plus*'], which concludes that 'plusDivergence'
1192 -- needs to be symmetric.
1193 -- Strictly speaking, we should have @plusDivergence Dunno Diverges = ExnOrDiv@.
1194 -- But that regresses in too many places (every infinite loop, basically) to be
1195 -- worth it and is only relevant in higher-order scenarios
1196 -- (e.g. Divergence of @f (throwIO blah)@).
1197 -- So 'plusDivergence' currently is 'glbDivergence', really.
1198 plusDivergence :: Divergence -> Divergence -> Divergence
1199 plusDivergence Dunno Dunno = Dunno
1200 plusDivergence Diverges _ = Diverges
1201 plusDivergence _ Diverges = Diverges
1202 plusDivergence _ _ = ExnOrDiv
1203
1204 -- | In a non-strict scenario, we might not force the Divergence, in which case
1205 -- we might converge, hence Dunno.
1206 multDivergence :: Card -> Divergence -> Divergence
1207 multDivergence n _ | not (isStrict n) = Dunno
1208 multDivergence _ d = d
1209
1210 topDiv, exnDiv, botDiv :: Divergence
1211 topDiv = Dunno
1212 exnDiv = ExnOrDiv
1213 botDiv = Diverges
1214
1215 -- | True if the 'Divergence' indicates that evaluation will not return.
1216 -- See Note [Dead ends].
1217 isDeadEndDiv :: Divergence -> Bool
1218 isDeadEndDiv Diverges = True
1219 isDeadEndDiv ExnOrDiv = True
1220 isDeadEndDiv Dunno = False
1221
1222 -- See Notes [Default demand on free variables and arguments]
1223 -- and Scenario 1 in [Precise exceptions and strictness analysis]
1224 defaultFvDmd :: Divergence -> Demand
1225 defaultFvDmd Dunno = absDmd
1226 defaultFvDmd ExnOrDiv = absDmd -- This is the whole point of ExnOrDiv!
1227 defaultFvDmd Diverges = botDmd -- Diverges
1228
1229 defaultArgDmd :: Divergence -> Demand
1230 -- TopRes and BotRes are polymorphic, so that
1231 -- BotRes === (Bot -> BotRes) === ...
1232 -- TopRes === (Top -> TopRes) === ...
1233 -- This function makes that concrete
1234 -- Also see Note [Default demand on free variables and arguments]
1235 defaultArgDmd Dunno = topDmd
1236 -- NB: not botDmd! We don't want to mask the precise exception by forcing the
1237 -- argument. But it is still absent.
1238 defaultArgDmd ExnOrDiv = absDmd
1239 defaultArgDmd Diverges = botDmd
1240
1241 {- Note [Precise vs imprecise exceptions]
1242 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1243 An exception is considered to be /precise/ when it is thrown by the 'raiseIO#'
1244 primop. It follows that all other primops (such as 'raise#' or
1245 division-by-zero) throw /imprecise/ exceptions. Note that the actual type of
1246 the exception thrown doesn't have any impact!
1247
1248 GHC undertakes some effort not to apply an optimisation that would mask a
1249 /precise/ exception with some other source of nontermination, such as genuine
1250 divergence or an imprecise exception, so that the user can reliably
1251 intercept the precise exception with a catch handler before and after
1252 optimisations.
1253
1254 See also the wiki page on precise exceptions:
1255 https://gitlab.haskell.org/ghc/ghc/wikis/exceptions/precise-exceptions
1256 Section 5 of "Tackling the awkward squad" talks about semantic concerns.
1257 Imprecise exceptions are actually more interesting than precise ones (which are
1258 fairly standard) from the perspective of semantics. See the paper "A Semantics
1259 for Imprecise Exceptions" for more details.
1260
1261 Note [Dead ends]
1262 ~~~~~~~~~~~~~~~~
1263 We call an expression that either diverges or throws a precise or imprecise
1264 exception a "dead end". We used to call such an expression just "bottoming",
1265 but with the measures we take to preserve precise exception semantics
1266 (see Note [Precise exceptions and strictness analysis]), that is no longer
1267 accurate: 'exnDiv' is no longer the bottom of the Divergence lattice.
1268
1269 Yet externally to demand analysis, we mostly care about being able to drop dead
1270 code etc., which is all due to the property that such an expression never
1271 returns, hence we consider throwing a precise exception to be a dead end.
1272 See also 'isDeadEndDiv'.
1273
1274 Note [Precise exceptions and strictness analysis]
1275 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1276 We have to take care to preserve precise exception semantics in strictness
1277 analysis (#17676). There are two scenarios that need careful treatment.
1278
1279 The fixes were discussed at
1280 https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions
1281
1282 Recall that raiseIO# raises a *precise* exception, in contrast to raise# which
1283 raises an *imprecise* exception. See Note [Precise vs imprecise exceptions].
1284
1285 Scenario 1: Precise exceptions in case alternatives
1286 ---------------------------------------------------
1287 Unlike raise# (which returns botDiv), we want raiseIO# to return exnDiv.
1288 Here's why. Consider this example from #13380 (similarly #17676):
1289 f x y | x>0 = raiseIO# Exc
1290 | y>0 = return 1
1291 | otherwise = return 2
1292 Is 'f' strict in 'y'? One might be tempted to say yes! But that plays fast and
1293 loose with the precise exception; after optimisation, (f 42 (error "boom"))
1294 turns from throwing the precise Exc to throwing the imprecise user error
1295 "boom". So, the defaultFvDmd of raiseIO# should be lazy (topDmd), which can be
1296 achieved by giving it divergence exnDiv.
1297 See Note [Default demand on free variables and arguments].
1298
1299 Why don't we just give it topDiv instead of introducing exnDiv?
1300 Because then the simplifier will fail to discard raiseIO#'s continuation in
1301 case raiseIO# x s of { (# s', r #) -> <BIG> }
1302 which we'd like to optimise to
1303 case raiseIO# x s of {}
1304 Hence we came up with exnDiv. The default FV demand of exnDiv is lazy (and
1305 its default arg dmd is absent), but otherwise (in terms of 'isDeadEndDiv') it
1306 behaves exactly as botDiv, so that dead code elimination works as expected.
1307 This is tracked by T13380b.
1308
1309 Scenario 2: Precise exceptions in case scrutinees
1310 -------------------------------------------------
1311 Consider (more complete examples in #148, #1592, testcase strun003)
1312
1313 case foo x s of { (# s', r #) -> y }
1314
1315 Is this strict in 'y'? Often not! If @foo x s@ might throw a precise exception
1316 (ultimately via raiseIO#), then we must not force 'y', which may fail to
1317 terminate or throw an imprecise exception, until we have performed @foo x s@.
1318
1319 So we have to 'deferAfterPreciseException' (which 'lub's with 'exnDmdType' to
1320 model the exceptional control flow) when @foo x s@ may throw a precise
1321 exception. Motivated by T13380{d,e,f}.
1322 See Note [Which scrutinees may throw precise exceptions] in "GHC.Core.Opt.DmdAnal".
1323
1324 We have to be careful not to discard dead-end Divergence from case
1325 alternatives, though (#18086):
1326
1327 m = putStrLn "foo" >> error "bar"
1328
1329 'm' should still have 'exnDiv', which is why it is not sufficient to lub with
1330 'nopDmdType' (which has 'topDiv') in 'deferAfterPreciseException'.
1331
1332 Historical Note: This used to be called the "IO hack". But that term is rather
1333 a bad fit because
1334 1. It's easily confused with the "State hack", which also affects IO.
1335 2. Neither "IO" nor "hack" is a good description of what goes on here, which
1336 is deferring strictness results after possibly throwing a precise exception.
1337 The "hack" is probably not having to defer when we can prove that the
1338 expression may not throw a precise exception (increasing precision of the
1339 analysis), but that's just a favourable guess.
1340
1341 Note [Exceptions and strictness]
1342 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1343 We used to smart about catching exceptions, but we aren't anymore.
1344 See #14998 for the way it's resolved at the moment.
1345
1346 Here's a historic breakdown:
1347
1348 Apparently, exception handling prim-ops didn't use to have any special
1349 strictness signatures, thus defaulting to nopSig, which assumes they use their
1350 arguments lazily. Joachim was the first to realise that we could provide richer
1351 information. Thus, in 0558911f91c (Dec 13), he added signatures to
1352 primops.txt.pp indicating that functions like `catch#` and `catchRetry#` call
1353 their argument, which is useful information for usage analysis. Still with a
1354 'Lazy' strictness demand (i.e. 'lazyApply1Dmd'), though, and the world was fine.
1355
1356 In 7c0fff4 (July 15), Simon argued that giving `catch#` et al. a
1357 'strictApply1Dmd' leads to substantial performance gains. That was at the cost
1358 of correctness, as #10712 proved. So, back to 'lazyApply1Dmd' in
1359 28638dfe79e (Dec 15).
1360
1361 Motivated to reproduce the gains of 7c0fff4 without the breakage of #10712,
1362 Ben opened #11222. Simon made the demand analyser "understand catch" in
1363 9915b656 (Jan 16) by adding a new 'catchArgDmd', which basically said to call
1364 its argument strictly, but also swallow any thrown exceptions in
1365 'multDivergence'. This was realized by extending the 'Str' constructor of
1366 'ArgStr' with a 'ExnStr' field, indicating that it catches the exception, and
1367 adding a 'ThrowsExn' constructor to the 'Divergence' lattice as an element
1368 between 'Dunno' and 'Diverges'. Then along came #11555 and finally #13330,
1369 so we had to revert to 'lazyApply1Dmd' again in 701256df88c (Mar 17).
1370
1371 This left the other variants like 'catchRetry#' having 'catchArgDmd', which is
1372 where #14998 picked up. Item 1 was concerned with measuring the impact of also
1373 making `catchRetry#` and `catchSTM#` have 'lazyApply1Dmd'. The result was that
1374 there was none. We removed the last usages of 'catchArgDmd' in 00b8ecb7
1375 (Apr 18). There was a lot of dead code resulting from that change, that we
1376 removed in ef6b283 (Jan 19): We got rid of 'ThrowsExn' and 'ExnStr' again and
1377 removed any code that was dealing with the peculiarities.
1378
1379 Where did the speed-ups vanish to? In #14998, item 3 established that
1380 turning 'catch#' strict in its first argument didn't bring back any of the
1381 alleged performance benefits. Item 2 of that ticket finally found out that it
1382 was entirely due to 'catchException's new (since #11555) definition, which
1383 was simply
1384
1385 catchException !io handler = catch io handler
1386
1387 While 'catchException' is arguably the saner semantics for 'catch', it is an
1388 internal helper function in "GHC.IO". Its use in
1389 "GHC.IO.Handle.Internals.do_operation" made for the huge allocation differences:
1390 Remove the bang and you find the regressions we originally wanted to avoid with
1391 'catchArgDmd'. See also #exceptions_and_strictness# in "GHC.IO".
1392
1393 So history keeps telling us that the only possibly correct strictness annotation
1394 for the first argument of 'catch#' is 'lazyApply1Dmd', because 'catch#' really
1395 is not strict in its argument: Just try this in GHCi
1396
1397 :set -XScopedTypeVariables
1398 import Control.Exception
1399 catch undefined (\(_ :: SomeException) -> putStrLn "you'll see this")
1400
1401 Any analysis that assumes otherwise will be broken in some way or another
1402 (beyond `-fno-pendantic-bottoms`).
1403
1404 But then #13380 and #17676 suggest (in Mar 20) that we need to re-introduce a
1405 subtly different variant of `ThrowsExn` (which we call `ExnOrDiv` now) that is
1406 only used by `raiseIO#` in order to preserve precise exceptions by strictness
1407 analysis, while not impacting the ability to eliminate dead code.
1408 See Note [Precise exceptions and strictness analysis].
1409
1410 Note [Default demand on free variables and arguments]
1411 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1412 Free variables not mentioned in the environment of a 'DmdType'
1413 are demanded according to the demand type's Divergence:
1414 * In a Diverges (botDiv) context, that demand is botDmd
1415 (strict and absent).
1416 * In all other contexts, the demand is absDmd (lazy and absent).
1417 This is recorded in 'defaultFvDmd'.
1418
1419 Similarly, we can eta-expand demand types to get demands on excess arguments
1420 not accounted for in the type, by consulting 'defaultArgDmd':
1421 * In a Diverges (botDiv) context, that demand is again botDmd.
1422 * In a ExnOrDiv (exnDiv) context, that demand is absDmd: We surely diverge
1423 before evaluating the excess argument, but don't want to eagerly evaluate
1424 it (cf. Note [Precise exceptions and strictness analysis]).
1425 * In a Dunno context (topDiv), the demand is topDmd, because
1426 it's perfectly possible to enter the additional lambda and evaluate it
1427 in unforeseen ways (so, not absent).
1428
1429 Note [Bottom CPR iff Dead-Ending Divergence]
1430 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1431 Both CPR analysis and Demand analysis handle recursive functions by doing
1432 fixed-point iteration. To find the *least* (e.g., most informative) fixed-point,
1433 iteration starts with the bottom element of the semantic domain. Diverging
1434 functions generally have the bottom element as their least fixed-point.
1435
1436 One might think that CPR analysis and Demand analysis then agree in when a
1437 function gets a bottom denotation. E.g., whenever it has 'botCpr', it should
1438 also have 'botDiv'. But that is not the case, because strictness analysis has to
1439 be careful around precise exceptions, see Note [Precise vs imprecise exceptions].
1440
1441 So Demand analysis gives some diverging functions 'exnDiv' (which is *not* the
1442 bottom element) when the CPR signature says 'botCpr', and that's OK. Here's an
1443 example (from #18086) where that is the case:
1444
1445 ioTest :: IO ()
1446 ioTest = do
1447 putStrLn "hi"
1448 undefined
1449
1450 However, one can loosely say that we give a function 'botCpr' whenever its
1451 'Divergence' is 'exnDiv' or 'botDiv', i.e., dead-ending. But that's just
1452 a consequence of fixed-point iteration, it's not important that they agree.
1453
1454 ************************************************************************
1455 * *
1456 Demand environments and types
1457 * *
1458 ************************************************************************
1459 -}
1460
1461 -- Subject to Note [Default demand on free variables and arguments]
1462 type DmdEnv = VarEnv Demand
1463
1464 emptyDmdEnv :: DmdEnv
1465 emptyDmdEnv = emptyVarEnv
1466
1467 multDmdEnv :: Card -> DmdEnv -> DmdEnv
1468 multDmdEnv C_11 env = env
1469 multDmdEnv C_00 _ = emptyDmdEnv
1470 multDmdEnv n env = mapVarEnv (multDmd n) env
1471
1472 reuseEnv :: DmdEnv -> DmdEnv
1473 reuseEnv = multDmdEnv C_1N
1474
1475 -- | @keepAliveDmdType dt vs@ makes sure that the Ids in @vs@ have
1476 -- /some/ usage in the returned demand types -- they are not Absent.
1477 -- See Note [Absence analysis for stable unfoldings and RULES]
1478 -- in "GHC.Core.Opt.DmdAnal".
1479 keepAliveDmdEnv :: DmdEnv -> IdSet -> DmdEnv
1480 keepAliveDmdEnv env vs
1481 = nonDetStrictFoldVarSet add env vs
1482 where
1483 add :: Id -> DmdEnv -> DmdEnv
1484 add v env = extendVarEnv_C add_dmd env v topDmd
1485
1486 add_dmd :: Demand -> Demand -> Demand
1487 -- If the existing usage is Absent, make it used
1488 -- Otherwise leave it alone
1489 add_dmd dmd _ | isAbsDmd dmd = topDmd
1490 | otherwise = dmd
1491
1492 -- | Characterises how an expression
1493 -- * Evaluates its free variables ('dt_env')
1494 -- * Evaluates its arguments ('dt_args')
1495 -- * Diverges on every code path or not ('dt_div')
1496 data DmdType
1497 = DmdType
1498 { dt_env :: !DmdEnv -- ^ Demand on explicitly-mentioned free variables
1499 , dt_args :: ![Demand] -- ^ Demand on arguments
1500 , dt_div :: !Divergence -- ^ Whether evaluation diverges.
1501 -- See Note [Demand type Divergence]
1502 }
1503
1504 instance Eq DmdType where
1505 (==) (DmdType fv1 ds1 div1)
1506 (DmdType fv2 ds2 div2) = nonDetUFMToList fv1 == nonDetUFMToList fv2
1507 -- It's OK to use nonDetUFMToList here because we're testing for
1508 -- equality and even though the lists will be in some arbitrary
1509 -- Unique order, it is the same order for both
1510 && ds1 == ds2 && div1 == div2
1511
1512 -- | Compute the least upper bound of two 'DmdType's elicited /by the same
1513 -- incoming demand/!
1514 lubDmdType :: DmdType -> DmdType -> DmdType
1515 lubDmdType d1 d2
1516 = DmdType lub_fv lub_ds lub_div
1517 where
1518 n = max (dmdTypeDepth d1) (dmdTypeDepth d2)
1519 (DmdType fv1 ds1 r1) = etaExpandDmdType n d1
1520 (DmdType fv2 ds2 r2) = etaExpandDmdType n d2
1521
1522 lub_fv = plusVarEnv_CD lubDmd fv1 (defaultFvDmd r1) fv2 (defaultFvDmd r2)
1523 lub_ds = zipWithEqual "lubDmdType" lubDmd ds1 ds2
1524 lub_div = lubDivergence r1 r2
1525
1526 type PlusDmdArg = (DmdEnv, Divergence)
1527
1528 mkPlusDmdArg :: DmdEnv -> PlusDmdArg
1529 mkPlusDmdArg env = (env, topDiv)
1530
1531 toPlusDmdArg :: DmdType -> PlusDmdArg
1532 toPlusDmdArg (DmdType fv _ r) = (fv, r)
1533
1534 plusDmdType :: DmdType -> PlusDmdArg -> DmdType
1535 plusDmdType (DmdType fv1 ds1 r1) (fv2, t2)
1536 -- See Note [Asymmetry of 'plus*']
1537 -- 'plus' takes the argument/result info from its *first* arg,
1538 -- using its second arg just for its free-var info.
1539 | isEmptyVarEnv fv2, defaultFvDmd t2 == absDmd
1540 = DmdType fv1 ds1 (r1 `plusDivergence` t2) -- a very common case that is much more efficient
1541 | otherwise
1542 = DmdType (plusVarEnv_CD plusDmd fv1 (defaultFvDmd r1) fv2 (defaultFvDmd t2))
1543 ds1
1544 (r1 `plusDivergence` t2)
1545
1546 botDmdType :: DmdType
1547 botDmdType = DmdType emptyDmdEnv [] botDiv
1548
1549 -- | The demand type of doing nothing (lazy, absent, no Divergence
1550 -- information). Note that it is ''not'' the top of the lattice (which would be
1551 -- "may use everything"), so it is (no longer) called topDmdType.
1552 nopDmdType :: DmdType
1553 nopDmdType = DmdType emptyDmdEnv [] topDiv
1554
1555 isTopDmdType :: DmdType -> Bool
1556 isTopDmdType (DmdType env args div)
1557 = div == topDiv && null args && isEmptyVarEnv env
1558
1559 -- | The demand type of an unspecified expression that is guaranteed to
1560 -- throw a (precise or imprecise) exception or diverge.
1561 exnDmdType :: DmdType
1562 exnDmdType = DmdType emptyDmdEnv [] exnDiv
1563
1564 dmdTypeDepth :: DmdType -> Arity
1565 dmdTypeDepth = length . dt_args
1566
1567 -- | This makes sure we can use the demand type with n arguments after eta
1568 -- expansion, where n must not be lower than the demand types depth.
1569 -- It appends the argument list with the correct 'defaultArgDmd'.
1570 etaExpandDmdType :: Arity -> DmdType -> DmdType
1571 etaExpandDmdType n d@DmdType{dt_args = ds, dt_div = div}
1572 | n == depth = d
1573 | n > depth = d{dt_args = inc_ds}
1574 | otherwise = pprPanic "etaExpandDmdType: arity decrease" (ppr n $$ ppr d)
1575 where depth = length ds
1576 -- Arity increase:
1577 -- * Demands on FVs are still valid
1578 -- * Demands on args also valid, plus we can extend with defaultArgDmd
1579 -- as appropriate for the given Divergence
1580 -- * Divergence is still valid:
1581 -- - A dead end after 2 arguments stays a dead end after 3 arguments
1582 -- - The remaining case is Dunno, which is already topDiv
1583 inc_ds = take n (ds ++ repeat (defaultArgDmd div))
1584
1585 -- | A conservative approximation for a given 'DmdType' in case of an arity
1586 -- decrease. Currently, it's just nopDmdType.
1587 decreaseArityDmdType :: DmdType -> DmdType
1588 decreaseArityDmdType _ = nopDmdType
1589
1590 splitDmdTy :: DmdType -> (Demand, DmdType)
1591 -- Split off one function argument
1592 -- We already have a suitable demand on all
1593 -- free vars, so no need to add more!
1594 splitDmdTy ty@DmdType{dt_args=dmd:args} = (dmd, ty{dt_args=args})
1595 splitDmdTy ty@DmdType{dt_div=div} = (defaultArgDmd div, ty)
1596
1597 multDmdType :: Card -> DmdType -> DmdType
1598 multDmdType n (DmdType fv args res_ty)
1599 = -- pprTrace "multDmdType" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $
1600 DmdType (multDmdEnv n fv)
1601 (map (multDmd n) args)
1602 (multDivergence n res_ty)
1603
1604 peelFV :: DmdType -> Var -> (DmdType, Demand)
1605 peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
1606 (DmdType fv' ds res, dmd)
1607 where
1608 -- Force these arguments so that old `Env` is not retained.
1609 !fv' = fv `delVarEnv` id
1610 -- See Note [Default demand on free variables and arguments]
1611 !dmd = lookupVarEnv fv id `orElse` defaultFvDmd res
1612
1613 addDemand :: Demand -> DmdType -> DmdType
1614 addDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res
1615
1616 findIdDemand :: DmdType -> Var -> Demand
1617 findIdDemand (DmdType fv _ res) id
1618 = lookupVarEnv fv id `orElse` defaultFvDmd res
1619
1620 -- | When e is evaluated after executing an IO action that may throw a precise
1621 -- exception, we act as if there is an additional control flow path that is
1622 -- taken if e throws a precise exception. The demand type of this control flow
1623 -- path
1624 -- * is lazy and absent ('topDmd') in all free variables and arguments
1625 -- * has 'exnDiv' 'Divergence' result
1626 -- So we can simply take a variant of 'nopDmdType', 'exnDmdType'.
1627 -- Why not 'nopDmdType'? Because then the result of 'e' can never be 'exnDiv'!
1628 -- That means failure to drop dead-ends, see #18086.
1629 -- See Note [Precise exceptions and strictness analysis]
1630 deferAfterPreciseException :: DmdType -> DmdType
1631 deferAfterPreciseException = lubDmdType exnDmdType
1632
1633 -- | See 'keepAliveDmdEnv'.
1634 keepAliveDmdType :: DmdType -> VarSet -> DmdType
1635 keepAliveDmdType (DmdType fvs ds res) vars =
1636 DmdType (fvs `keepAliveDmdEnv` vars) ds res
1637
1638 {-
1639 Note [Demand type Divergence]
1640 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1641 In contrast to DmdSigs, DmdTypes are elicited under a specific incoming demand.
1642 This is described in detail in Note [Understanding DmdType and DmdSig].
1643 Here, we'll focus on what that means for a DmdType's Divergence in a higher-order
1644 scenario.
1645
1646 Consider
1647 err x y = x `seq` y `seq` error (show x)
1648 this has a strictness signature of
1649 <1L><1L>b
1650 meaning that we don't know what happens when we call err in weaker contexts than
1651 C1(C1(L)), like @err `seq` ()@ (1A) and @err 1 `seq` ()@ (CS(A)). We
1652 may not unleash the botDiv, hence assume topDiv. Of course, in
1653 @err 1 2 `seq` ()@ the incoming demand CS(CS(A)) is strong enough and we see
1654 that the expression diverges.
1655
1656 Now consider a function
1657 f g = g 1 2
1658 with signature <C1(C1(L))>, and the expression
1659 f err `seq` ()
1660 now f puts a strictness demand of C1(C1(L)) onto its argument, which is unleashed
1661 on err via the App rule. In contrast to weaker head strictness, this demand is
1662 strong enough to unleash err's signature and hence we see that the whole
1663 expression diverges!
1664
1665 Note [Asymmetry of 'plus*']
1666 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1667 'plus' for DmdTypes is *asymmetrical*, because there can only one
1668 be one type contributing argument demands! For example, given (e1 e2), we get
1669 a DmdType dt1 for e1, use its arg demand to analyse e2 giving dt2, and then do
1670 (dt1 `plusType` dt2). Similarly with
1671 case e of { p -> rhs }
1672 we get dt_scrut from the scrutinee and dt_rhs from the RHS, and then
1673 compute (dt_rhs `plusType` dt_scrut).
1674
1675 We
1676 1. combine the information on the free variables,
1677 2. take the demand on arguments from the first argument
1678 3. combine the termination results, as in plusDivergence.
1679
1680 Since we don't use argument demands of the second argument anyway, 'plus's
1681 second argument is just a 'PlusDmdType'.
1682
1683 But note that the argument demand types are not guaranteed to be observed in
1684 left to right order. For example, analysis of a case expression will pass the
1685 demand type for the alts as the left argument and the type for the scrutinee as
1686 the right argument. Also, it is not at all clear if there is such an order;
1687 consider the LetUp case, where the RHS might be forced at any point while
1688 evaluating the let body.
1689 Therefore, it is crucial that 'plusDivergence' is symmetric!
1690
1691 Note [Demands from unsaturated function calls]
1692 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1693 Consider a demand transformer d1 -> d2 -> r for f.
1694 If a sufficiently detailed demand is fed into this transformer,
1695 e.g <C1(C1(L))> arising from "f x1 x2" in a strict, use-once context,
1696 then d1 and d2 is precisely the demand unleashed onto x1 and x2 (similar for
1697 the free variable environment) and furthermore the result information r is the
1698 one we want to use.
1699
1700 An anonymous lambda is also an unsaturated function all (needs one argument,
1701 none given), so this applies to that case as well.
1702
1703 But the demand fed into f might be less than C1(C1(L)). Then we have to
1704 'multDmdType' the announced demand type. Examples:
1705 * Not strict enough, e.g. C1(C1(L)):
1706 - We have to multiply all argument and free variable demands with C_01,
1707 zapping strictness.
1708 - We have to multiply divergence with C_01. If r says that f Diverges for sure,
1709 then this holds when the demand guarantees that two arguments are going to
1710 be passed. If the demand is lower, we may just as well converge.
1711 If we were tracking definite convergence, than that would still hold under
1712 a weaker demand than expected by the demand transformer.
1713 * Used more than once, e.g. CS(C1(L)):
1714 - Multiply with C_1N. Even if f puts a used-once demand on any of its argument
1715 or free variables, if we call f multiple times, we may evaluate this
1716 argument or free variable multiple times.
1717
1718 In dmdTransformSig, we call peelManyCalls to find out the 'Card'inality with
1719 which we have to multiply and then call multDmdType with that.
1720
1721 Similarly, dmdTransformDictSelSig and dmdAnal, when analyzing a Lambda, use
1722 peelCallDmd, which peels only one level, but also returns the demand put on the
1723 body of the function.
1724 -}
1725
1726
1727 {-
1728 ************************************************************************
1729 * *
1730 Demand signatures
1731 * *
1732 ************************************************************************
1733
1734 In a let-bound Id we record its demand signature.
1735 In principle, this demand signature is a demand transformer, mapping
1736 a demand on the Id into a DmdType, which gives
1737 a) the free vars of the Id's value
1738 b) the Id's arguments
1739 c) an indication of the result of applying
1740 the Id to its arguments
1741
1742 However, in fact we store in the Id an extremely emascuated demand
1743 transfomer, namely
1744
1745 a single DmdType
1746 (Nevertheless we dignify DmdSig as a distinct type.)
1747
1748 This DmdType gives the demands unleashed by the Id when it is applied
1749 to as many arguments as are given in by the arg demands in the DmdType.
1750 Also see Note [Demand type Divergence] for the meaning of a Divergence in a
1751 strictness signature.
1752
1753 If an Id is applied to less arguments than its arity, it means that
1754 the demand on the function at a call site is weaker than the vanilla
1755 call demand, used for signature inference. Therefore we place a top
1756 demand on all arguments. Otherwise, the demand is specified by Id's
1757 signature.
1758
1759 For example, the demand transformer described by the demand signature
1760 DmdSig (DmdType {x -> <1L>} <A><1P(L,L)>)
1761 says that when the function is applied to two arguments, it
1762 unleashes demand 1L on the free var x, A on the first arg,
1763 and 1P(L,L) on the second.
1764
1765 If this same function is applied to one arg, all we can say is that it
1766 uses x with 1L, and its arg with demand 1P(L,L).
1767
1768 Note [Understanding DmdType and DmdSig]
1769 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1770 Demand types are sound approximations of an expression's semantics relative to
1771 the incoming demand we put the expression under. Consider the following
1772 expression:
1773
1774 \x y -> x `seq` (y, 2*x)
1775
1776 Here is a table with demand types resulting from different incoming demands we
1777 put that expression under. Note the monotonicity; a stronger incoming demand
1778 yields a more precise demand type:
1779
1780 incoming demand | demand type
1781 --------------------------------
1782 1A | <L><L>{}
1783 C1(C1(L)) | <1P(L)><L>{}
1784 C1(C1(1P(1P(L),A))) | <1P(A)><A>{}
1785
1786 Note that in the first example, the depth of the demand type was *higher* than
1787 the arity of the incoming call demand due to the anonymous lambda.
1788 The converse is also possible and happens when we unleash demand signatures.
1789 In @f x y@, the incoming call demand on f has arity 2. But if all we have is a
1790 demand signature with depth 1 for @f@ (which we can safely unleash, see below),
1791 the demand type of @f@ under a call demand of arity 2 has a *lower* depth of 1.
1792
1793 So: Demand types are elicited by putting an expression under an incoming (call)
1794 demand, the arity of which can be lower or higher than the depth of the
1795 resulting demand type.
1796 In contrast, a demand signature summarises a function's semantics *without*
1797 immediately specifying the incoming demand it was produced under. Despite StrSig
1798 being a newtype wrapper around DmdType, it actually encodes two things:
1799
1800 * The threshold (i.e., minimum arity) to unleash the signature
1801 * A demand type that is sound to unleash when the minimum arity requirement is
1802 met.
1803
1804 Here comes the subtle part: The threshold is encoded in the wrapped demand
1805 type's depth! So in mkDmdSigForArity we make sure to trim the list of
1806 argument demands to the given threshold arity. Call sites will make sure that
1807 this corresponds to the arity of the call demand that elicited the wrapped
1808 demand type. See also Note [What are demand signatures?].
1809 -}
1810
1811 -- | The depth of the wrapped 'DmdType' encodes the arity at which it is safe
1812 -- to unleash. Better construct this through 'mkDmdSigForArity'.
1813 -- See Note [Understanding DmdType and DmdSig]
1814 newtype DmdSig
1815 = DmdSig DmdType
1816 deriving Eq
1817
1818 -- | Turns a 'DmdType' computed for the particular 'Arity' into a 'DmdSig'
1819 -- unleashable at that arity. See Note [Understanding DmdType and DmdSig].
1820 mkDmdSigForArity :: Arity -> DmdType -> DmdSig
1821 mkDmdSigForArity arity dmd_ty@(DmdType fvs args div)
1822 | arity < dmdTypeDepth dmd_ty = DmdSig $ DmdType fvs (take arity args) div
1823 | otherwise = DmdSig (etaExpandDmdType arity dmd_ty)
1824
1825 mkClosedDmdSig :: [Demand] -> Divergence -> DmdSig
1826 mkClosedDmdSig ds res = mkDmdSigForArity (length ds) (DmdType emptyDmdEnv ds res)
1827
1828 splitDmdSig :: DmdSig -> ([Demand], Divergence)
1829 splitDmdSig (DmdSig (DmdType _ dmds res)) = (dmds, res)
1830
1831 dmdSigDmdEnv :: DmdSig -> DmdEnv
1832 dmdSigDmdEnv (DmdSig (DmdType env _ _)) = env
1833
1834 hasDemandEnvSig :: DmdSig -> Bool
1835 hasDemandEnvSig = not . isEmptyVarEnv . dmdSigDmdEnv
1836
1837 botSig :: DmdSig
1838 botSig = DmdSig botDmdType
1839
1840 nopSig :: DmdSig
1841 nopSig = DmdSig nopDmdType
1842
1843 isTopSig :: DmdSig -> Bool
1844 isTopSig (DmdSig ty) = isTopDmdType ty
1845
1846 -- | True if the signature diverges or throws an exception in a saturated call.
1847 -- See Note [Dead ends].
1848 isDeadEndSig :: DmdSig -> Bool
1849 isDeadEndSig (DmdSig (DmdType _ _ res)) = isDeadEndDiv res
1850
1851 -- | Returns true if an application to n args would diverge or throw an
1852 -- exception.
1853 --
1854 -- If a function having 'botDiv' is applied to a less number of arguments than
1855 -- its syntactic arity, we cannot say for sure that it is going to diverge.
1856 -- Hence this function conservatively returns False in that case.
1857 -- See Note [Dead ends].
1858 appIsDeadEnd :: DmdSig -> Int -> Bool
1859 appIsDeadEnd (DmdSig (DmdType _ ds res)) n
1860 = isDeadEndDiv res && not (lengthExceeds ds n)
1861
1862 prependArgsDmdSig :: Int -> DmdSig -> DmdSig
1863 -- ^ Add extra ('topDmd') arguments to a strictness signature.
1864 -- In contrast to 'etaConvertDmdSig', this /prepends/ additional argument
1865 -- demands. This is used by FloatOut.
1866 prependArgsDmdSig new_args sig@(DmdSig dmd_ty@(DmdType env dmds res))
1867 | new_args == 0 = sig
1868 | isTopDmdType dmd_ty = sig
1869 | new_args < 0 = pprPanic "prependArgsDmdSig: negative new_args"
1870 (ppr new_args $$ ppr sig)
1871 | otherwise = DmdSig (DmdType env dmds' res)
1872 where
1873 dmds' = replicate new_args topDmd ++ dmds
1874
1875 etaConvertDmdSig :: Arity -> DmdSig -> DmdSig
1876 -- ^ We are expanding (\x y. e) to (\x y z. e z) or reducing from the latter to
1877 -- the former (when the Simplifier identifies a new join points, for example).
1878 -- In contrast to 'prependArgsDmdSig', this /appends/ extra arg demands if
1879 -- necessary.
1880 -- This works by looking at the 'DmdType' (which was produced under a call
1881 -- demand for the old arity) and trying to transfer as many facts as we can to
1882 -- the call demand of new arity.
1883 -- An arity increase (resulting in a stronger incoming demand) can retain much
1884 -- of the info, while an arity decrease (a weakening of the incoming demand)
1885 -- must fall back to a conservative default.
1886 etaConvertDmdSig arity (DmdSig dmd_ty)
1887 | arity < dmdTypeDepth dmd_ty = DmdSig $ decreaseArityDmdType dmd_ty
1888 | otherwise = DmdSig $ etaExpandDmdType arity dmd_ty
1889
1890 {-
1891 ************************************************************************
1892 * *
1893 Demand transformers
1894 * *
1895 ************************************************************************
1896 -}
1897
1898 -- | A /demand transformer/ is a monotone function from an incoming evaluation
1899 -- context ('SubDemand') to a 'DmdType', describing how the denoted thing
1900 -- (i.e. expression, function) uses its arguments and free variables, and
1901 -- whether it diverges.
1902 --
1903 -- See Note [Understanding DmdType and DmdSig]
1904 -- and Note [What are demand signatures?].
1905 type DmdTransformer = SubDemand -> DmdType
1906
1907 -- | Extrapolate a demand signature ('DmdSig') into a 'DmdTransformer'.
1908 --
1909 -- Given a function's 'DmdSig' and a 'SubDemand' for the evaluation context,
1910 -- return how the function evaluates its free variables and arguments.
1911 dmdTransformSig :: DmdSig -> DmdTransformer
1912 dmdTransformSig (DmdSig dmd_ty@(DmdType _ arg_ds _)) sd
1913 = multDmdType (peelManyCalls (length arg_ds) sd) dmd_ty
1914 -- see Note [Demands from unsaturated function calls]
1915 -- and Note [What are demand signatures?]
1916
1917 -- | A special 'DmdTransformer' for data constructors that feeds product
1918 -- demands into the constructor arguments.
1919 dmdTransformDataConSig :: Arity -> DmdTransformer
1920 dmdTransformDataConSig arity sd = case go arity sd of
1921 Just dmds -> DmdType emptyDmdEnv dmds topDiv
1922 Nothing -> nopDmdType -- Not saturated
1923 where
1924 go 0 sd = snd <$> viewProd arity sd
1925 go n (Call C_11 sd) = go (n-1) sd -- strict calls only!
1926 go _ _ = Nothing
1927
1928 -- | A special 'DmdTransformer' for dictionary selectors that feeds the demand
1929 -- on the result into the indicated dictionary component (if saturated).
1930 -- See Note [Demand transformer for a dictionary selector].
1931 dmdTransformDictSelSig :: DmdSig -> DmdTransformer
1932 -- NB: This currently doesn't handle newtype dictionaries.
1933 -- It should simply apply call_sd directly to the dictionary, I suppose.
1934 dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod] _)) call_sd
1935 | (n, sd') <- peelCallDmd call_sd
1936 , Prod _ sig_ds <- prod
1937 = multDmdType n $
1938 DmdType emptyDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)] topDiv
1939 | otherwise
1940 = nopDmdType -- See Note [Demand transformer for a dictionary selector]
1941 where
1942 enhance _ AbsDmd = AbsDmd
1943 enhance _ BotDmd = BotDmd
1944 enhance sd _dmd_var = C_11 :* sd -- This is the one!
1945 -- C_11, because we multiply with n above
1946 dmdTransformDictSelSig sig sd = pprPanic "dmdTransformDictSelSig: no args" (ppr sig $$ ppr sd)
1947
1948 {-
1949 Note [What are demand signatures?]
1950 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1951 Demand analysis interprets expressions in the abstract domain of demand
1952 transformers. Given a (sub-)demand that denotes the evaluation context, the
1953 abstract transformer of an expression gives us back a demand type denoting
1954 how other things (like arguments and free vars) were used when the expression
1955 was evaluated. Here's an example:
1956
1957 f x y =
1958 if x + expensive
1959 then \z -> z + y * ...
1960 else \z -> z * ...
1961
1962 The abstract transformer (let's call it F_e) of the if expression (let's
1963 call it e) would transform an incoming (undersaturated!) head demand 1A into
1964 a demand type like {x-><1L>,y-><L>}<L>. In pictures:
1965
1966 Demand ---F_e---> DmdType
1967 <1A> {x-><1L>,y-><L>}<L>
1968
1969 Let's assume that the demand transformers we compute for an expression are
1970 correct wrt. to some concrete semantics for Core. How do demand signatures fit
1971 in? They are strange beasts, given that they come with strict rules when to
1972 it's sound to unleash them.
1973
1974 Fortunately, we can formalise the rules with Galois connections. Consider
1975 f's strictness signature, {}<1L><L>. It's a single-point approximation of
1976 the actual abstract transformer of f's RHS for arity 2. So, what happens is that
1977 we abstract *once more* from the abstract domain we already are in, replacing
1978 the incoming Demand by a simple lattice with two elements denoting incoming
1979 arity: A_2 = {<2, >=2} (where '<2' is the top element and >=2 the bottom
1980 element). Here's the diagram:
1981
1982 A_2 -----f_f----> DmdType
1983 ^ |
1984 | α γ |
1985 | v
1986 SubDemand --F_f----> DmdType
1987
1988 With
1989 α(C1(C1(_))) = >=2
1990 α(_) = <2
1991 γ(ty) = ty
1992 and F_f being the abstract transformer of f's RHS and f_f being the abstracted
1993 abstract transformer computable from our demand signature simply by
1994
1995 f_f(>=2) = {}<1L><L>
1996 f_f(<2) = multDmdType C_0N {}<1L><L>
1997
1998 where multDmdType makes a proper top element out of the given demand type.
1999
2000 In practice, the A_n domain is not just a simple Bool, but a Card, which is
2001 exactly the Card with which we have to multDmdType. The Card for arity n
2002 is computed by calling @peelManyCalls n@, which corresponds to α above.
2003
2004 Note [Demand transformer for a dictionary selector]
2005 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2006 Suppose we have a superclass selector 'sc_sel' and a class method
2007 selector 'op_sel', and a function that uses both, like this
2008
2009 -- Strictness sig: 1P(1,A)
2010 sc_sel (x,y) = x
2011
2012 -- Strictness sig: 1P(A,1)
2013 op_sel (p,q)= q
2014
2015 f d v = op_sel (sc_sel d) v
2016
2017 What do we learn about the demand on 'd'? Alas, we see only the
2018 demand from 'sc_sel', namely '1P(1,A)'. We /don't/ see that 'd' really has a nested
2019 demand '1P(1P(A,1C1(1)),A)'. On the other hand, if we inlined the two selectors
2020 we'd have
2021
2022 f d x = case d of (x,_) ->
2023 case x of (_,q) ->
2024 q v
2025
2026 If we analyse that, we'll get a richer, nested demand on 'd'.
2027
2028 We want to behave /as if/ we'd inlined 'op_sel' and 'sc_sel'. We can do this
2029 easily by building a richer demand transformer for dictionary selectors than
2030 is expressible by a regular demand signature.
2031 And that is what 'dmdTransformDictSelSig' does: it transforms the demand on the
2032 result to a demand on the (single) argument.
2033
2034 How does it do that?
2035 If we evaluate (op dict-expr) under demand 'd', then we can push the demand 'd'
2036 into the appropriate field of the dictionary. What *is* the appropriate field?
2037 We just look at the strictness signature of the class op, which will be
2038 something like: P(AAA1AAAAA). Then replace the '1' (or any other non-absent
2039 demand, really) by the demand 'd'. The '1' acts as if it was a demand variable,
2040 the whole signature really means `\d. P(AAAdAAAAA)` for any incoming
2041 demand 'd'.
2042
2043 For single-method classes, which are represented by newtypes the signature
2044 of 'op' won't look like P(...), so matching on Prod will fail.
2045 That's fine: if we are doing strictness analysis we are also doing inlining,
2046 so we'll have inlined 'op' into a cast. So we can bale out in a conservative
2047 way, returning nopDmdType. SG: Although we then probably want to apply the eval
2048 demand 'd' directly to 'op' rather than turning it into 'topSubDmd'...
2049
2050 It is (just.. #8329) possible to be running strictness analysis *without*
2051 having inlined class ops from single-method classes. Suppose you are using
2052 ghc --make; and the first module has a local -O0 flag. So you may load a class
2053 without interface pragmas, ie (currently) without an unfolding for the class
2054 ops. Now if a subsequent module in the --make sweep has a local -O flag
2055 you might do strictness analysis, but there is no inlining for the class op.
2056 This is weird, so I'm not worried about whether this optimises brilliantly; but
2057 it should not fall over.
2058 -}
2059
2060 -- | Remove the demand environment from the signature.
2061 zapDmdEnvSig :: DmdSig -> DmdSig
2062 zapDmdEnvSig (DmdSig (DmdType _ ds r)) = mkClosedDmdSig ds r
2063
2064 zapUsageDemand :: Demand -> Demand
2065 -- Remove the usage info, but not the strictness info, from the demand
2066 zapUsageDemand = kill_usage $ KillFlags
2067 { kf_abs = True
2068 , kf_used_once = True
2069 , kf_called_once = True
2070 }
2071
2072 -- | Remove all `C_01 :*` info (but not `CM` sub-demands) from the demand
2073 zapUsedOnceDemand :: Demand -> Demand
2074 zapUsedOnceDemand = kill_usage $ KillFlags
2075 { kf_abs = False
2076 , kf_used_once = True
2077 , kf_called_once = False
2078 }
2079
2080 -- | Remove all `C_01 :*` info (but not `CM` sub-demands) from the strictness
2081 -- signature
2082 zapUsedOnceSig :: DmdSig -> DmdSig
2083 zapUsedOnceSig (DmdSig (DmdType env ds r))
2084 = DmdSig (DmdType env (map zapUsedOnceDemand ds) r)
2085
2086 data KillFlags = KillFlags
2087 { kf_abs :: Bool
2088 , kf_used_once :: Bool
2089 , kf_called_once :: Bool
2090 }
2091
2092 kill_usage_card :: KillFlags -> Card -> Card
2093 kill_usage_card kfs C_00 | kf_abs kfs = C_0N
2094 kill_usage_card kfs C_10 | kf_abs kfs = C_1N
2095 kill_usage_card kfs C_01 | kf_used_once kfs = C_0N
2096 kill_usage_card kfs C_11 | kf_used_once kfs = C_1N
2097 kill_usage_card _ n = n
2098
2099 kill_usage :: KillFlags -> Demand -> Demand
2100 kill_usage _ AbsDmd = AbsDmd
2101 kill_usage _ BotDmd = BotDmd
2102 kill_usage kfs (n :* sd) = kill_usage_card kfs n :* kill_usage_sd kfs sd
2103
2104 kill_usage_sd :: KillFlags -> SubDemand -> SubDemand
2105 kill_usage_sd kfs (Call n sd)
2106 | kf_called_once kfs = mkCall (lubCard C_1N n) (kill_usage_sd kfs sd)
2107 | otherwise = mkCall n (kill_usage_sd kfs sd)
2108 kill_usage_sd kfs (Prod b ds) = mkProd b (map (kill_usage kfs) ds)
2109 kill_usage_sd _ sd = sd
2110
2111 {- *********************************************************************
2112 * *
2113 TypeShape and demand trimming
2114 * *
2115 ********************************************************************* -}
2116
2117
2118 data TypeShape -- See Note [Trimming a demand to a type]
2119 -- in GHC.Core.Opt.DmdAnal
2120 = TsFun TypeShape
2121 | TsProd [TypeShape]
2122 | TsUnk
2123
2124 trimToType :: Demand -> TypeShape -> Demand
2125 -- See Note [Trimming a demand to a type] in GHC.Core.Opt.DmdAnal
2126 trimToType AbsDmd _ = AbsDmd
2127 trimToType BotDmd _ = BotDmd
2128 trimToType (n :* sd) ts
2129 = n :* go sd ts
2130 where
2131 go (Prod b ds) (TsProd tss)
2132 | equalLength ds tss = mkProd b (zipWith trimToType ds tss)
2133 go (Call n sd) (TsFun ts) = mkCall n (go sd ts)
2134 go sd@Poly{} _ = sd
2135 go _ _ = topSubDmd
2136
2137 -- | Drop all boxity
2138 trimBoxity :: Demand -> Demand
2139 trimBoxity AbsDmd = AbsDmd
2140 trimBoxity BotDmd = BotDmd
2141 trimBoxity (n :* sd) = n :* go sd
2142 where
2143 go (Poly _ n) = Poly Boxed n
2144 go (Prod _ ds) = mkProd Boxed (map trimBoxity ds)
2145 go (Call n sd) = mkCall n $ go sd
2146
2147 {-
2148 ************************************************************************
2149 * *
2150 'seq'ing demands
2151 * *
2152 ************************************************************************
2153 -}
2154
2155 seqDemand :: Demand -> ()
2156 seqDemand AbsDmd = ()
2157 seqDemand BotDmd = ()
2158 seqDemand (_ :* sd) = seqSubDemand sd
2159
2160 seqSubDemand :: SubDemand -> ()
2161 seqSubDemand (Prod _ ds) = seqDemandList ds
2162 seqSubDemand (Call _ sd) = seqSubDemand sd
2163 seqSubDemand (Poly _ _) = ()
2164
2165 seqDemandList :: [Demand] -> ()
2166 seqDemandList = foldr (seq . seqDemand) ()
2167
2168 seqDmdType :: DmdType -> ()
2169 seqDmdType (DmdType env ds res) =
2170 seqDmdEnv env `seq` seqDemandList ds `seq` res `seq` ()
2171
2172 seqDmdEnv :: DmdEnv -> ()
2173 seqDmdEnv env = seqEltsUFM seqDemand env
2174
2175 seqDmdSig :: DmdSig -> ()
2176 seqDmdSig (DmdSig ty) = seqDmdType ty
2177
2178 {-
2179 ************************************************************************
2180 * *
2181 Outputable and Binary instances
2182 * *
2183 ************************************************************************
2184 -}
2185
2186 -- Just for debugging purposes.
2187 instance Show Card where
2188 show C_00 = "C_00"
2189 show C_01 = "C_01"
2190 show C_0N = "C_0N"
2191 show C_10 = "C_10"
2192 show C_11 = "C_11"
2193 show C_1N = "C_1N"
2194
2195 {- Note [Demand notation]
2196 ~~~~~~~~~~~~~~~~~~~~~~~~~
2197 This Note should be kept up to date with the documentation of `-fstrictness`
2198 in the user's guide.
2199
2200 For pretty-printing demands, we use quite a compact notation with some
2201 abbreviations. Here's the BNF:
2202
2203 card ::= B {}
2204 | A {0}
2205 | M {0,1}
2206 | L {0,1,n}
2207 | 1 {1}
2208 | S {1,n}
2209
2210 box ::= ! Unboxed
2211 | <empty> Boxed
2212
2213 d ::= card sd The :* constructor, just juxtaposition
2214 | card abbreviation: Same as "card card"
2215
2216 sd ::= box card @Poly box card@
2217 | box P(d,d,..) @Prod box [d1,d2,..]@
2218 | Ccard(sd) @Call card sd@
2219
2220 So, L can denote a 'Card', polymorphic 'SubDemand' or polymorphic 'Demand',
2221 but it's always clear from context which "overload" is meant. It's like
2222 return-type inference of e.g. 'read'.
2223
2224 Examples are in the haddock for 'Demand'.
2225
2226 This is the syntax for demand signatures:
2227
2228 div ::= <empty> topDiv
2229 | x exnDiv
2230 | b botDiv
2231
2232 sig ::= {x->dx,y->dy,z->dz...}<d1><d2><d3>...<dn>div
2233 ^ ^ ^ ^ ^ ^
2234 | | | | | |
2235 | \---+---+------/ |
2236 | | |
2237 demand on free demand on divergence
2238 variables arguments information
2239 (omitted if empty) (omitted if
2240 no information)
2241
2242
2243 -}
2244
2245 -- | See Note [Demand notation]
2246 -- Current syntax was discussed in #19016.
2247 instance Outputable Card where
2248 ppr C_00 = char 'A' -- "Absent"
2249 ppr C_01 = char 'M' -- "Maybe"
2250 ppr C_0N = char 'L' -- "Lazy"
2251 ppr C_11 = char '1' -- "exactly 1"
2252 ppr C_1N = char 'S' -- "Strict"
2253 ppr C_10 = char 'B' -- "Bottom"
2254
2255 -- | See Note [Demand notation]
2256 instance Outputable Demand where
2257 ppr AbsDmd = char 'A'
2258 ppr BotDmd = char 'B'
2259 ppr (C_0N :* Poly Boxed C_0N) = char 'L' -- Print LL as just L
2260 ppr (C_1N :* Poly Boxed C_1N) = char 'S' -- Dito SS
2261 ppr (n :* sd) = ppr n <> ppr sd
2262
2263 -- | See Note [Demand notation]
2264 instance Outputable SubDemand where
2265 ppr (Poly b sd) = pp_boxity b <> ppr sd
2266 ppr (Call n sd) = char 'C' <> ppr n <> parens (ppr sd)
2267 ppr (Prod b ds) = pp_boxity b <> char 'P' <> parens (fields ds)
2268 where
2269 fields [] = empty
2270 fields [x] = ppr x
2271 fields (x:xs) = ppr x <> char ',' <> fields xs
2272
2273 pp_boxity :: Boxity -> SDoc
2274 pp_boxity Unboxed = char '!'
2275 pp_boxity _ = empty
2276
2277 instance Outputable Divergence where
2278 ppr Diverges = char 'b' -- for (b)ottom
2279 ppr ExnOrDiv = char 'x' -- for e(x)ception
2280 ppr Dunno = empty
2281
2282 instance Outputable DmdType where
2283 ppr (DmdType fv ds res)
2284 = hsep [hcat (map (angleBrackets . ppr) ds) <> ppr res,
2285 if null fv_elts then empty
2286 else braces (fsep (map pp_elt fv_elts))]
2287 where
2288 pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
2289 fv_elts = nonDetUFMToList fv
2290 -- It's OK to use nonDetUFMToList here because we only do it for
2291 -- pretty printing
2292
2293 instance Outputable DmdSig where
2294 ppr (DmdSig ty) = ppr ty
2295
2296 instance Outputable TypeShape where
2297 ppr TsUnk = text "TsUnk"
2298 ppr (TsFun ts) = text "TsFun" <> parens (ppr ts)
2299 ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)
2300
2301 instance Binary Card where
2302 put_ bh C_00 = putByte bh 0
2303 put_ bh C_01 = putByte bh 1
2304 put_ bh C_0N = putByte bh 2
2305 put_ bh C_11 = putByte bh 3
2306 put_ bh C_1N = putByte bh 4
2307 put_ bh C_10 = putByte bh 5
2308 get bh = do
2309 h <- getByte bh
2310 case h of
2311 0 -> return C_00
2312 1 -> return C_01
2313 2 -> return C_0N
2314 3 -> return C_11
2315 4 -> return C_1N
2316 5 -> return C_10
2317 _ -> pprPanic "Binary:Card" (ppr (fromIntegral h :: Int))
2318
2319 instance Binary Demand where
2320 put_ bh (n :* sd) = put_ bh n *> case n of
2321 C_00 -> return ()
2322 C_10 -> return ()
2323 _ -> put_ bh sd
2324 get bh = get bh >>= \n -> case n of
2325 C_00 -> return AbsDmd
2326 C_10 -> return BotDmd
2327 _ -> (n :*) <$> get bh
2328
2329 instance Binary SubDemand where
2330 put_ bh (Poly b sd) = putByte bh 0 *> put_ bh b *> put_ bh sd
2331 put_ bh (Call n sd) = putByte bh 1 *> put_ bh n *> put_ bh sd
2332 put_ bh (Prod b ds) = putByte bh 2 *> put_ bh b *> put_ bh ds
2333 get bh = do
2334 h <- getByte bh
2335 case h of
2336 0 -> Poly <$> get bh <*> get bh
2337 1 -> mkCall <$> get bh <*> get bh
2338 2 -> Prod <$> get bh <*> get bh
2339 _ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int))
2340
2341 instance Binary DmdSig where
2342 put_ bh (DmdSig aa) = put_ bh aa
2343 get bh = DmdSig <$> get bh
2344
2345 instance Binary DmdType where
2346 -- Ignore DmdEnv when spitting out the DmdType
2347 put_ bh (DmdType _ ds dr) = put_ bh ds *> put_ bh dr
2348 get bh = DmdType emptyDmdEnv <$> get bh <*> get bh
2349
2350 instance Binary Divergence where
2351 put_ bh Dunno = putByte bh 0
2352 put_ bh ExnOrDiv = putByte bh 1
2353 put_ bh Diverges = putByte bh 2
2354 get bh = do
2355 h <- getByte bh
2356 case h of
2357 0 -> return Dunno
2358 1 -> return ExnOrDiv
2359 2 -> return Diverges
2360 _ -> pprPanic "Binary:Divergence" (ppr (fromIntegral h :: Int))