Demand.hs 70.7 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5
\section[Demand]{@Demand@: A decoupled implementation of a demand domain}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
9 10

module Demand (
Austin Seipp's avatar
Austin Seipp committed
11
        StrDmd, UseDmd(..), Count(..),
12
        countOnce, countMany,   -- cardinality
13

Austin Seipp's avatar
Austin Seipp committed
14
        Demand, CleanDemand,
15
        mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd,
Austin Seipp's avatar
Austin Seipp committed
16
        getUsage, toCleanDmd,
17
        absDmd, topDmd, botDmd, seqDmd,
Austin Seipp's avatar
Austin Seipp committed
18 19
        lubDmd, bothDmd, apply1Dmd, apply2Dmd,
        isTopDmd, isBotDmd, isAbsDmd, isSeqDmd,
20
        peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd,
21
        addCaseBndrDmd,
22

23
        DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,
24
        nopDmdType, botDmdType, mkDmdType,
25
        addDemand, removeDmdTyArgs,
26
        BothDmdArg, mkBothDmdArg, toBothDmdArg,
27 28

        DmdEnv, emptyDmdEnv,
29
        peelFV, findIdDemand,
30

31
        DmdResult, CPRResult,
Joachim Breitner's avatar
Joachim Breitner committed
32
        isBotRes, isTopRes,
33
        topRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes,
Austin Seipp's avatar
Austin Seipp committed
34
        appIsBottom, isBottomingSig, pprIfaceStrictSig,
Joachim Breitner's avatar
Joachim Breitner committed
35
        trimCPRInfo, returnsCPR_maybe,
36
        StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig,
37
        isNopSig, splitStrictSig, increaseStrictSigArity,
38

Austin Seipp's avatar
Austin Seipp committed
39
        seqDemand, seqDemandList, seqDmdType, seqStrictSig,
40

Austin Seipp's avatar
Austin Seipp committed
41
        evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd,
42
        splitDmdTy, splitFVs,
43
        deferAfterIO,
44
        postProcessUnsat, postProcessDmdTypeM,
45

46
        splitProdDmd_maybe, peelCallDmd, mkCallDmd,
47 48
        dmdTransformSig, dmdTransformDataConSig, dmdTransformDictSelSig,
        argOneShots, argsOneShots,
49
        trimToType, TypeShape(..),
50

51 52
        isSingleUsed, reuseEnv,
        killUsageDemand, killUsageSig, zapUsageDemand,
53
        strictifyDictDmd
54

sof's avatar
sof committed
55 56
     ) where

57 58
#include "HsVersions.h"

59
import StaticFlags
60
import DynFlags
61
import Outputable
62
import Var ( Var )
63 64
import VarEnv
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
65
import Util
66 67
import BasicTypes
import Binary
Joachim Breitner's avatar
Joachim Breitner committed
68
import Maybes           ( orElse )
69

70
import Type            ( Type, isUnLiftedType )
71 72
import TyCon           ( isNewTyCon, isClassTyCon )
import DataCon         ( splitDataProductType_maybe )
73
import FastString
74

Austin Seipp's avatar
Austin Seipp committed
75 76 77
{-
************************************************************************
*                                                                      *
78
\subsection{Strictness domain}
Austin Seipp's avatar
Austin Seipp committed
79 80
*                                                                      *
************************************************************************
81

82 83
        Lazy
         |
84
      HeadStr
85 86 87 88
      /     \
  SCall      SProd
      \      /
      HyperStr
Austin Seipp's avatar
Austin Seipp committed
89
-}
90

91 92
-- Vanilla strictness domain
data StrDmd
Austin Seipp's avatar
Austin Seipp committed
93
  = HyperStr             -- Hyper-strict
94
                         -- Bottom of the lattice
95
                         -- Note [HyperStr and Use demands]
96 97 98 99

  | SCall StrDmd         -- Call demand
                         -- Used only for values of function type

100
  | SProd [MaybeStr]     -- Product
101 102
                         -- Used only for values of product type
                         -- Invariant: not all components are HyperStr (use HyperStr)
103
                         --            not all components are Lazy     (use HeadStr)
104

105
  | HeadStr              -- Head-Strict
106 107 108
                         -- A polymorphic demand: used for values of all types,
                         --                       including a type variable

109 110 111 112 113
  deriving ( Eq, Show )

data MaybeStr = Lazy            -- Lazy
                                -- Top of the lattice
              | Str StrDmd
114 115 116
  deriving ( Eq, Show )

-- Well-formedness preserving constructors for the Strictness domain
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
strBot, strTop :: MaybeStr
strBot = Str HyperStr
strTop = Lazy

mkSCall :: StrDmd -> StrDmd
mkSCall HyperStr = HyperStr
mkSCall s        = SCall s

mkSProd :: [MaybeStr] -> StrDmd
mkSProd sx
  | any isHyperStr sx = HyperStr
  | all isLazy     sx = HeadStr
  | otherwise         = SProd sx

isLazy :: MaybeStr -> Bool
isLazy Lazy    = True
isLazy (Str _) = False

isHyperStr :: MaybeStr -> Bool
isHyperStr (Str HyperStr) = True
isHyperStr _              = False
138 139 140 141 142

-- Pretty-printing
instance Outputable StrDmd where
  ppr HyperStr      = char 'B'
  ppr (SCall s)     = char 'C' <> parens (ppr s)
143
  ppr HeadStr       = char 'S'
144 145
  ppr (SProd sx)    = char 'S' <> parens (hcat (map ppr sx))

146 147 148 149 150 151 152 153 154
instance Outputable MaybeStr where
  ppr (Str s)       = ppr s
  ppr Lazy          = char 'L'

lubMaybeStr :: MaybeStr -> MaybeStr -> MaybeStr
lubMaybeStr Lazy     _        = Lazy
lubMaybeStr _        Lazy     = Lazy
lubMaybeStr (Str s1) (Str s2) = Str (s1 `lubStr` s2)

155 156 157
lubStr :: StrDmd -> StrDmd -> StrDmd
lubStr HyperStr s              = s
lubStr (SCall s1) HyperStr     = SCall s1
158
lubStr (SCall _)  HeadStr      = HeadStr
159
lubStr (SCall s1) (SCall s2)   = SCall (s1 `lubStr` s2)
160 161 162
lubStr (SCall _)  (SProd _)    = HeadStr
lubStr (SProd sx) HyperStr     = SProd sx
lubStr (SProd _)  HeadStr      = HeadStr
163
lubStr (SProd s1) (SProd s2)
164 165 166 167 168 169 170
    | length s1 == length s2   = mkSProd (zipWith lubMaybeStr s1 s2)
    | otherwise                = HeadStr
lubStr (SProd _) (SCall _)     = HeadStr
lubStr HeadStr   _             = HeadStr

bothMaybeStr :: MaybeStr -> MaybeStr -> MaybeStr
bothMaybeStr Lazy     s           = s
Austin Seipp's avatar
Austin Seipp committed
171
bothMaybeStr s        Lazy        = s
172
bothMaybeStr (Str s1) (Str s2) = Str (s1 `bothStr` s2)
173 174 175

bothStr :: StrDmd -> StrDmd -> StrDmd
bothStr HyperStr _             = HyperStr
176
bothStr HeadStr s              = s
177
bothStr (SCall _)  HyperStr    = HyperStr
178
bothStr (SCall s1) HeadStr     = SCall s1
179 180 181 182
bothStr (SCall s1) (SCall s2)  = SCall (s1 `bothStr` s2)
bothStr (SCall _)  (SProd _)   = HyperStr  -- Weird

bothStr (SProd _)  HyperStr    = HyperStr
183
bothStr (SProd s1) HeadStr     = SProd s1
Austin Seipp's avatar
Austin Seipp committed
184
bothStr (SProd s1) (SProd s2)
185
    | length s1 == length s2   = mkSProd (zipWith bothMaybeStr s1 s2)
186 187 188
    | otherwise                = HyperStr  -- Weird
bothStr (SProd _) (SCall _)    = HyperStr

189 190 191
-- utility functions to deal with memory leaks
seqStrDmd :: StrDmd -> ()
seqStrDmd (SProd ds)   = seqStrDmdList ds
Austin Seipp's avatar
Austin Seipp committed
192
seqStrDmd (SCall s)     = s `seq` ()
193 194
seqStrDmd _            = ()

195
seqStrDmdList :: [MaybeStr] -> ()
196
seqStrDmdList [] = ()
197 198 199 200 201
seqStrDmdList (d:ds) = seqMaybeStr d `seq` seqStrDmdList ds

seqMaybeStr :: MaybeStr -> ()
seqMaybeStr Lazy    = ()
seqMaybeStr (Str s) = seqStrDmd s
202 203

-- Splitting polymorphic demands
204 205 206 207
splitMaybeStrProdDmd :: Int -> MaybeStr -> Maybe [MaybeStr]
splitMaybeStrProdDmd n Lazy    = Just (replicate n Lazy)
splitMaybeStrProdDmd n (Str s) = splitStrProdDmd n s

208 209 210 211 212 213 214
splitStrProdDmd :: Int -> StrDmd -> Maybe [MaybeStr]
splitStrProdDmd n HyperStr   = Just (replicate n strBot)
splitStrProdDmd n HeadStr    = Just (replicate n strTop)
splitStrProdDmd n (SProd ds) = ASSERT( ds `lengthIs` n) Just ds
splitStrProdDmd _ (SCall {}) = Nothing
      -- This can happen when the programmer uses unsafeCoerce,
      -- and we don't then want to crash the compiler (Trac #9208)
215

Austin Seipp's avatar
Austin Seipp committed
216 217 218
{-
************************************************************************
*                                                                      *
219
\subsection{Absence domain}
Austin Seipp's avatar
Austin Seipp committed
220 221
*                                                                      *
************************************************************************
222

223 224 225 226 227 228 229
      Used
      /   \
  UCall   UProd
      \   /
      UHead
       |
      Abs
Austin Seipp's avatar
Austin Seipp committed
230
-}
231

232 233 234
-- Domain for genuine usage
data UseDmd
  = UCall Count UseDmd   -- Call demand for absence
235 236
                         -- Used only for values of function type

Austin Seipp's avatar
Austin Seipp committed
237
  | UProd [MaybeUsed]     -- Product
238 239 240 241 242
                         -- Used only for values of product type
                         -- See Note [Don't optimise UProd(Used) to Used]
                         -- [Invariant] Not all components are Abs
                         --             (in that case, use UHead)

Austin Seipp's avatar
Austin Seipp committed
243
  | UHead                -- May be used; but its sub-components are
244 245 246 247 248 249 250
                         -- definitely *not* used.  Roughly U(AAA)
                         -- Eg the usage of x in x `seq` e
                         -- A polymorphic demand: used for values of all types,
                         --                       including a type variable
                         -- Since (UCall _ Abs) is ill-typed, UHead doesn't
                         -- make sense for lambdas

251 252 253 254
  | Used                 -- May be used; and its sub-components may be used
                         -- Top of the lattice
  deriving ( Eq, Show )

255 256 257 258 259
-- Extended usage demand for absence and counting
data MaybeUsed
  = Abs                  -- Definitely unused
                         -- Bottom of the lattice

Austin Seipp's avatar
Austin Seipp committed
260
  | Use Count UseDmd     -- May be used with some cardinality
261 262 263 264
  deriving ( Eq, Show )

-- Abstract counting of usages
data Count = One | Many
Austin Seipp's avatar
Austin Seipp committed
265
  deriving ( Eq, Show )
266 267

-- Pretty-printing
268 269
instance Outputable MaybeUsed where
  ppr Abs           = char 'A'
Austin Seipp's avatar
Austin Seipp committed
270
  ppr (Use Many a)   = ppr a
271 272 273 274 275 276 277 278 279 280 281
  ppr (Use One  a)   = char '1' <> char '*' <> ppr a

instance Outputable UseDmd where
  ppr Used           = char 'U'
  ppr (UCall c a)    = char 'C' <> ppr c <> parens (ppr a)
  ppr UHead          = char 'H'
  ppr (UProd as)     = char 'U' <> parens (hcat (punctuate (char ',') (map ppr as)))

instance Outputable Count where
  ppr One  = char '1'
  ppr Many = text ""
282 283

-- Well-formedness preserving constructors for the Absence domain
284 285 286 287 288 289 290 291 292
countOnce, countMany :: Count
countOnce = One
countMany = Many

useBot, useTop :: MaybeUsed
useBot     = Abs
useTop     = Use Many Used

mkUCall :: Count -> UseDmd -> UseDmd
Austin Seipp's avatar
Austin Seipp committed
293
--mkUCall c Used = Used c
294 295 296
mkUCall c a  = UCall c a

mkUProd :: [MaybeUsed] -> UseDmd
Austin Seipp's avatar
Austin Seipp committed
297
mkUProd ux
298 299 300
  | all (== Abs) ux    = UHead
  | otherwise          = UProd ux

301 302 303
lubCount :: Count -> Count -> Count
lubCount _ Many = Many
lubCount Many _ = Many
Austin Seipp's avatar
Austin Seipp committed
304
lubCount x _    = x
305 306 307 308 309 310 311 312 313 314 315

lubMaybeUsed :: MaybeUsed -> MaybeUsed -> MaybeUsed
lubMaybeUsed Abs x                   = x
lubMaybeUsed x Abs                   = x
lubMaybeUsed (Use c1 a1) (Use c2 a2) = Use (lubCount c1 c2) (lubUse a1 a2)

lubUse :: UseDmd -> UseDmd -> UseDmd
lubUse UHead       u               = u
lubUse (UCall c u) UHead           = UCall c u
lubUse (UCall c1 u1) (UCall c2 u2) = UCall (lubCount c1 c2) (lubUse u1 u2)
lubUse (UCall _ _) _               = Used
Austin Seipp's avatar
Austin Seipp committed
316
lubUse (UProd ux) UHead            = UProd ux
317 318 319 320 321 322 323 324 325 326 327
lubUse (UProd ux1) (UProd ux2)
     | length ux1 == length ux2    = UProd $ zipWith lubMaybeUsed ux1 ux2
     | otherwise                   = Used
lubUse (UProd {}) (UCall {})       = Used
-- lubUse (UProd {}) Used             = Used
lubUse (UProd ux) Used             = UProd (map (`lubMaybeUsed` useTop) ux)
lubUse Used       (UProd ux)       = UProd (map (`lubMaybeUsed` useTop) ux)
lubUse Used _                      = Used  -- Note [Used should win]

-- `both` is different from `lub` in its treatment of counting; if
-- `both` is computed for two used, the result always has
Austin Seipp's avatar
Austin Seipp committed
328
--  cardinality `Many` (except for the inner demands of UCall demand -- [TODO] explain).
329 330 331 332 333 334 335 336 337 338 339 340
--  Also,  x `bothUse` x /= x (for anything but Abs).

bothMaybeUsed :: MaybeUsed -> MaybeUsed -> MaybeUsed
bothMaybeUsed Abs x                   = x
bothMaybeUsed x Abs                   = x
bothMaybeUsed (Use _ a1) (Use _ a2)   = Use Many (bothUse a1 a2)


bothUse :: UseDmd -> UseDmd -> UseDmd
bothUse UHead       u               = u
bothUse (UCall c u) UHead           = UCall c u

Austin Seipp's avatar
Austin Seipp committed
341
-- Exciting special treatment of inner demand for call demands:
342 343 344 345
--    use `lubUse` instead of `bothUse`!
bothUse (UCall _ u1) (UCall _ u2)   = UCall Many (u1 `lubUse` u2)

bothUse (UCall {}) _                = Used
Austin Seipp's avatar
Austin Seipp committed
346
bothUse (UProd ux) UHead            = UProd ux
347 348 349 350 351 352 353 354 355 356 357 358
bothUse (UProd ux1) (UProd ux2)
      | length ux1 == length ux2    = UProd $ zipWith bothMaybeUsed ux1 ux2
      | otherwise                   = Used
bothUse (UProd {}) (UCall {})       = Used
-- bothUse (UProd {}) Used             = Used  -- Note [Used should win]
bothUse Used (UProd ux)             = UProd (map (`bothMaybeUsed` useTop) ux)
bothUse (UProd ux) Used             = UProd (map (`bothMaybeUsed` useTop) ux)
bothUse Used _                      = Used  -- Note [Used should win]

peelUseCall :: UseDmd -> Maybe (Count, UseDmd)
peelUseCall (UCall c u)   = Just (c,u)
peelUseCall _             = Nothing
359

360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395
addCaseBndrDmd :: Demand    -- On the case binder
               -> [Demand]  -- On the components of the constructor
               -> [Demand]  -- Final demands for the components of the constructor
-- See Note [Demand on case-alternative binders]
addCaseBndrDmd (JD { strd = ms, absd = mu }) alt_dmds
  = case mu of
     Abs     -> alt_dmds
     Use _ u -> zipWith bothDmd alt_dmds (mkJointDmds ss us)
             where
                Just ss = splitMaybeStrProdDmd arity ms  -- Guaranteed not to be a call
                Just us = splitUseProdDmd      arity u   -- Ditto
  where
    arity = length alt_dmds

{- Note [Demand on case-alternative binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The demand on a binder in a case alternative comes
  (a) From the demand on the binder itself
  (b) From the demand on the case binder
Forgetting (b) led directly to Trac #10148.

Example. Source code:
  f x@(p,_) = if p then foo x else True

  foo (p,True) = True
  foo (p,q)    = foo (q,p)

After strictness analysis:
  f = \ (x_an1 [Dmd=<S(SL),1*U(U,1*U)>] :: (Bool, Bool)) ->
      case x_an1
      of wild_X7 [Dmd=<L,1*U(1*U,1*U)>]
      { (p_an2 [Dmd=<S,1*U>], ds_dnz [Dmd=<L,A>]) ->
      case p_an2 of _ {
        False -> GHC.Types.True;
        True -> foo wild_X7 }

396
It's true that ds_dnz is *itself* absent, but the use of wild_X7 means
397 398 399 400 401 402
that it is very much alive and demanded.  See Trac #10148 for how the
consequences play out.

This is needed even for non-product types, in case the case-binder
is used but the components of the case alternative are not.

403 404 405 406 407 408 409 410
Note [Don't optimise UProd(Used) to Used]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
These two UseDmds:
   UProd [Used, Used]   and    Used
are semantically equivalent, but we do not turn the former into
the latter, for a regrettable-subtle reason.  Suppose we did.
then
  f (x,y) = (y,x)
Austin Seipp's avatar
Austin Seipp committed
411
would get
412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430
  StrDmd = Str  = SProd [Lazy, Lazy]
  UseDmd = Used = UProd [Used, Used]
But with the joint demand of <Str, Used> doesn't convey any clue
that there is a product involved, and so the worthSplittingFun
will not fire.  (We'd need to use the type as well to make it fire.)
Moreover, consider
  g h p@(_,_) = h p
This too would get <Str, Used>, but this time there really isn't any
point in w/w since the components of the pair are not used at all.

So the solution is: don't aggressively collapse UProd [Used,Used] to
Used; intead leave it as-is. In effect we are using the UseDmd to do a
little bit of boxity analysis.  Not very nice.

Note [Used should win]
~~~~~~~~~~~~~~~~~~~~~~
Both in lubUse and bothUse we want (Used `both` UProd us) to be Used.
Why?  Because Used carries the implication the whole thing is used,
box and all, so we don't want to w/w it.  If we use it both boxed and
Austin Seipp's avatar
Austin Seipp committed
431
unboxed, then we are definitely using the box, and so we are quite
432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448
likely to pay a reboxing cost.  So we make Used win here.

Example is in the Buffer argument of GHC.IO.Handle.Internals.writeCharBuffer

Baseline: (A) Not making Used win (UProd wins)
Compare with: (B) making Used win for lub and both

            Min          -0.3%     -5.6%    -10.7%    -11.0%    -33.3%
            Max          +0.3%    +45.6%    +11.5%    +11.5%     +6.9%
 Geometric Mean          -0.0%     +0.5%     +0.3%     +0.2%     -0.8%

Baseline: (B) Making Used win for both lub and both
Compare with: (C) making Used win for both, but UProd win for lub

            Min          -0.1%     -0.3%     -7.9%     -8.0%     -6.5%
            Max          +0.1%     +1.0%    +21.0%    +21.0%     +0.5%
 Geometric Mean          +0.0%     +0.0%     -0.0%     -0.1%     -0.1%
Austin Seipp's avatar
Austin Seipp committed
449
-}
450

451 452 453 454 455
-- If a demand is used multiple times (i.e. reused), than any use-once
-- mentioned there, that is not protected by a UCall, can happen many times.
markReusedDmd :: MaybeUsed -> MaybeUsed
markReusedDmd Abs         = Abs
markReusedDmd (Use _ a)   = Use Many (markReused a)
456

457 458 459 460
markReused :: UseDmd -> UseDmd
markReused (UCall _ u)      = UCall Many u   -- No need to recurse here
markReused (UProd ux)       = UProd (map markReusedDmd ux)
markReused u                = u
461 462

isUsedMU :: MaybeUsed -> Bool
463
-- True <=> markReusedDmd d = d
464 465 466 467 468
isUsedMU Abs          = True
isUsedMU (Use One _)  = False
isUsedMU (Use Many u) = isUsedU u

isUsedU :: UseDmd -> Bool
469
-- True <=> markReused d = d
470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490
isUsedU Used           = True
isUsedU UHead          = True
isUsedU (UProd us)     = all isUsedMU us
isUsedU (UCall One _)  = False
isUsedU (UCall Many _) = True  -- No need to recurse

-- Squashing usage demand demands
seqUseDmd :: UseDmd -> ()
seqUseDmd (UProd ds)   = seqMaybeUsedList ds
seqUseDmd (UCall c d)  = c `seq` seqUseDmd d
seqUseDmd _            = ()

seqMaybeUsedList :: [MaybeUsed] -> ()
seqMaybeUsedList []     = ()
seqMaybeUsedList (d:ds) = seqMaybeUsed d `seq` seqMaybeUsedList ds

seqMaybeUsed :: MaybeUsed -> ()
seqMaybeUsed (Use c u)  = c `seq` seqUseDmd u
seqMaybeUsed _          = ()

-- Splitting polymorphic Maybe-Used demands
491 492 493
splitUseProdDmd :: Int -> UseDmd -> Maybe [MaybeUsed]
splitUseProdDmd n Used        = Just (replicate n useTop)
splitUseProdDmd n UHead       = Just (replicate n Abs)
Austin Seipp's avatar
Austin Seipp committed
494
splitUseProdDmd n (UProd ds)  = ASSERT2( ds `lengthIs` n, text "splitUseProdDmd" $$ ppr n $$ ppr ds )
495 496 497 498
                                Just ds
splitUseProdDmd _ (UCall _ _) = Nothing
      -- This can happen when the programmer uses unsafeCoerce,
      -- and we don't then want to crash the compiler (Trac #9208)
499

Austin Seipp's avatar
Austin Seipp committed
500 501 502 503 504 505 506
{-
************************************************************************
*                                                                      *
\subsection{Joint domain for Strictness and Absence}
*                                                                      *
************************************************************************
-}
507

Austin Seipp's avatar
Austin Seipp committed
508
data JointDmd = JD { strd :: MaybeStr, absd :: MaybeUsed }
509 510 511 512 513 514 515
  deriving ( Eq, Show )

-- Pretty-printing
instance Outputable JointDmd where
  ppr (JD {strd = s, absd = a}) = angleBrackets (ppr s <> char ',' <> ppr a)

-- Well-formedness preserving constructors for the joint domain
516
mkJointDmd :: MaybeStr -> MaybeUsed -> JointDmd
517 518
mkJointDmd s a = JD { strd = s, absd = a }

519
mkJointDmds :: [MaybeStr] -> [MaybeUsed] -> [JointDmd]
520
mkJointDmds ss as = zipWithEqual "mkJointDmds" mkJointDmd ss as
Austin Seipp's avatar
Austin Seipp committed
521

522
absDmd :: JointDmd
523
absDmd = mkJointDmd Lazy Abs
524

525 526 527 528 529
apply1Dmd, apply2Dmd :: Demand
-- C1(U), C1(C1(U)) respectively
apply1Dmd = JD { strd = Lazy, absd = Use Many (UCall One Used) }
apply2Dmd = JD { strd = Lazy, absd = Use Many (UCall One (UCall One Used)) }

530
topDmd :: JointDmd
531 532 533 534
topDmd = mkJointDmd Lazy useTop

seqDmd :: JointDmd
seqDmd = mkJointDmd (Str HeadStr) (Use One UHead)
535 536

botDmd :: JointDmd
537
botDmd = mkJointDmd strBot useBot
538 539

lubDmd :: JointDmd -> JointDmd -> JointDmd
Austin Seipp's avatar
Austin Seipp committed
540
lubDmd (JD {strd = s1, absd = a1})
541
       (JD {strd = s2, absd = a2}) = mkJointDmd (s1 `lubMaybeStr` s2) (a1 `lubMaybeUsed` a2)
542 543

bothDmd :: JointDmd -> JointDmd -> JointDmd
Austin Seipp's avatar
Austin Seipp committed
544
bothDmd (JD {strd = s1, absd = a1})
545
        (JD {strd = s2, absd = a2}) = mkJointDmd (s1 `bothMaybeStr` s2) (a1 `bothMaybeUsed` a2)
546 547

isTopDmd :: JointDmd -> Bool
548
isTopDmd (JD {strd = Lazy, absd = Use Many Used}) = True
Austin Seipp's avatar
Austin Seipp committed
549
isTopDmd _                                        = False
550 551

isBotDmd :: JointDmd -> Bool
552
isBotDmd (JD {strd = Str HyperStr, absd = Abs}) = True
Austin Seipp's avatar
Austin Seipp committed
553 554
isBotDmd _                                      = False

555
isAbsDmd :: JointDmd -> Bool
Austin Seipp's avatar
Austin Seipp committed
556
isAbsDmd (JD {absd = Abs})  = True   -- The strictness part can be HyperStr
557 558 559
isAbsDmd _                  = False  -- for a bottom demand

isSeqDmd :: JointDmd -> Bool
560 561
isSeqDmd (JD {strd=Str HeadStr, absd=Use _ UHead}) = True
isSeqDmd _                                         = False
562 563 564

-- More utility functions for strictness
seqDemand :: JointDmd -> ()
565
seqDemand (JD {strd = x, absd = y}) = seqMaybeStr x `seq` seqMaybeUsed y `seq` ()
566 567

seqDemandList :: [JointDmd] -> ()
568 569
seqDemandList [] = ()
seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
570

571
isStrictDmd :: Demand -> Bool
572 573 574 575 576
-- See Note [Strict demands]
isStrictDmd (JD {absd = Abs})  = False
isStrictDmd (JD {strd = Lazy}) = False
isStrictDmd _                  = True

577 578
isWeakDmd :: Demand -> Bool
isWeakDmd (JD {strd = s, absd = a}) = isLazy s && isUsedMU a
579

580 581 582
cleanUseDmd_maybe :: JointDmd -> Maybe UseDmd
cleanUseDmd_maybe (JD { absd = Use _ ud }) = Just ud
cleanUseDmd_maybe _                        = Nothing
583

584 585 586 587 588 589 590 591 592 593
splitFVs :: Bool   -- Thunk
         -> DmdEnv -> (DmdEnv, DmdEnv)
splitFVs is_thunk rhs_fvs
  | is_thunk  = foldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs
  | otherwise = partitionVarEnv isWeakDmd rhs_fvs
  where
    add uniq dmd@(JD { strd = s, absd = u }) (lazy_fv, sig_fv)
      | Lazy <- s = (addToUFM_Directly lazy_fv uniq dmd, sig_fv)
      | otherwise = ( addToUFM_Directly lazy_fv uniq (JD { strd = Lazy, absd = u })
                    , addToUFM_Directly sig_fv  uniq (JD { strd = s,    absd = Abs }) )
594

Austin Seipp's avatar
Austin Seipp committed
595 596 597
{-
************************************************************************
*                                                                      *
598
\subsection{Clean demand for Strictness and Usage}
Austin Seipp's avatar
Austin Seipp committed
599 600
*                                                                      *
************************************************************************
601

602 603
This domain differst from JointDemand in the sence that pure absence
is taken away, i.e., we deal *only* with non-absent demands.
604

605 606
Note [Strict demands]
~~~~~~~~~~~~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
607
isStrictDmd returns true only of demands that are
608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623
   both strict
   and  used
In particular, it is False for <HyperStr, Abs>, which can and does
arise in, say (Trac #7319)
   f x = raise# <some exception>
Then 'x' is not used, so f gets strictness <HyperStr,Abs> -> .
Now the w/w generates
   fx = let x <HyperStr,Abs> = absentError "unused"
        in raise <some exception>
At this point we really don't want to convert to
   fx = case absentError "unused" of x -> raise <some exception>
Since the program is going to diverge, this swaps one error for another,
but it's really a bad idea to *ever* evaluate an absent argument.
In Trac #7319 we get
   T7319.exe: Oops!  Entered absent arg w_s1Hd{v} [lid] [base:GHC.Base.String{tc 36u}]

624 625 626 627 628 629 630 631 632 633
Note [Dealing with call demands]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call demands are constructed and deconstructed coherently for
strictness and absence. For instance, the strictness signature for the
following function

f :: (Int -> (Int, Int)) -> (Int, Bool)
f g = (snd (g 3), True)

should be: <L,C(U(AU))>m
Austin Seipp's avatar
Austin Seipp committed
634
-}
635

636 637
data CleanDemand   -- A demand that is at least head-strict
  = CD { sd :: StrDmd, ud :: UseDmd }
638 639 640 641 642 643 644 645 646
  deriving ( Eq, Show )

instance Outputable CleanDemand where
  ppr (CD {sd = s, ud = a}) = angleBrackets (ppr s <> comma <> ppr a)

mkCleanDmd :: StrDmd -> UseDmd -> CleanDemand
mkCleanDmd s a = CD { sd = s, ud = a }

bothCleanDmd :: CleanDemand -> CleanDemand -> CleanDemand
Austin Seipp's avatar
Austin Seipp committed
647
bothCleanDmd (CD { sd = s1, ud = a1}) (CD { sd = s2, ud = a2})
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668
  = CD { sd = s1 `bothStr` s2, ud = a1 `bothUse` a2 }

mkHeadStrict :: CleanDemand -> CleanDemand
mkHeadStrict (CD { ud = a }) = mkCleanDmd HeadStr a

oneifyDmd :: JointDmd -> JointDmd
oneifyDmd (JD { strd = s, absd = Use _ a }) = JD { strd = s, absd = Use One a }
oneifyDmd jd                                = jd

mkOnceUsedDmd, mkManyUsedDmd :: CleanDemand -> JointDmd
mkOnceUsedDmd (CD {sd = s,ud = a}) = mkJointDmd (Str s) (Use One a)
mkManyUsedDmd (CD {sd = s,ud = a}) = mkJointDmd (Str s) (Use Many a)

getUsage :: CleanDemand -> UseDmd
getUsage = ud

evalDmd :: JointDmd
-- Evaluated strictly, and used arbitrarily deeply
evalDmd = mkJointDmd (Str HeadStr) useTop

mkProdDmd :: [JointDmd] -> CleanDemand
Austin Seipp's avatar
Austin Seipp committed
669 670
mkProdDmd dx
  = mkCleanDmd sp up
671 672
  where
    sp = mkSProd $ map strd dx
Austin Seipp's avatar
Austin Seipp committed
673
    up = mkUProd $ map absd dx
674 675

mkCallDmd :: CleanDemand -> CleanDemand
Austin Seipp's avatar
Austin Seipp committed
676
mkCallDmd (CD {sd = d, ud = u})
677 678 679 680 681 682 683 684 685 686
  = mkCleanDmd (mkSCall d) (mkUCall One u)

cleanEvalDmd :: CleanDemand
cleanEvalDmd = mkCleanDmd HeadStr Used

cleanEvalProdDmd :: Arity -> CleanDemand
cleanEvalProdDmd n = mkCleanDmd HeadStr (UProd (replicate n useTop))

isSingleUsed :: JointDmd -> Bool
isSingleUsed (JD {absd=a}) = is_used_once a
687
  where
688 689 690
    is_used_once Abs         = True
    is_used_once (Use One _) = True
    is_used_once _           = False
691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727


data TypeShape = TsFun TypeShape
               | TsProd [TypeShape]
               | TsUnk

instance Outputable TypeShape where
  ppr TsUnk        = ptext (sLit "TsUnk")
  ppr (TsFun ts)   = ptext (sLit "TsFun") <> parens (ppr ts)
  ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)

trimToType :: JointDmd -> TypeShape -> JointDmd
-- See Note [Trimming a demand to a type]
trimToType (JD ms mu) ts
  = JD (go_ms ms ts) (go_mu mu ts)
  where
    go_ms :: MaybeStr -> TypeShape -> MaybeStr
    go_ms Lazy    _  = Lazy
    go_ms (Str s) ts = Str (go_s s ts)

    go_s :: StrDmd -> TypeShape -> StrDmd
    go_s HyperStr    _            = HyperStr
    go_s (SCall s)   (TsFun ts)   = SCall (go_s s ts)
    go_s (SProd mss) (TsProd tss)
      | equalLength mss tss       = SProd (zipWith go_ms mss tss)
    go_s _           _            = HeadStr

    go_mu :: MaybeUsed -> TypeShape -> MaybeUsed
    go_mu Abs _ = Abs
    go_mu (Use c u) ts = Use c (go_u u ts)

    go_u :: UseDmd -> TypeShape -> UseDmd
    go_u UHead       _          = UHead
    go_u (UCall c u) (TsFun ts) = UCall c (go_u u ts)
    go_u (UProd mus) (TsProd tss)
      | equalLength mus tss      = UProd (zipWith go_mu mus tss)
    go_u _           _           = Used
728

Austin Seipp's avatar
Austin Seipp committed
729
{-
730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750
Note [Trimming a demand to a type]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this:

  f :: a -> Bool
  f x = case ... of
          A g1 -> case (x |> g1) of (p,q) -> ...
          B    -> error "urk"

where A,B are the constructors of a GADT.  We'll get a U(U,U) demand
on x from the A branch, but that's a stupid demand for x itself, which
has type 'a'. Indeed we get ASSERTs going off (notably in
splitUseProdDmd, Trac #8569).

Bottom line: we really don't want to have a binder whose demand is more
deeply-nested than its type.  There are various ways to tackle this.
When processing (x |> g1), we could "trim" the incoming demand U(U,U)
to match x's type.  But I'm currently doing so just at the moment when
we pin a demand on a binder, in DmdAnal.findBndrDmd.


751 752 753 754 755 756
Note [Threshold demands]
~~~~~~~~~~~~~~~~~~~~~~~~
Threshold usage demand is generated to figure out if
cardinality-instrumented demands of a binding's free variables should
be unleashed. See also [Aggregated demand for cardinality].

757 758 759 760 761 762 763 764 765
Note [Replicating polymorphic demands]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Some demands can be considered as polymorphic. Generally, it is
applicable to such beasts as tops, bottoms as well as Head-Used adn
Head-stricts demands. For instance,

S ~ S(L, ..., L)

Also, when top or bottom is occurred as a result demand, it in fact
Austin Seipp's avatar
Austin Seipp committed
766 767
can be expanded to saturate a callee's arity.
-}
768

769
splitProdDmd_maybe :: JointDmd -> Maybe [JointDmd]
770 771 772
-- Split a product into its components, iff there is any
-- useful information to be extracted thereby
-- The demand is not necessarily strict!
773 774
splitProdDmd_maybe (JD {strd = s, absd = u})
  = case (s,u) of
775 776 777 778 779 780
      (Str (SProd sx), Use _ u)          | Just ux <- splitUseProdDmd (length sx) u
                                         -> Just (mkJointDmds sx ux)
      (Str s,          Use _ (UProd ux)) | Just sx <- splitStrProdDmd (length ux) s
                                         -> Just (mkJointDmds sx ux)
      (Lazy,           Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux)
      _ -> Nothing
781

Austin Seipp's avatar
Austin Seipp committed
782 783 784
{-
************************************************************************
*                                                                      *
785
                   Demand results
Austin Seipp's avatar
Austin Seipp committed
786 787
*                                                                      *
************************************************************************
788

789 790 791 792 793 794 795 796 797 798 799 800 801 802

DmdResult:     Dunno CPRResult
               /
        Diverges


CPRResult:         NoCPR
                   /    \
            RetProd    RetSum ConTag


Product contructors return (Dunno (RetProd rs))
In a fixpoint iteration, start from Diverges
We have lubs, but not glbs; but that is ok.
Austin Seipp's avatar
Austin Seipp committed
803
-}
804

805
------------------------------------------------------------------------
Austin Seipp's avatar
Austin Seipp committed
806
-- Constructed Product Result
807 808
------------------------------------------------------------------------

809 810
data Termination r = Diverges    -- Definitely diverges
                   | Dunno r     -- Might diverge or converge
811 812
               deriving( Eq, Show )

813 814 815 816 817
type DmdResult = Termination CPRResult

data CPRResult = NoCPR          -- Top of the lattice
               | RetProd        -- Returns a constructor from a product type
               | RetSum ConTag  -- Returns a constructor from a data type
818 819
               deriving( Eq, Show )

820
lubCPR :: CPRResult -> CPRResult -> CPRResult
Austin Seipp's avatar
Austin Seipp committed
821
lubCPR (RetSum t1) (RetSum t2)
822
  | t1 == t2                       = RetSum t1
823 824
lubCPR RetProd     RetProd     = RetProd
lubCPR _ _                     = NoCPR
825 826 827 828 829

lubDmdResult :: DmdResult -> DmdResult -> DmdResult
lubDmdResult Diverges       r              = r
lubDmdResult (Dunno c1)     Diverges       = Dunno c1
lubDmdResult (Dunno c1)     (Dunno c2)     = Dunno (c1 `lubCPR` c2)
830
-- This needs to commute with defaultDmd, i.e.
831
-- defaultDmd (r1 `lubDmdResult` r2) = defaultDmd r1 `lubDmd` defaultDmd r2
832
-- (See Note [Default demand on free variables] for why)
833

834
bothDmdResult :: DmdResult -> Termination () -> DmdResult
835
-- See Note [Asymmetry of 'both' for DmdType and DmdResult]
836 837
bothDmdResult _              Diverges   = Diverges
bothDmdResult r              _          = r
838
-- This needs to commute with defaultDmd, i.e.
839
-- defaultDmd (r1 `bothDmdResult` r2) = defaultDmd r1 `bothDmd` defaultDmd r2
840
-- (See Note [Default demand on free variables] for why)
841

842
instance Outputable DmdResult where
843 844
  ppr Diverges      = char 'b'
  ppr (Dunno c)     = ppr c
845

846 847 848 849
instance Outputable CPRResult where
  ppr NoCPR        = empty
  ppr (RetSum n)   = char 'm' <> int n
  ppr RetProd      = char 'm'
850

851 852 853
seqDmdResult :: DmdResult -> ()
seqDmdResult Diverges = ()
seqDmdResult (Dunno c)     = seqCPRResult c
854

855 856 857 858
seqCPRResult :: CPRResult -> ()
seqCPRResult NoCPR        = ()
seqCPRResult (RetSum n)   = n `seq` ()
seqCPRResult RetProd      = ()
859

860 861 862 863

------------------------------------------------------------------------
-- Combined demand result                                             --
------------------------------------------------------------------------
864

865
-- [cprRes] lets us switch off CPR analysis
866 867
-- by making sure that everything uses TopRes
topRes, botRes :: DmdResult
868 869
topRes = Dunno NoCPR
botRes = Diverges
870

871 872 873
cprSumRes :: ConTag -> DmdResult
cprSumRes tag | opt_CprOff = topRes
              | otherwise  = Dunno $ RetSum tag
874

875
cprProdRes :: [DmdType] -> DmdResult
876
cprProdRes _arg_tys
877 878
  | opt_CprOff = topRes
  | otherwise  = Dunno $ RetProd
879

880
vanillaCprProdRes :: Arity -> DmdResult
881
vanillaCprProdRes _arity
882 883
  | opt_CprOff = topRes
  | otherwise  = Dunno $ RetProd
884

885
isTopRes :: DmdResult -> Bool
886 887
isTopRes (Dunno NoCPR) = True
isTopRes _             = False
888 889

isBotRes :: DmdResult -> Bool
890 891 892 893 894 895 896 897 898 899 900 901 902 903 904
isBotRes Diverges = True
isBotRes _        = False

trimCPRInfo :: Bool -> Bool -> DmdResult -> DmdResult
trimCPRInfo trim_all trim_sums res
  = trimR res
  where
    trimR (Dunno c)     = Dunno (trimC c)
    trimR Diverges      = Diverges

    trimC (RetSum n)   | trim_all || trim_sums = NoCPR
                       | otherwise             = RetSum n
    trimC RetProd      | trim_all  = NoCPR
                       | otherwise = RetProd
    trimC NoCPR = NoCPR
905

906
returnsCPR_maybe :: DmdResult -> Maybe ConTag
907 908 909 910 911 912 913
returnsCPR_maybe (Dunno c)     = retCPR_maybe c
returnsCPR_maybe Diverges      = Nothing

retCPR_maybe :: CPRResult -> Maybe ConTag
retCPR_maybe (RetSum t)  = Just t
retCPR_maybe RetProd     = Just fIRST_TAG
retCPR_maybe NoCPR       = Nothing
914

Gabor Greif's avatar
Gabor Greif committed
915
-- See Notes [Default demand on free variables]
Joachim Breitner's avatar
Joachim Breitner committed
916 917 918 919 920
-- and [defaultDmd vs. resTypeArgDmd]
defaultDmd :: Termination r -> JointDmd
defaultDmd Diverges = botDmd
defaultDmd _        = absDmd

921
resTypeArgDmd :: DmdResult -> JointDmd
922 923 924 925
-- TopRes and BotRes are polymorphic, so that
--      BotRes === Bot -> BotRes === ...
--      TopRes === Top -> TopRes === ...
-- This function makes that concrete
Joachim Breitner's avatar
Joachim Breitner committed
926
-- Also see Note [defaultDmd vs. resTypeArgDmd]
927 928
resTypeArgDmd r | isBotRes r = botDmd
resTypeArgDmd _              = topDmd
929

Austin Seipp's avatar
Austin Seipp committed
930
{-
Joachim Breitner's avatar
Joachim Breitner committed
931 932 933 934
Note [defaultDmd and resTypeArgDmd]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

These functions are similar: They express the demand on something not
Gabor Greif's avatar
Gabor Greif committed
935
explicitly mentioned in the environment resp. the argument list. Yet they are
Joachim Breitner's avatar
Joachim Breitner committed
936 937 938 939 940
different:
 * Variables not mentioned in the free variables environment are definitely
   unused, so we can use absDmd there.
 * Further arguments *can* be used, of course. Hence topDmd is used.

941
Note [Worthy functions for Worker-Wrapper split]
942
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968
For non-bottoming functions a worker-wrapper transformation takes into
account several possibilities to decide if the function is worthy for
splitting:

1. The result is of product type and the function is strict in some
(or even all) of its arguments. The check that the argument is used is
more of sanity nature, since strictness implies usage. Example:

f :: (Int, Int) -> Int
f p = (case p of (a,b) -> a) + 1

should be splitted to

f :: (Int, Int) -> Int
f p = case p of (a,b) -> $wf a

$wf :: Int -> Int
$wf a = a + 1

2. Sometimes it also makes sense to perform a WW split if the
strictness analysis cannot say for sure if the function is strict in
components of its argument. Then we reason according to the inferred
usage information: if the function uses its product argument's
components, the WW split can be beneficial. Example:

g :: Bool -> (Int, Int) -> Int
969
g c p = case p of (a,b) ->
970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002
          if c then a else b

The function g is strict in is argument p and lazy in its
components. However, both components are used in the RHS. The idea is
since some of the components (both in this case) are used in the
right-hand side, the product must presumable be taken apart.

Therefore, the WW transform splits the function g to

g :: Bool -> (Int, Int) -> Int
g c p = case p of (a,b) -> $wg c a b

$wg :: Bool -> Int -> Int -> Int
$wg c a b = if c then a else b

3. If an argument is absent, it would be silly to pass it to a
function, hence the worker with reduced arity is generated.


Note [Worker-wrapper for bottoming functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used not to split if the result is bottom.
[Justification:  there's no efficiency to be gained.]

But it's sometimes bad not to make a wrapper.  Consider
        fw = \x# -> let x = I# x# in case e of
                                        p1 -> error_fn x
                                        p2 -> error_fn x
                                        p3 -> the real stuff
The re-boxing code won't go away unless error_fn gets a wrapper too.
[We don't do reboxing now, but in general it's better to pass an
unboxed thing to f, and have it reboxed in the error cases....]

1003 1004 1005 1006
However we *don't* want to do this when the argument is not actually
taken apart in the function at all.  Otherwise we risk decomposing a
masssive tuple which is barely used.  Example:

Simon Peyton Jones's avatar
Simon Peyton Jones committed
1007 1008
        f :: ((Int,Int) -> String) -> (Int,Int) -> a
        f g pr = error (g pr)
1009

Simon Peyton Jones's avatar
Simon Peyton Jones committed
1010
        main = print (f fst (1, error "no"))
1011

1012 1013 1014 1015
Here, f does not take 'pr' apart, and it's stupid to do so.
Imagine that it had millions of fields. This actually happened
in GHC itself where the tuple was DynFlags

1016

Austin Seipp's avatar
Austin Seipp committed
1017 1018
************************************************************************
*                                                                      *
1019
\subsection{Demand environments and types}
Austin Seipp's avatar
Austin Seipp committed
1020 1021 1022
*                                                                      *
************************************************************************
-}
1023 1024

type Demand = JointDmd
1025

1026
type DmdEnv = VarEnv Demand   -- See Note [Default demand on free variables]
1027

Austin Seipp's avatar
Austin Seipp committed
1028 1029
data DmdType = DmdType
                  DmdEnv        -- Demand on explicitly-mentioned
1030 1031
                                --      free variables
                  [Demand]      -- Demand on arguments
1032
                  DmdResult     -- See [Nature of result demand]
1033

Austin Seipp's avatar
Austin Seipp committed
1034
{-
1035 1036
Note [Nature of result demand]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060