SpecConstr.lhs 70 KB
Newer Older
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
1 2 3 4 5
ToDo [Nov 2010]
~~~~~~~~~~~~~~~
1. Use a library type rather than an annotation for ForceSpecConstr
2. Nuke NoSpecConstr

6 7 8 9 10 11 12
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[SpecConstr]{Specialise over constructors}

\begin{code}
module SpecConstr(
13
        specConstrProgram
14 15 16
#ifdef GHCI
        , SpecConstrAnnotation(..)
#endif
17 18 19 20 21
    ) where

#include "HsVersions.h"

import CoreSyn
22 23
import CoreSubst
import CoreUtils
24 25
import CoreUnfold       ( couldBeSmallEnoughToInline )
import CoreFVs          ( exprsFreeVars )
26
import CoreMonad
27
import Literal          ( litIsLifted )
28
import HscTypes         ( ModGuts(..) )
29
import WwLib            ( mkWorkerArgs )
30
import DataCon
31
import Coercion         hiding( substTy, substCo )
32
import Rules
33
import Type             hiding ( substTy )
34
import Id
35
import MkCore           ( mkImpossibleExpr )
36
import Var
37 38
import VarEnv
import VarSet
39
import Name
40
import BasicTypes
41 42 43
import DynFlags         ( DynFlags(..) )
import StaticFlags      ( opt_PprStyle_Debug )
import Maybes           ( orElse, catMaybes, isJust, isNothing )
44
import Demand
45
import DmdAnal          ( both )
46
import Serialized       ( deserializeWithData )
47
import Util
48
import Pair
49 50
import UniqSupply
import Outputable
51
import FastString
52
import UniqFM
Ian Lynagh's avatar
Ian Lynagh committed
53
import MonadUtils
54
import Control.Monad    ( zipWithM )
Ian Lynagh's avatar
Ian Lynagh committed
55
import Data.List
56 57 58 59 60 61 62 63 64


-- See Note [SpecConstrAnnotation]
#ifndef GHCI
type SpecConstrAnnotation = ()
#else
import TyCon            ( TyCon )
import GHC.Exts( SpecConstrAnnotation(..) )
#endif
65 66 67
\end{code}

-----------------------------------------------------
68
                        Game plan
69 70 71
-----------------------------------------------------

Consider
72 73 74
        drop n []     = []
        drop 0 xs     = []
        drop n (x:xs) = drop (n-1) xs
75 76 77 78

After the first time round, we could pass n unboxed.  This happens in
numerical code too.  Here's what it looks like in Core:

79 80 81 82 83 84
        drop n xs = case xs of
                      []     -> []
                      (y:ys) -> case n of
                                  I# n# -> case n# of
                                             0 -> []
                                             _ -> drop (I# (n# -# 1#)) xs
85 86 87 88

Notice that the recursive call has an explicit constructor as argument.
Noticing this, we can make a specialised version of drop

89 90 91
        RULE: drop (I# n#) xs ==> drop' n# xs

        drop' n# xs = let n = I# n# in ...orig RHS...
92 93 94

Now the simplifier will apply the specialisation in the rhs of drop', giving

95 96 97 98 99
        drop' n# xs = case xs of
                      []     -> []
                      (y:ys) -> case n# of
                                  0 -> []
                                  _ -> drop (n# -# 1#) xs
100

101
Much better!
102 103 104 105

We'd also like to catch cases where a parameter is carried along unchanged,
but evaluated each time round the loop:

106
        f i n = if i>0 || i>n then i else f (i*2) n
107 108 109 110

Here f isn't strict in n, but we'd like to avoid evaluating it each iteration.
In Core, by the time we've w/wd (f is strict in i) we get

111 112 113 114 115 116
        f i# n = case i# ># 0 of
                   False -> I# i#
                   True  -> case n of n' { I# n# ->
                            case i# ># n# of
                                False -> I# i#
                                True  -> f (i# *# 2#) n'
117 118 119

At the call to f, we see that the argument, n is know to be (I# n#),
and n is evaluated elsewhere in the body of f, so we can play the same
120
trick as above.
121 122 123 124 125


Note [Reboxing]
~~~~~~~~~~~~~~~
We must be careful not to allocate the same constructor twice.  Consider
126 127
        f p = (...(case p of (a,b) -> e)...p...,
               ...let t = (r,s) in ...t...(f t)...)
128 129
At the recursive call to f, we can see that t is a pair.  But we do NOT want
to make a specialised copy:
130
        f' a b = let p = (a,b) in (..., ...)
131 132 133 134 135 136
because now t is allocated by the caller, then r and s are passed to the
recursive call, which allocates the (r,s) pair again.

This happens if
  (a) the argument p is used in other than a case-scrutinsation way.
  (b) the argument to the call is not a 'fresh' tuple; you have to
137
        look into its unfolding to see that it's a tuple
138 139 140

Hence the "OR" part of Note [Good arguments] below.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
141
ALTERNATIVE 2: pass both boxed and unboxed versions.  This no longer saves
142 143 144 145 146 147 148 149
allocation, but does perhaps save evals. In the RULE we'd have
something like

  f (I# x#) = f' (I# x#) x#

If at the call site the (I# x) was an unfolding, then we'd have to
rely on CSE to eliminate the duplicate allocation.... This alternative
doesn't look attractive enough to pursue.
150

151
ALTERNATIVE 3: ignore the reboxing problem.  The trouble is that
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
152 153
the conservative reboxing story prevents many useful functions from being
specialised.  Example:
154 155 156
        foo :: Maybe Int -> Int -> Int
        foo   (Just m) 0 = 0
        foo x@(Just m) n = foo x (n-m)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
157 158 159
Here the use of 'x' will clearly not require boxing in the specialised function.

The strictness analyser has the same problem, in fact.  Example:
160
        f p@(a,b) = ...
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
161 162 163 164 165 166 167 168 169
If we pass just 'a' and 'b' to the worker, it might need to rebox the
pair to create (a,b).  A more sophisticated analysis might figure out
precisely the cases in which this could happen, but the strictness
analyser does no such analysis; it just passes 'a' and 'b', and hopes
for the best.

So my current choice is to make SpecConstr similarly aggressive, and
ignore the bad potential of reboxing.

170

171 172
Note [Good arguments]
~~~~~~~~~~~~~~~~~~~~~
173 174
So we look for

175
* A self-recursive function.  Ignore mutual recursion for now,
176 177 178 179
  because it's less common, and the code is simpler for self-recursion.

* EITHER

180
   a) At a recursive call, one or more parameters is an explicit
181
      constructor application
182 183
        AND
      That same parameter is scrutinised by a case somewhere in
184 185 186 187 188 189
      the RHS of the function

  OR

    b) At a recursive call, one or more parameters has an unfolding
       that is an explicit constructor application
190 191
        AND
      That same parameter is scrutinised by a case somewhere in
192
      the RHS of the function
193
        AND
194
      Those are the only uses of the parameter (see Note [Reboxing])
195 196


197 198
What to abstract over
~~~~~~~~~~~~~~~~~~~~~
199 200 201
There's a bit of a complication with type arguments.  If the call
site looks like

202
        f p = ...f ((:) [a] x xs)...
203 204 205

then our specialised function look like

206
        f_spec x xs = let p = (:) [a] x xs in ....as before....
207 208 209 210 211 212 213 214 215

This only makes sense if either
  a) the type variable 'a' is in scope at the top of f, or
  b) the type variable 'a' is an argument to f (and hence fs)

Actually, (a) may hold for value arguments too, in which case
we may not want to pass them.  Supose 'x' is in scope at f's
defn, but xs is not.  Then we'd like

216
        f_spec xs = let p = (:) [a] x xs in ....as before....
217 218 219 220 221 222 223

Similarly (b) may hold too.  If x is already an argument at the
call, no need to pass it again.

Finally, if 'a' is not in scope at the call site, we could abstract
it as we do the term variables:

224
        f_spec a x xs = let p = (:) [a] x xs in ...as before...
225 226 227

So the grand plan is:

228 229
        * abstract the call site to a constructor-only pattern
          e.g.  C x (D (f p) (g q))  ==>  C s1 (D s2 s3)
230

231
        * Find the free variables of the abstracted pattern
232

233 234
        * Pass these variables, less any that are in scope at
          the fn defn.  But see Note [Shadowing] below.
235 236 237 238 239 240 241


NOTICE that we only abstract over variables that are not in scope,
so we're in no danger of shadowing variables used in "higher up"
in f_spec's RHS.


242 243 244 245 246 247 248
Note [Shadowing]
~~~~~~~~~~~~~~~~
In this pass we gather up usage information that may mention variables
that are bound between the usage site and the definition site; or (more
seriously) may be bound to something different at the definition site.
For example:

249 250
        f x = letrec g y v = let x = ...
                             in ...(g (a,b) x)...
251

252
Since 'x' is in scope at the call site, we may make a rewrite rule that
253
looks like
254 255
        RULE forall a,b. g (a,b) x = ...
But this rule will never match, because it's really a different 'x' at
256 257 258 259 260 261 262 263 264
the call site -- and that difference will be manifest by the time the
simplifier gets to it.  [A worry: the simplifier doesn't *guarantee*
no-shadowing, so perhaps it may not be distinct?]

Anyway, the rule isn't actually wrong, it's just not useful.  One possibility
is to run deShadowBinds before running SpecConstr, but instead we run the
simplifier.  That gives the simplest possible program for SpecConstr to
chew on; and it virtually guarantees no shadowing.

265 266
Note [Specialising for constant parameters]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
This one is about specialising on a *constant* (but not necessarily
constructor) argument

    foo :: Int -> (Int -> Int) -> Int
    foo 0 f = 0
    foo m f = foo (f m) (+1)

It produces

    lvl_rmV :: GHC.Base.Int -> GHC.Base.Int
    lvl_rmV =
      \ (ds_dlk :: GHC.Base.Int) ->
        case ds_dlk of wild_alH { GHC.Base.I# x_alG ->
        GHC.Base.I# (GHC.Prim.+# x_alG 1)

    T.$wfoo :: GHC.Prim.Int# -> (GHC.Base.Int -> GHC.Base.Int) ->
    GHC.Prim.Int#
    T.$wfoo =
      \ (ww_sme :: GHC.Prim.Int#) (w_smg :: GHC.Base.Int -> GHC.Base.Int) ->
        case ww_sme of ds_Xlw {
          __DEFAULT ->
288 289 290
        case w_smg (GHC.Base.I# ds_Xlw) of w1_Xmo { GHC.Base.I# ww1_Xmz ->
        T.$wfoo ww1_Xmz lvl_rmV
        };
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305
          0 -> 0
        }

The recursive call has lvl_rmV as its argument, so we could create a specialised copy
with that argument baked in; that is, not passed at all.   Now it can perhaps be inlined.

When is this worth it?  Call the constant 'lvl'
- If 'lvl' has an unfolding that is a constructor, see if the corresponding
  parameter is scrutinised anywhere in the body.

- If 'lvl' has an unfolding that is a inlinable function, see if the corresponding
  parameter is applied (...to enough arguments...?)

  Also do this is if the function has RULES?

306
Also
307

308 309
Note [Specialising for lambda parameters]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
310 311 312 313 314 315 316 317 318 319 320 321 322
    foo :: Int -> (Int -> Int) -> Int
    foo 0 f = 0
    foo m f = foo (f m) (\n -> n-m)

This is subtly different from the previous one in that we get an
explicit lambda as the argument:

    T.$wfoo :: GHC.Prim.Int# -> (GHC.Base.Int -> GHC.Base.Int) ->
    GHC.Prim.Int#
    T.$wfoo =
      \ (ww_sm8 :: GHC.Prim.Int#) (w_sma :: GHC.Base.Int -> GHC.Base.Int) ->
        case ww_sm8 of ds_Xlr {
          __DEFAULT ->
323 324 325 326 327 328 329 330
        case w_sma (GHC.Base.I# ds_Xlr) of w1_Xmf { GHC.Base.I# ww1_Xmq ->
        T.$wfoo
          ww1_Xmq
          (\ (n_ad3 :: GHC.Base.Int) ->
             case n_ad3 of wild_alB { GHC.Base.I# x_alA ->
             GHC.Base.I# (GHC.Prim.-# x_alA ds_Xlr)
             })
        };
331 332 333 334 335 336 337 338 339 340 341 342 343
          0 -> 0
        }

I wonder if SpecConstr couldn't be extended to handle this? After all,
lambda is a sort of constructor for functions and perhaps it already
has most of the necessary machinery?

Furthermore, there's an immediate win, because you don't need to allocate the lamda
at the call site; and if perchance it's called in the recursive call, then you
may avoid allocating it altogether.  Just like for constructors.

Looks cool, but probably rare...but it might be easy to implement.

344 345 346

Note [SpecConstr for casts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
347
Consider
348 349 350 351 352 353 354 355
    data family T a :: *
    data instance T Int = T Int

    foo n = ...
       where
         go (T 0) = 0
         go (T n) = go (T (n-1))

356 357
The recursive call ends up looking like
        go (T (I# ...) `cast` g)
358 359 360
So we want to spot the construtor application inside the cast.
That's why we have the Cast case in argToPat

361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379
Note [Local recursive groups]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For a *local* recursive group, we can see all the calls to the
function, so we seed the specialisation loop from the calls in the
body, not from the calls in the RHS.  Consider:

  bar m n = foo n (n,n) (n,n) (n,n) (n,n)
   where
     foo n p q r s
       | n == 0    = m
       | n > 3000  = case p of { (p1,p2) -> foo (n-1) (p2,p1) q r s }
       | n > 2000  = case q of { (q1,q2) -> foo (n-1) p (q2,q1) r s }
       | n > 1000  = case r of { (r1,r2) -> foo (n-1) p q (r2,r1) s }
       | otherwise = case s of { (s1,s2) -> foo (n-1) p q r (s2,s1) }

If we start with the RHSs of 'foo', we get lots and lots of specialisations,
most of which are not needed.  But if we start with the (single) call
in the rhs of 'bar' we get exactly one fully-specialised copy, and all
the recursive calls go to this fully-specialised copy. Indeed, the original
380
function is later collected as dead code.  This is very important in
381 382 383
specialising the loops arising from stream fusion, for example in NDP where
we were getting literally hundreds of (mostly unused) specialisations of
a local function.
384

385 386 387 388 389 390 391 392
In a case like the above we end up never calling the original un-specialised
function.  (Although we still leave its code around just in case.)

However, if we find any boring calls in the body, including *unsaturated*
ones, such as
      letrec foo x y = ....foo...
      in map foo xs
then we will end up calling the un-specialised function, so then we *should*
393
use the calls in the un-specialised RHS as seeds.  We call these "boring
394 395 396
call patterns, and callsToPats reports if it finds any of these.


397 398 399 400 401 402 403 404 405 406 407 408 409
Note [Do not specialise diverging functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Specialising a function that just diverges is a waste of code.
Furthermore, it broke GHC (simpl014) thus:
   {-# STR Sb #-}
   f = \x. case x of (a,b) -> f x
If we specialise f we get
   f = \x. case x of (a,b) -> fspec a b
But fspec doesn't have decent strictnes info.  As it happened,
(f x) :: IO t, so the state hack applied and we eta expanded fspec,
and hence f.  But now f's strictness is less than its arity, which
breaks an invariant.

410 411 412 413 414 415 416 417 418 419 420
Note [SpecConstrAnnotation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
SpecConstrAnnotation is defined in GHC.Exts, and is only guaranteed to
be available in stage 2 (well, until the bootstrap compiler can be
guaranteed to have it)

So we define it to be () in stage1 (ie when GHCI is undefined), and
'#ifdef' out the code that uses it.

See also Note [Forcing specialisation]

421 422 423 424 425 426 427 428 429 430 431 432 433 434 435
Note [Forcing specialisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With stream fusion and in other similar cases, we want to fully specialise
some (but not necessarily all!) loops regardless of their size and the
number of specialisations. We allow a library to specify this by annotating
a type with ForceSpecConstr and then adding a parameter of that type to the
loop. Here is a (simplified) example from the vector library:

  data SPEC = SPEC | SPEC2
  {-# ANN type SPEC ForceSpecConstr #-}

  foldl :: (a -> b -> a) -> a -> Stream b -> a
  {-# INLINE foldl #-}
  foldl f z (Stream step s _) = foldl_loop SPEC z s
    where
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
436 437 438
      foldl_loop !sPEC z s = case step s of
                              Yield x s' -> foldl_loop sPEC (f z x) s'
                              Skip       -> foldl_loop sPEC z s'
439 440 441
                              Done       -> z

SpecConstr will spot the SPEC parameter and always fully specialise
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
442 443 444 445 446 447 448 449 450
foldl_loop. Note that

  * We have to prevent the SPEC argument from being removed by
    w/w which is why (a) SPEC is a sum type, and (b) we have to seq on
    the SPEC argument.

  * And lastly, the SPEC argument is ultimately eliminated by
    SpecConstr itself so there is no runtime overhead.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
451
This is all quite ugly; we ought to come up with a better design.
452 453

ForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
454 455 456 457 458 459 460
sc_force to True when calling specLoop. This flag does three things:
  * Ignore specConstrThreshold, to specialise functions of arbitrary size
        (see scTopBind)
  * Ignore specConstrCount, to make arbitrary numbers of specialisations
        (see specialise)
  * Specialise even for arguments that are not scrutinised in the loop
        (see argToPat; Trac #4488)
461

462 463 464 465
This flag is inherited for nested non-recursive bindings (which are likely to
be join points and hence should be fully specialised) but reset for nested
recursive bindings.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
466 467 468 469 470 471
What alternatives did I consider? Annotating the loop itself doesn't
work because (a) it is local and (b) it will be w/w'ed and I having
w/w propagating annotation somehow doesn't seem like a good idea. The
types of the loop arguments really seem to be the most persistent
thing.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
472
Annotating the types that make up the loop state doesn't work,
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
473 474 475 476 477 478
either, because (a) it would prevent us from using types like Either
or tuples here, (b) we don't want to restrict the set of types that
can be used in Stream states and (c) some types are fixed by the user
(e.g., the accumulator here) but we still want to specialise as much
as possible.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
479 480 481 482 483 484
ForceSpecConstr is done by way of an annotation:
  data SPEC = SPEC | SPEC2
  {-# ANN type SPEC ForceSpecConstr #-}
But SPEC is the *only* type so annotated, so it'd be better to
use a particular library type.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507
Alternatives to ForceSpecConstr
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Instead of giving the loop an extra argument of type SPEC, we
also considered *wrapping* arguments in SPEC, thus
  data SPEC a = SPEC a | SPEC2

  loop = \arg -> case arg of
                     SPEC state ->
                        case state of (x,y) -> ... loop (SPEC (x',y')) ...
                        S2 -> error ...
The idea is that a SPEC argument says "specialise this argument
regardless of whether the function case-analyses it.  But this
doesn't work well:
  * SPEC must still be a sum type, else the strictness analyser
    eliminates it
  * But that means that 'loop' won't be strict in its real payload
This loss of strictness in turn screws up specialisation, because
we may end up with calls like
   loop (SPEC (case z of (p,q) -> (q,p)))
Without the SPEC, if 'loop' was strict, the case would move out
and we'd see loop applied to a pair. But if 'loop' isn' strict
this doesn't look like a specialisable call.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
508 509
Note [NoSpecConstr]
~~~~~~~~~~~~~~~~~~~
510
The ignoreDataCon stuff allows you to say
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
511 512 513 514 515 516 517
    {-# ANN type T NoSpecConstr #-}
to mean "don't specialise on arguments of this type.  It was added
before we had ForceSpecConstr.  Lacking ForceSpecConstr we specialised
regardless of size; and then we needed a way to turn that *off*.  Now
that we have ForceSpecConstr, this NoSpecConstr is probably redundant.
(Used only for PArray.)

518
-----------------------------------------------------
519
                Stuff not yet handled
520 521 522 523
-----------------------------------------------------

Here are notes arising from Roman's work that I don't want to lose.

524 525 526 527 528 529 530 531 532 533 534 535 536 537 538
Example 1
~~~~~~~~~
    data T a = T !a

    foo :: Int -> T Int -> Int
    foo 0 t = 0
    foo x t | even x    = case t of { T n -> foo (x-n) t }
            | otherwise = foo (x-1) t

SpecConstr does no specialisation, because the second recursive call
looks like a boxed use of the argument.  A pity.

    $wfoo_sFw :: GHC.Prim.Int# -> T.T GHC.Base.Int -> GHC.Prim.Int#
    $wfoo_sFw =
      \ (ww_sFo [Just L] :: GHC.Prim.Int#) (w_sFq [Just L] :: T.T GHC.Base.Int) ->
539 540 541 542 543 544 545 546 547 548
         case ww_sFo of ds_Xw6 [Just L] {
           __DEFAULT ->
                case GHC.Prim.remInt# ds_Xw6 2 of wild1_aEF [Dead Just A] {
                  __DEFAULT -> $wfoo_sFw (GHC.Prim.-# ds_Xw6 1) w_sFq;
                  0 ->
                    case w_sFq of wild_Xy [Just L] { T.T n_ad5 [Just U(L)] ->
                    case n_ad5 of wild1_aET [Just A] { GHC.Base.I# y_aES [Just L] ->
                    $wfoo_sFw (GHC.Prim.-# ds_Xw6 y_aES) wild_Xy
                    } } };
           0 -> 0
549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568

Example 2
~~~~~~~~~
    data a :*: b = !a :*: !b
    data T a = T !a

    foo :: (Int :*: T Int) -> Int
    foo (0 :*: t) = 0
    foo (x :*: t) | even x    = case t of { T n -> foo ((x-n) :*: t) }
                  | otherwise = foo ((x-1) :*: t)

Very similar to the previous one, except that the parameters are now in
a strict tuple. Before SpecConstr, we have

    $wfoo_sG3 :: GHC.Prim.Int# -> T.T GHC.Base.Int -> GHC.Prim.Int#
    $wfoo_sG3 =
      \ (ww_sFU [Just L] :: GHC.Prim.Int#) (ww_sFW [Just L] :: T.T
    GHC.Base.Int) ->
        case ww_sFU of ds_Xws [Just L] {
          __DEFAULT ->
569 570 571 572 573 574 575 576 577 578
        case GHC.Prim.remInt# ds_Xws 2 of wild1_aEZ [Dead Just A] {
          __DEFAULT ->
            case ww_sFW of tpl_B2 [Just L] { T.T a_sFo [Just A] ->
            $wfoo_sG3 (GHC.Prim.-# ds_Xws 1) tpl_B2             -- $wfoo1
            };
          0 ->
            case ww_sFW of wild_XB [Just A] { T.T n_ad7 [Just S(L)] ->
            case n_ad7 of wild1_aFd [Just L] { GHC.Base.I# y_aFc [Just L] ->
            $wfoo_sG3 (GHC.Prim.-# ds_Xws y_aFc) wild_XB        -- $wfoo2
            } } };
579 580 581 582
          0 -> 0 }

We get two specialisations:
"SC:$wfoo1" [0] __forall {a_sFB :: GHC.Base.Int sc_sGC :: GHC.Prim.Int#}
583 584
                  Foo.$wfoo sc_sGC (Foo.T @ GHC.Base.Int a_sFB)
                  = Foo.$s$wfoo1 a_sFB sc_sGC ;
585
"SC:$wfoo2" [0] __forall {y_aFp :: GHC.Prim.Int# sc_sGC :: GHC.Prim.Int#}
586 587
                  Foo.$wfoo sc_sGC (Foo.T @ GHC.Base.Int (GHC.Base.I# y_aFp))
                  = Foo.$s$wfoo y_aFp sc_sGC ;
588 589

But perhaps the first one isn't good.  After all, we know that tpl_B2 is
590 591
a T (I# x) really, because T is strict and Int has one constructor.  (We can't
unbox the strict fields, becuase T is polymorphic!)
592

593
%************************************************************************
594
%*                                                                      *
595
\subsection{Top level wrapper stuff}
596
%*                                                                      *
597 598 599
%************************************************************************

\begin{code}
600 601 602 603 604
specConstrProgram :: ModGuts -> CoreM ModGuts
specConstrProgram guts
  = do
      dflags <- getDynFlags
      us     <- getUniqueSupplyM
605
      annos  <- getFirstAnnotations deserializeWithData guts
606 607
      let binds' = fst $ initUs us (go (initScEnv dflags annos) (mg_binds guts))
      return (guts { mg_binds = binds' })
608
  where
609
    go _   []           = return []
610
    go env (bind:binds) = do (env', bind') <- scTopBind env bind
611 612
                             binds' <- go env' binds
                             return (bind' : binds')
613 614 615 616
\end{code}


%************************************************************************
617
%*                                                                      *
618
\subsection{Environment: goes downwards}
619
%*                                                                      *
620 621 622
%************************************************************************

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
623
data ScEnv = SCE { sc_dflags :: DynFlags,
624 625 626
                   sc_size  :: Maybe Int,       -- Size threshold
                   sc_count :: Maybe Int,       -- Max # of specialisations for any one fn
                                                -- See Note [Avoiding exponential blowup]
627 628
                   sc_force :: Bool,            -- Force specialisation?
                                                -- See Note [Forcing specialisation]
629

630 631
                   sc_subst :: Subst,           -- Current substitution
                                                -- Maps InIds to OutExprs
632

633 634 635
                   sc_how_bound :: HowBoundEnv,
                        -- Binds interesting non-top-level variables
                        -- Domain is OutVars (*after* applying the substitution)
636

637 638 639
                   sc_vals  :: ValueEnv,
                        -- Domain is OutIds (*after* applying the substitution)
                        -- Used even for top-level bindings (but not imported ones)
640

641
                   sc_annotations :: UniqFM SpecConstrAnnotation
642
             }
643

644 645
---------------------
-- As we go, we apply a substitution (sc_subst) to the current term
646
type InExpr = CoreExpr          -- _Before_ applying the subst
647
type InVar  = Var
648

649
type OutExpr = CoreExpr         -- _After_ applying the subst
650 651 652 653
type OutId   = Id
type OutVar  = Var

---------------------
654
type HowBoundEnv = VarEnv HowBound      -- Domain is OutVars
655

656
---------------------
657 658 659 660
type ValueEnv = IdEnv Value             -- Domain is OutIds
data Value    = ConVal AltCon [CoreArg] -- _Saturated_ constructors
                                        --   The AltCon is never DEFAULT
              | LambdaVal               -- Inlinable lambdas or PAPs
661

662 663
instance Outputable Value where
   ppr (ConVal con args) = ppr con <+> interpp'SP args
664
   ppr LambdaVal         = ptext (sLit "<Lambda>")
665

666
---------------------
667
initScEnv :: DynFlags -> UniqFM SpecConstrAnnotation -> ScEnv
668
initScEnv dflags anns
Ian Lynagh's avatar
Ian Lynagh committed
669 670
  = SCE { sc_dflags = dflags,
          sc_size = specConstrThreshold dflags,
671
          sc_count = specConstrCount dflags,
672
          sc_force = False,
673 674 675
          sc_subst = emptySubst,
          sc_how_bound = emptyVarEnv,
          sc_vals = emptyVarEnv,
676
          sc_annotations = anns }
677

678 679
data HowBound = RecFun  -- These are the recursive functions for which
                        -- we seek interesting call patterns
680

681 682
              | RecArg  -- These are those functions' arguments, or their sub-components;
                        -- we gather occurrence information for these
683

684 685 686 687
instance Outputable HowBound where
  ppr RecFun = text "RecFun"
  ppr RecArg = text "RecArg"

688 689 690
scForce :: ScEnv -> Bool -> ScEnv
scForce env b = env { sc_force = b }

691 692 693 694
lookupHowBound :: ScEnv -> Id -> Maybe HowBound
lookupHowBound env id = lookupVarEnv (sc_how_bound env) id

scSubstId :: ScEnv -> Id -> CoreExpr
695
scSubstId env v = lookupIdSubst (text "scSubstId") (sc_subst env) v
696 697 698 699

scSubstTy :: ScEnv -> Type -> Type
scSubstTy env ty = substTy (sc_subst env) ty

700 701 702
scSubstCo :: ScEnv -> Coercion -> Coercion
scSubstCo env co = substCo (sc_subst env) co

703 704
zapScSubst :: ScEnv -> ScEnv
zapScSubst env = env { sc_subst = zapSubstEnv (sc_subst env) }
705

706
extendScInScope :: ScEnv -> [Var] -> ScEnv
707
        -- Bring the quantified variables into scope
708
extendScInScope env qvars = env { sc_subst = extendInScopeList (sc_subst env) qvars }
709

710
        -- Extend the substitution
711 712 713 714 715
extendScSubst :: ScEnv -> Var -> OutExpr -> ScEnv
extendScSubst env var expr = env { sc_subst = extendSubst (sc_subst env) var expr }

extendScSubstList :: ScEnv -> [(Var,OutExpr)] -> ScEnv
extendScSubstList env prs = env { sc_subst = extendSubstList (sc_subst env) prs }
716 717 718 719

extendHowBound :: ScEnv -> [Var] -> HowBound -> ScEnv
extendHowBound env bndrs how_bound
  = env { sc_how_bound = extendVarEnvList (sc_how_bound env)
720
                            [(bndr,how_bound) | bndr <- bndrs] }
721 722

extendBndrsWith :: HowBound -> ScEnv -> [Var] -> (ScEnv, [Var])
723
extendBndrsWith how_bound env bndrs
724
  = (env { sc_subst = subst', sc_how_bound = hb_env' }, bndrs')
725
  where
726
    (subst', bndrs') = substBndrs (sc_subst env) bndrs
727 728
    hb_env' = sc_how_bound env `extendVarEnvList`
                    [(bndr,how_bound) | bndr <- bndrs']
729 730

extendBndrWith :: HowBound -> ScEnv -> Var -> (ScEnv, Var)
731
extendBndrWith how_bound env bndr
732
  = (env { sc_subst = subst', sc_how_bound = hb_env' }, bndr')
733
  where
734 735 736 737 738
    (subst', bndr') = substBndr (sc_subst env) bndr
    hb_env' = extendVarEnv (sc_how_bound env) bndr' how_bound

extendRecBndrs :: ScEnv -> [Var] -> (ScEnv, [Var])
extendRecBndrs env bndrs  = (env { sc_subst = subst' }, bndrs')
739 740
                      where
                        (subst', bndrs') = substRecBndrs (sc_subst env) bndrs
741 742 743

extendBndr :: ScEnv -> Var -> (ScEnv, Var)
extendBndr  env bndr  = (env { sc_subst = subst' }, bndr')
744 745
                      where
                        (subst', bndr') = substBndr (sc_subst env) bndr
746

747
extendValEnv :: ScEnv -> Id -> Maybe Value -> ScEnv
748
extendValEnv env _  Nothing   = env
749
extendValEnv env id (Just cv) = env { sc_vals = extendVarEnv (sc_vals env) id cv }
750

751
extendCaseBndrs :: ScEnv -> OutExpr -> OutId -> AltCon -> [Var] -> (ScEnv, [Var])
752
-- When we encounter
753 754
--      case scrut of b
--          C x y -> ...
755 756 757 758
-- we want to bind b, to (C x y)
-- NB1: Extends only the sc_vals part of the envt
-- NB2: Kill the dead-ness info on the pattern binders x,y, since
--      they are potentially made alive by the [b -> C x y] binding
759 760
extendCaseBndrs env scrut case_bndr con alt_bndrs
   = (env2, alt_bndrs')
761
 where
762 763
   live_case_bndr = not (isDeadBinder case_bndr)
   env1 | Var v <- scrut = extendValEnv env v cval
764
        | otherwise      = env  -- See Note [Add scrutinee to ValueEnv too]
765
   env2 | live_case_bndr = extendValEnv env1 case_bndr cval
766 767 768 769 770 771 772
        | otherwise      = env1

   alt_bndrs' | case scrut of { Var {} -> True; _ -> live_case_bndr }
              = map zap alt_bndrs
              | otherwise
              = alt_bndrs

773
   cval = case con of
774 775 776 777 778 779 780 781
                DEFAULT    -> Nothing
                LitAlt {}  -> Just (ConVal con [])
                DataAlt {} -> Just (ConVal con vanilla_args)
                      where
                        vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
                                       varsToCoreExprs alt_bndrs

   zap v | isTyVar v = v                -- See NB2 above
782 783
         | otherwise = zapIdOccInfo v

784

785 786
decreaseSpecCount :: ScEnv -> Int -> ScEnv
-- See Note [Avoiding exponential blowup]
787
decreaseSpecCount env n_specs
788 789 790
  = env { sc_count = case sc_count env of
                       Nothing -> Nothing
                       Just n  -> Just (n `div` (n_specs + 1)) }
791 792
        -- The "+1" takes account of the original function;
        -- See Note [Avoiding exponential blowup]
793 794 795 796

---------------------------------------------------
-- See Note [SpecConstrAnnotation]
ignoreType    :: ScEnv -> Type   -> Bool
797
ignoreDataCon  :: ScEnv -> DataCon -> Bool
798 799 800
forceSpecBndr :: ScEnv -> Var    -> Bool
#ifndef GHCI
ignoreType    _ _ = False
801
ignoreDataCon  _ _ = False
802 803 804 805
forceSpecBndr _ _ = False

#else /* GHCI */

806
ignoreDataCon env dc = ignoreTyCon env (dataConTyCon dc)
807

808
ignoreType env ty
809 810 811
  = case tyConAppTyCon_maybe ty of
      Just tycon -> ignoreTyCon env tycon
      _          -> False
812

813 814 815
ignoreTyCon :: ScEnv -> TyCon -> Bool
ignoreTyCon env tycon
  = lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
816

817
forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTys . varType $ var
818 819 820 821 822 823 824 825 826 827 828

forceSpecFunTy :: ScEnv -> Type -> Bool
forceSpecFunTy env = any (forceSpecArgTy env) . fst . splitFunTys

forceSpecArgTy :: ScEnv -> Type -> Bool
forceSpecArgTy env ty
  | Just ty' <- coreView ty = forceSpecArgTy env ty'

forceSpecArgTy env ty
  | Just (tycon, tys) <- splitTyConApp_maybe ty
  , tycon /= funTyCon
829
      = lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
830 831 832
        || any (forceSpecArgTy env) tys

forceSpecArgTy _ _ = False
833
#endif /* GHCI */
834 835
\end{code}

836 837 838 839 840 841 842 843 844 845 846 847
Note [Add scrutinee to ValueEnv too]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this:
   case x of y
     (a,b) -> case b of c
                I# v -> ...(f y)...
By the time we get to the call (f y), the ValueEnv
will have a binding for y, and for c
    y -> (a,b)
    c -> I# v
BUT that's not enough!  Looking at the call (f y) we
see that y is pair (a,b), but we also need to know what 'b' is.
848
So in extendCaseBndrs we must *also* add the binding
849 850 851 852 853 854
   b -> I# v
else we lose a useful specialisation for f.  This is necessary even
though the simplifier has systematically replaced uses of 'x' with 'y'
and 'b' with 'c' in the code.  The use of 'b' in the ValueEnv came
from outside the case.  See Trac #4908 for the live example.

855 856 857 858 859 860
Note [Avoiding exponential blowup]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The sc_count field of the ScEnv says how many times we are prepared to
duplicate a single function.  But we must take care with recursive
specialiations.  Consider

861 862
        let $j1 = let $j2 = let $j3 = ...
                            in
863
                            ...$j3...
864
                  in
865
                  ...$j2...
866
        in
867 868 869 870 871 872 873 874 875 876
        ...$j1...

If we specialise $j1 then in each specialisation (as well as the original)
we can specialise $j2, and similarly $j3.  Even if we make just *one*
specialisation of each, becuase we also have the original we'll get 2^n
copies of $j3, which is not good.

So when recursively specialising we divide the sc_count by the number of
copies we are making at this level, including the original.

877 878

%************************************************************************
879
%*                                                                      *
880
\subsection{Usage information: flows upwards}
881
%*                                                                      *
882
%************************************************************************
883

884
\begin{code}
885 886
data ScUsage
   = SCU {
887 888 889
        scu_calls :: CallEnv,           -- Calls
                                        -- The functions are a subset of the
                                        --      RecFuns in the ScEnv
890

891 892
        scu_occs :: !(IdEnv ArgOcc)     -- Information on argument occurrences
     }                                  -- The domain is OutIds
893

894
type CallEnv = IdEnv [Call]
895
type Call = (ValueEnv, [CoreArg])
896 897
        -- The arguments of the call, together with the
        -- env giving the constructor bindings at the call site
898

899 900
nullUsage :: ScUsage
nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv }
901

902 903 904
combineCalls :: CallEnv -> CallEnv -> CallEnv
combineCalls = plusVarEnv_C (++)

905 906
combineUsage :: ScUsage -> ScUsage -> ScUsage
combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2),
907
                           scu_occs  = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) }
908

909
combineUsages :: [ScUsage] -> ScUsage
910 911 912
combineUsages [] = nullUsage
combineUsages us = foldr1 combineUsage us

913 914 915
lookupOccs :: ScUsage -> [OutVar] -> (ScUsage, [ArgOcc])
lookupOccs (SCU { scu_calls = sc_calls, scu_occs = sc_occs }) bndrs
  = (SCU {scu_calls = sc_calls, scu_occs = delVarEnvList sc_occs bndrs},
916 917
     [lookupVarEnv sc_occs b `orElse` NoOcc | b <- bndrs])

918 919
data ArgOcc = NoOcc     -- Doesn't occur at all; or a type argument
            | UnkOcc    -- Used in some unknown way
920

921
            | ScrutOcc  -- See Note [ScrutOcc]
922
                 (DataConEnv [ArgOcc])   -- How the sub-components are used
923

924
type DataConEnv a = UniqFM a     -- Keyed by DataCon
925

926 927
{- Note  [ScrutOcc]
~~~~~~~~~~~~~~~~~~~
928 929
An occurrence of ScrutOcc indicates that the thing, or a `cast` version of the thing,
is *only* taken apart or applied.
930

931
  Functions, literal: ScrutOcc emptyUFM
932 933 934 935 936
  Data constructors:  ScrutOcc subs,

where (subs :: UniqFM [ArgOcc]) gives usage of the *pattern-bound* components,
The domain of the UniqFM is the Unique of the data constructor

937
The [ArgOcc] is the occurrences of the *pattern-bound* components
938
of the data structure.  E.g.
939
        data T a = forall b. MkT a b (b->a)
940 941 942
A pattern binds b, x::a, y::b, z::b->a, but not 'a'!

-}
943 944

instance Outputable ArgOcc where
Ian Lynagh's avatar
Ian Lynagh committed
945
  ppr (ScrutOcc xs) = ptext (sLit "scrut-occ") <> ppr xs
946 947
  ppr UnkOcc        = ptext (sLit "unk-occ")
  ppr NoOcc         = ptext (sLit "no-occ")
948

949 950 951
evalScrutOcc :: ArgOcc
evalScrutOcc = ScrutOcc emptyUFM

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
952
-- Experimentally, this vesion of combineOcc makes ScrutOcc "win", so
953 954
-- that if the thing is scrutinised anywhere then we get to see that
-- in the overall result, even if it's also used in a boxed way
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
955
-- This might be too agressive; see Note [Reboxing] Alternative 3
956
combineOcc :: ArgOcc -> ArgOcc -> ArgOcc
957 958
combineOcc NoOcc         occ           = occ
combineOcc occ           NoOcc         = occ
959
combineOcc (ScrutOcc xs) (ScrutOcc ys) = ScrutOcc (plusUFM_C combineOccs xs ys)
960
combineOcc UnkOcc        (ScrutOcc ys) = ScrutOcc ys
961
combineOcc (ScrutOcc xs) UnkOcc        = ScrutOcc xs
962 963 964 965 966
combineOcc UnkOcc        UnkOcc        = UnkOcc

combineOccs :: [ArgOcc] -> [ArgOcc] -> [ArgOcc]
combineOccs xs ys = zipWithEqual "combineOccs" combineOcc xs ys

967
setScrutOcc :: ScEnv -> ScUsage -> OutExpr -> ArgOcc -> ScUsage
Thomas Schilling's avatar
Thomas Schilling committed
968
-- _Overwrite_ the occurrence info for the scrutinee, if the scrutinee
969
-- is a variable, and an interesting variable
970 971
setScrutOcc env usg (Cast e _) occ   = setScrutOcc env usg e occ
setScrutOcc env usg (Tick _ e) occ = setScrutOcc env usg e occ
972
setScrutOcc env usg (Var v)    occ
973
  | Just RecArg <- lookupHowBound env v = usg { scu_occs = extendVarEnv (scu_occs usg) v occ }
974 975 976
  | otherwise                           = usg
setScrutOcc _env usg _other _occ        -- Catch-all
  = usg
977 978 979
\end{code}

%************************************************************************
980
%*                                                                      *
981
\subsection{The main recursive function}
982
%*                                                                      *
983 984
%************************************************************************

985 986 987
The main recursive function gathers up usage information, and
creates specialised versions of functions.

988
\begin{code}
989
scExpr, scExpr' :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr)
990 991
        -- The unique supply is needed when we invent
        -- a new name for the specialised function and its args
992

993 994 995 996
scExpr env e = scExpr' env e


scExpr' env (Var v)     = case scSubstId env v of
997 998
                            Var v' -> return (mkVarUsage env v' [], Var v')
                            e'     -> scExpr (zapScSubst env) e'
999

1000
scExpr' env (Type t)    = return (nullUsage, Type (scSubstTy env t))
1001
scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c))
1002
scExpr' _   e@(Lit {})  = return (nullUsage, e)
1003 1004
scExpr' env (Tick t e)  = do (usg,e') <- scExpr env e
                             return (usg, Tick t e')
1005
scExpr' env (Cast e co) = do (usg, e') <- scExpr env e
1006
                             return (usg, Cast e' (scSubstCo env co))
1007
scExpr' env e@(App _ _) = scApp env (collectArgs e)
1008 1009 1010
scExpr' env (Lam b e)   = do let (env', b') = extendBndr env b
                             (usg, e') <- scExpr env' e
                             return (usg, Lam b' e')
1011

1012 1013 1014 1015 1016 1017
scExpr' env (Case scrut b ty alts)
  = do  { (scrut_usg, scrut') <- scExpr env scrut
        ; case isValue (sc_vals env) scrut' of
                Just (ConVal con args) -> sc_con_app con args scrut'
                _other                 -> sc_vanilla scrut_usg scrut'
        }
1018
  where
1019 1020 1021 1022 1023 1024 1025
    sc_con_app con args scrut'  -- Known constructor; simplify
        = do { let (_, bs, rhs) = findAlt con alts
                                  `orElse` (DEFAULT, [], mkImpossibleExpr ty)
                   alt_env'  = extendScSubstList env ((b,scrut') : bs `zip` trimConArgs con args)
             ; scExpr alt_env' rhs }

    sc_vanilla scrut_usg scrut' -- Normal case
1026
     = do { let (alt_env,b') = extendBndrWith RecArg env b
1027
                        -- Record RecArg for the components
1028

1029 1030
          ; (alt_usgs, alt_occs, alts')
                <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts
1031

1032 1033 1034 1035 1036
          ; let scrut_occ  = foldr combineOcc NoOcc alt_occs
                scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ
                -- The combined usage of the scrutinee is given
                -- by scrut_occ, which is passed to scScrut, which
                -- in turn treats a bare-variable scrutinee specially
1037

1038 1039
          ; return (foldr combineUsage scrut_usg' alt_usgs,
                    Case scrut' b' (scSubstTy env ty) alts') }
1040

1041 1042
    sc_alt env scrut' b' (con,bs,rhs)
      = do { let (env1, bs1) = extendBndrsWith RecArg env bs
1043 1044 1045 1046 1047 1048 1049
                 (env2, bs2) = extendCaseBndrs env1 scrut' b' con bs1
           ; (usg, rhs') <- scExpr env2 rhs
           ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2)
                 scrut_occ = case con of
                                DataAlt dc -> ScrutOcc (unitUFM dc arg_occs)
                                _          -> ScrutOcc emptyUFM
           ; return (usg', b_occ `combineOcc` scrut_occ, (con, bs2, rhs')) }
1050 1051

scExpr' env (Let (NonRec bndr rhs) body)
1052
  | isTyVar bndr        -- Type-lets may be created by doBeta
1053
  = scExpr' (extendScSubst env bndr rhs) body
1054

1055 1056 1057
  | otherwise
  = do  { let (body_env, bndr') = extendBndr env bndr
        ; (rhs_usg, rhs_info) <- scRecRhs env (bndr',rhs)
1058

1059 1060 1061
        ; let body_env2 = extendHowBound body_env [bndr'] RecFun
                                   -- Note [Local let bindings]
              RI _ rhs' _ _ _ = rhs_info
1062 1063
              body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs')

1064
        ; (body_usg, body') <- scExpr body_env3 body
1065

1066 1067
          -- NB: For non-recursive bindings we inherit sc_force flag from
          -- the parent function (see Note [Forcing specialisation])
1068 1069 1070
        ; (spec_usg, specs) <- specialise env
                                          (scu_calls body_usg)
                                          rhs_info
1071
                                          (SI [] 0 (Just rhs_usg))
1072

1073 1074 1075 1076
        ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' }
                    `combineUsage` rhs_usg `combineUsage` spec_usg,
                  mkLets [NonRec b r | (b,r) <- specInfoBinds rhs_info specs] body')
        }
1077

1078

1079
-- A *local* recursive group: see Note [Local recursive groups]
1080
scExpr' env (Let (Rec prs) body)
1081 1082 1083
  = do  { let (bndrs,rhss) = unzip prs
              (rhs_env1,bndrs') = extendRecBndrs env bndrs
              rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun
1084
              force_spec = any (forceSpecBndr env) bndrs'
1085
                -- Note [Forcing specialisation]
1086

1087 1088
        ; (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs rhs_env2) (bndrs' `zip` rhss)
        ; (body_usg, body')     <- scExpr rhs_env2 body