compiler/stranal/WwLib.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[WwLib]{A library for the ``worker\/wrapper'' back-end to the strictness analyser}
   5
   6 \begin{code}
   7 module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs ) where
   8
   9 #include "HsVersions.h"
  10
  11 import CoreSyn
  12 import CoreUtils        ( exprType )
  13 import Id               ( Id, idType, mkSysLocal, idDemandInfo, setIdDemandInfo,
  14                           isOneShotLambda, setOneShotLambda, setIdUnfolding,
  15                           setIdInfo
  16                         )
  17 import IdInfo           ( vanillaIdInfo )
  18 import DataCon
  19 import Demand           ( Demand(..), DmdResult(..), Demands(..) )
  20 import MkCore           ( mkRuntimeErrorApp, aBSENT_ERROR_ID )
  21 import MkId             ( realWorldPrimId, voidArgId,
  22                           mkUnpackCase, mkProductBox )
  23 import TysPrim          ( realWorldStatePrimTy )
  24 import TysWiredIn       ( tupleCon )
  25 import Type
  26 import Coercion         ( mkSymCoercion, splitNewTypeRepCo_maybe )
  27 import BasicTypes       ( Boxity(..) )
  28 import Literal          ( absentLiteralOf )
  29 import Var              ( Var )
  30 import UniqSupply
  31 import Unique
  32 import Util             ( zipWithEqual )
  33 import Outputable
  34 import FastString
  35 \end{code}
  36
  37
  38 %************************************************************************
  39 %*                                                                      *
  40 \subsection[mkWrapperAndWorker]{@mkWrapperAndWorker@}
  41 %*                                                                      *
  42 %************************************************************************
  43
  44 Here's an example.  The original function is:
  45
  46 \begin{verbatim}
  47 g :: forall a . Int -> [a] -> a
  48
  49 g = \/\ a -> \ x ys ->
  50         case x of
  51           0 -> head ys
  52           _ -> head (tail ys)
  53 \end{verbatim}
  54
  55 From this, we want to produce:
  56 \begin{verbatim}
  57 -- wrapper (an unfolding)
  58 g :: forall a . Int -> [a] -> a
  59
  60 g = \/\ a -> \ x ys ->
  61         case x of
  62           I# x# -> $wg a x# ys
  63             -- call the worker; don't forget the type args!
  64
  65 -- worker
  66 $wg :: forall a . Int# -> [a] -> a
  67
  68 $wg = \/\ a -> \ x# ys ->
  69         let
  70             x = I# x#
  71         in
  72             case x of               -- note: body of g moved intact
  73               0 -> head ys
  74               _ -> head (tail ys)
  75 \end{verbatim}
  76
  77 Something we have to be careful about:  Here's an example:
  78
  79 \begin{verbatim}
  80 -- "f" strictness: U(P)U(P)
  81 f (I# a) (I# b) = a +# b
  82
  83 g = f   -- "g" strictness same as "f"
  84 \end{verbatim}
  85
  86 \tr{f} will get a worker all nice and friendly-like; that's good.
  87 {\em But we don't want a worker for \tr{g}}, even though it has the
  88 same strictness as \tr{f}.  Doing so could break laziness, at best.
  89
  90 Consequently, we insist that the number of strictness-info items is
  91 exactly the same as the number of lambda-bound arguments.  (This is
  92 probably slightly paranoid, but OK in practice.)  If it isn't the
  93 same, we ``revise'' the strictness info, so that we won't propagate
  94 the unusable strictness-info into the interfaces.
  95
  96
  97 %************************************************************************
  98 %*                                                                      *
  99 \subsection{The worker wrapper core}
 100 %*                                                                      *
 101 %************************************************************************
 102
 103 @mkWwBodies@ is called when doing the worker\/wrapper split inside a module.
 104
 105 \begin{code}
 106 mkWwBodies :: Type                              -- Type of original function
 107            -> [Demand]                          -- Strictness of original function
 108            -> DmdResult                         -- Info about function result
 109            -> [Bool]                            -- One-shot-ness of the function
 110            -> UniqSM ([Demand],                 -- Demands for worker (value) args
 111                       Id -> CoreExpr,           -- Wrapper body, lacking only the worker Id
 112                       CoreExpr -> CoreExpr)     -- Worker body, lacking the original function rhs
 113
 114 -- wrap_fn_args E       = \x y -> E
 115 -- work_fn_args E       = E x y
 116
 117 -- wrap_fn_str E        = case x of { (a,b) ->
 118 --                        case a of { (a1,a2) ->
 119 --                        E a1 a2 b y }}
 120 -- work_fn_str E        = \a2 a2 b y ->
 121 --                        let a = (a1,a2) in
 122 --                        let x = (a,b) in
 123 --                        E
 124
 125 mkWwBodies fun_ty demands res_info one_shots
 126   = do  { let arg_info = demands `zip` (one_shots ++ repeat False)
 127         ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs emptyTvSubst fun_ty arg_info
 128         ; (work_args, wrap_fn_str,  work_fn_str) <- mkWWstr wrap_args
 129
 130         -- Don't do CPR if the worker doesn't have any value arguments
 131         -- Then the worker is just a constant, so we don't want to unbox it.
 132         ; (wrap_fn_cpr, work_fn_cpr,  _cpr_res_ty)
 133                <- if any isId work_args then
 134                      mkWWcpr res_ty res_info
 135                   else
 136                      return (id, id, res_ty)
 137
 138         ; let (work_lam_args, work_call_args) = mkWorkerArgs work_args res_ty
 139         ; return ([idDemandInfo v | v <- work_call_args, isId v],
 140                   wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var,
 141                   mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args) }
 142         -- We use an INLINE unconditionally, even if the wrapper turns out to be
 143         -- something trivial like
 144         --      fw = ...
 145         --      f = __inline__ (coerce T fw)
 146         -- The point is to propagate the coerce to f's call sites, so even though
 147         -- f's RHS is now trivial (size 1) we still want the __inline__ to prevent
 148         -- fw from being inlined into f's RHS
 149 \end{code}
 150
 151
 152 %************************************************************************
 153 %*                                                                      *
 154 \subsection{Making wrapper args}
 155 %*                                                                      *
 156 %************************************************************************
 157
 158 During worker-wrapper stuff we may end up with an unlifted thing
 159 which we want to let-bind without losing laziness.  So we
 160 add a void argument.  E.g.
 161
 162         f = /\a -> \x y z -> E::Int#    -- E does not mention x,y,z
 163 ==>
 164         fw = /\ a -> \void -> E
 165         f  = /\ a -> \x y z -> fw realworld
 166
 167 We use the state-token type which generates no code.
 168
 169 \begin{code}
 170 mkWorkerArgs :: [Var]
 171              -> Type    -- Type of body
 172              -> ([Var], -- Lambda bound args
 173                  [Var]) -- Args at call site
 174 mkWorkerArgs args res_ty
 175     | any isId args || not (isUnLiftedType res_ty)
 176     = (args, args)
 177     | otherwise
 178     = (args ++ [voidArgId], args ++ [realWorldPrimId])
 179 \end{code}
 180
 181
 182 %************************************************************************
 183 %*                                                                      *
 184 \subsection{Coercion stuff}
 185 %*                                                                      *
 186 %************************************************************************
 187
 188 We really want to "look through" coerces.
 189 Reason: I've seen this situation:
 190
 191         let f = coerce T (\s -> E)
 192         in \x -> case x of
 193                     p -> coerce T' f
 194                     q -> \s -> E2
 195                     r -> coerce T' f
 196
 197 If only we w/w'd f, we'd get
 198         let f = coerce T (\s -> fw s)
 199             fw = \s -> E
 200         in ...
 201
 202 Now we'll inline f to get
 203
 204         let fw = \s -> E
 205         in \x -> case x of
 206                     p -> fw
 207                     q -> \s -> E2
 208                     r -> fw
 209
 210 Now we'll see that fw has arity 1, and will arity expand
 211 the \x to get what we want.
 212
 213 \begin{code}
 214 -- mkWWargs just does eta expansion
 215 -- is driven off the function type and arity.
 216 -- It chomps bites off foralls, arrows, newtypes
 217 -- and keeps repeating that until it's satisfied the supplied arity
 218
 219 mkWWargs :: TvSubst             -- Freshening substitution to apply to the type
 220                                 --   See Note [Freshen type variables]
 221          -> Type                -- The type of the function
 222          -> [(Demand,Bool)]     -- Demands and one-shot info for value arguments
 223          -> UniqSM  ([Var],             -- Wrapper args
 224                      CoreExpr -> CoreExpr,      -- Wrapper fn
 225                      CoreExpr -> CoreExpr,      -- Worker fn
 226                      Type)                      -- Type of wrapper body
 227
 228 mkWWargs subst fun_ty arg_info
 229   | Just (rep_ty, co) <- splitNewTypeRepCo_maybe fun_ty
 230         -- The newtype case is for when the function has
 231         -- a recursive newtype after the arrow (rare)
 232         -- We check for arity >= 0 to avoid looping in the case
 233         -- of a function whose type is, in effect, infinite
 234         -- [Arity is driven by looking at the term, not just the type.]
 235         --
 236         -- It's also important when we have a function returning (say) a pair
 237         -- wrapped in a recursive newtype, at least if CPR analysis can look
 238         -- through such newtypes, which it probably can since they are
 239         -- simply coerces.
 240         --
 241         -- Note (Sept 08): This case applies even if demands is empty.
 242         --                 I'm not quite sure why; perhaps it makes it
 243         --                 easier for CPR
 244   = do { (wrap_args, wrap_fn_args, work_fn_args, res_ty)
 245             <-  mkWWargs subst rep_ty arg_info
 246         ; return (wrap_args,
 247                   \e -> Cast (wrap_fn_args e) (mkSymCoercion co),
 248                   \e -> work_fn_args (Cast e co),
 249                   res_ty) }
 250
 251   | null arg_info
 252   = return ([], id, id, substTy subst fun_ty)
 253
 254   | Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty
 255   = do  { let (subst', tv') = substTyVarBndr subst tv
 256                 -- This substTyVarBndr clones the type variable when necy
 257                 -- See Note [Freshen type variables]
 258         ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
 259              <- mkWWargs subst' fun_ty' arg_info
 260         ; return (tv' : wrap_args,
 261                   Lam tv' . wrap_fn_args,
 262                   work_fn_args . (`App` Type (mkTyVarTy tv')),
 263                   res_ty) }
 264
 265   | ((dmd,one_shot):arg_info') <- arg_info
 266   , Just (arg_ty, fun_ty') <- splitFunTy_maybe fun_ty
 267   = do  { uniq <- getUniqueM
 268         ; let arg_ty' = substTy subst arg_ty
 269               id = mk_wrap_arg uniq arg_ty' dmd one_shot
 270         ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
 271               <- mkWWargs subst fun_ty' arg_info'
 272         ; return (id : wrap_args,
 273                   Lam id . wrap_fn_args,
 274                   work_fn_args . (`App` Var id),
 275                   res_ty) }
 276
 277   | otherwise
 278   = WARN( True, ppr fun_ty )                    -- Should not happen: if there is a demand
 279     return ([], id, id, substTy subst fun_ty)   -- then there should be a function arrow
 280
 281 applyToVars :: [Var] -> CoreExpr -> CoreExpr
 282 applyToVars vars fn = mkVarApps fn vars
 283
 284 mk_wrap_arg :: Unique -> Type -> Demand -> Bool -> Id
 285 mk_wrap_arg uniq ty dmd one_shot
 286   = set_one_shot one_shot (setIdDemandInfo (mkSysLocal (fsLit "w") uniq ty) dmd)
 287   where
 288     set_one_shot True  id = setOneShotLambda id
 289     set_one_shot False id = id
 290 \end{code}
 291
 292 Note [Freshen type variables]
 293 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 294 mkWWargs may be given a type like  (a~b) => <blah>
 295 Which really means                 forall (co:a~b). <blah>
 296 Because the name of the coercion variable, 'co', isn't mentioned in <blah>,
 297 nested coercion foralls may all use the same variable; and sometimes do
 298 see Var.mkWildCoVar.
 299
 300 However, when we do a worker/wrapper split, we must not use shadowed names,
 301 else we'll get
 302    f = /\ co /\co. fw co co
 303 which is obviously wrong.  Actually, the same is true of type variables, which
 304 can in principle shadow, within a type (e.g. forall a. a -> forall a. a->a).
 305 But type variables *are* mentioned in <blah>, so we must substitute.
 306
 307 That's why we carry the TvSubst through mkWWargs
 308
 309 %************************************************************************
 310 %*                                                                      *
 311 \subsection{Strictness stuff}
 312 %*                                                                      *
 313 %************************************************************************
 314
 315 \begin{code}
 316 mkWWstr :: [Var]                                -- Wrapper args; have their demand info on them
 317                                                 --  *Includes type variables*
 318         -> UniqSM ([Var],                       -- Worker args
 319                    CoreExpr -> CoreExpr,        -- Wrapper body, lacking the worker call
 320                                                 -- and without its lambdas
 321                                                 -- This fn adds the unboxing
 322
 323                    CoreExpr -> CoreExpr)        -- Worker body, lacking the original body of the function,
 324                                                 -- and lacking its lambdas.
 325                                                 -- This fn does the reboxing
 326 mkWWstr []
 327   = return ([], nop_fn, nop_fn)
 328
 329 mkWWstr (arg : args) = do
 330     (args1, wrap_fn1, work_fn1) <- mkWWstr_one arg
 331     (args2, wrap_fn2, work_fn2) <- mkWWstr args
 332     return (args1 ++ args2, wrap_fn1 . wrap_fn2, work_fn1 . work_fn2)
 333
 334 ----------------------
 335 -- mkWWstr_one wrap_arg = (work_args, wrap_fn, work_fn)
 336 --   *  wrap_fn assumes wrap_arg is in scope,
 337 --        brings into scope work_args (via cases)
 338 --   * work_fn assumes work_args are in scope, a
 339 --        brings into scope wrap_arg (via lets)
 340 mkWWstr_one :: Var -> UniqSM ([Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr)
 341 mkWWstr_one arg
 342   | isTyCoVar arg
 343   = return ([arg],  nop_fn, nop_fn)
 344
 345   | otherwise
 346   = case idDemandInfo arg of
 347
 348         -- Absent case.  We can't always handle absence for arbitrary
 349         -- unlifted types, so we need to choose just the cases we can
 350         -- (that's what mk_absent_let does)
 351       Abs | Just work_fn <- mk_absent_let arg
 352           -> return ([], nop_fn, work_fn)
 353
 354         -- Unpack case
 355       Eval (Prod cs)
 356         | Just (_arg_tycon, _tycon_arg_tys, data_con, inst_con_arg_tys)
 357                 <- deepSplitProductType_maybe (idType arg)
 358         -> do uniqs <- getUniquesM
 359               let
 360                 unpk_args      = zipWith mk_ww_local uniqs inst_con_arg_tys
 361                 unpk_args_w_ds = zipWithEqual "mkWWstr" set_worker_arg_info unpk_args cs
 362                 unbox_fn       = mkUnpackCase (sanitiseCaseBndr arg) (Var arg) unpk_args data_con
 363                 rebox_fn       = Let (NonRec arg con_app)
 364                 con_app        = mkProductBox unpk_args (idType arg)
 365               (worker_args, wrap_fn, work_fn) <- mkWWstr unpk_args_w_ds
 366               return (worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn)
 367                            -- Don't pass the arg, rebox instead
 368
 369         -- `seq` demand; evaluate in wrapper in the hope
 370         -- of dropping seqs in the worker
 371       Eval (Poly Abs)
 372         -> let
 373                 arg_w_unf = arg `setIdUnfolding` evaldUnfolding
 374                 -- Tell the worker arg that it's sure to be evaluated
 375                 -- so that internal seqs can be dropped
 376            in
 377            return ([arg_w_unf], mk_seq_case arg, nop_fn)
 378                 -- Pass the arg, anyway, even if it is in theory discarded
 379                 -- Consider
 380                 --      f x y = x `seq` y
 381                 -- x gets a (Eval (Poly Abs)) demand, but if we fail to pass it to the worker
 382                 -- we ABSOLUTELY MUST record that x is evaluated in the wrapper.
 383                 -- Something like:
 384                 --      f x y = x `seq` fw y
 385                 --      fw y = let x{Evald} = error "oops" in (x `seq` y)
 386                 -- If we don't pin on the "Evald" flag, the seq doesn't disappear, and
 387                 -- we end up evaluating the absent thunk.
 388                 -- But the Evald flag is pretty weird, and I worry that it might disappear
 389                 -- during simplification, so for now I've just nuked this whole case
 390
 391         -- Other cases
 392       _other_demand -> return ([arg], nop_fn, nop_fn)
 393
 394   where
 395         -- If the wrapper argument is a one-shot lambda, then
 396         -- so should (all) the corresponding worker arguments be
 397         -- This bites when we do w/w on a case join point
 398     set_worker_arg_info worker_arg demand = set_one_shot (setIdDemandInfo worker_arg demand)
 399
 400     set_one_shot | isOneShotLambda arg = setOneShotLambda
 401                  | otherwise           = \x -> x
 402
 403 ----------------------
 404 nop_fn :: CoreExpr -> CoreExpr
 405 nop_fn body = body
 406 \end{code}
 407
 408
 409 %************************************************************************
 410 %*                                                                      *
 411 \subsection{CPR stuff}
 412 %*                                                                      *
 413 %************************************************************************
 414
 415
 416 @mkWWcpr@ takes the worker/wrapper pair produced from the strictness
 417 info and adds in the CPR transformation.  The worker returns an
 418 unboxed tuple containing non-CPR components.  The wrapper takes this
 419 tuple and re-produces the correct structured output.
 420
 421 The non-CPR results appear ordered in the unboxed tuple as if by a
 422 left-to-right traversal of the result structure.
 423
 424
 425 \begin{code}
 426 mkWWcpr :: Type                              -- function body type
 427         -> DmdResult                         -- CPR analysis results
 428         -> UniqSM (CoreExpr -> CoreExpr,             -- New wrapper
 429                    CoreExpr -> CoreExpr,             -- New worker
 430                    Type)                        -- Type of worker's body
 431
 432 mkWWcpr body_ty RetCPR
 433     | not (isClosedAlgType body_ty)
 434     = WARN( True,
 435             text "mkWWcpr: non-algebraic or open body type" <+> ppr body_ty )
 436       return (id, id, body_ty)
 437
 438     | n_con_args == 1 && isUnLiftedType con_arg_ty1 = do
 439         -- Special case when there is a single result of unlifted type
 440         --
 441         -- Wrapper:     case (..call worker..) of x -> C x
 442         -- Worker:      case (   ..body..    ) of C x -> x
 443       (work_uniq : arg_uniq : _) <- getUniquesM
 444       let
 445         work_wild = mk_ww_local work_uniq body_ty
 446         arg       = mk_ww_local arg_uniq  con_arg_ty1
 447         con_app   = mkProductBox [arg] body_ty
 448
 449       return (\ wkr_call -> Case wkr_call (arg) (exprType con_app) [(DEFAULT, [], con_app)],
 450                 \ body     -> workerCase (work_wild) body [arg] data_con (Var arg),
 451                 con_arg_ty1)
 452
 453     | otherwise = do    -- The general case
 454         -- Wrapper: case (..call worker..) of (# a, b #) -> C a b
 455         -- Worker:  case (   ...body...  ) of C a b -> (# a, b #)
 456       uniqs <- getUniquesM
 457       let
 458         (wrap_wild : work_wild : args) = zipWith mk_ww_local uniqs (ubx_tup_ty : body_ty : con_arg_tys)
 459         arg_vars                       = map Var args
 460         ubx_tup_con                    = tupleCon Unboxed n_con_args
 461         ubx_tup_ty                     = exprType ubx_tup_app
 462         ubx_tup_app                    = mkConApp ubx_tup_con (map Type con_arg_tys   ++ arg_vars)
 463         con_app                        = mkProductBox args body_ty
 464
 465       return (\ wkr_call -> Case wkr_call (wrap_wild) (exprType con_app)  [(DataAlt ubx_tup_con, args, con_app)],
 466                 \ body     -> workerCase (work_wild) body args data_con ubx_tup_app,
 467                 ubx_tup_ty)
 468     where
 469       (_arg_tycon, _tycon_arg_tys, data_con, con_arg_tys) = deepSplitProductType "mkWWcpr" body_ty
 470       n_con_args  = length con_arg_tys
 471       con_arg_ty1 = head con_arg_tys
 472
 473 mkWWcpr body_ty _other          -- No CPR info
 474     = return (id, id, body_ty)
 475
 476 -- If the original function looked like
 477 --      f = \ x -> _scc_ "foo" E
 478 --
 479 -- then we want the CPR'd worker to look like
 480 --      \ x -> _scc_ "foo" (case E of I# x -> x)
 481 -- and definitely not
 482 --      \ x -> case (_scc_ "foo" E) of I# x -> x)
 483 --
 484 -- This transform doesn't move work or allocation
 485 -- from one cost centre to another
 486 workerCase :: Id -> CoreExpr -> [Id] -> DataCon -> CoreExpr -> CoreExpr
 487 workerCase bndr (Note (SCC cc) e) args con body = Note (SCC cc) (mkUnpackCase bndr e args con body)
 488 workerCase bndr e args con body = mkUnpackCase bndr e args con body
 489 \end{code}
 490
 491
 492 %************************************************************************
 493 %*                                                                      *
 494 \subsection{Utilities}
 495 %*                                                                      *
 496 %************************************************************************
 497
 498 Note [Absent errors]
 499 ~~~~~~~~~~~~~~~~~~~~
 500 We make a new binding for Ids that are marked absent, thus
 501    let x = absentError "x :: Int"
 502 The idea is that this binding will never be used; but if it
 503 buggily is used we'll get a runtime error message.
 504
 505 Coping with absence for *unlifted* types is important; see, for
 506 example, Trac #4306.  For these we find a suitable literal,
 507 using Literal.absentLiteralOf.  We don't have literals for
 508 every primitive type, so the function is partial.
 509
 510     [I did try the experiment of using an error thunk for unlifted
 511     things too, relying on the simplifier to drop it as dead code,
 512     by making absentError
 513       (a) *not* be a bottoming Id,
 514       (b) be "ok for speculation"
 515     But that relies on the simplifier finding that it really
 516     is dead code, which is fragile, and indeed failed when
 517     profiling is on, which disables various optimisations.  So
 518     using a literal will do.]
 519
 520 \begin{code}
 521 mk_absent_let :: Id -> Maybe (CoreExpr -> CoreExpr)
 522 mk_absent_let arg
 523   | not (isUnLiftedType arg_ty)
 524   = Just (Let (NonRec arg abs_rhs))
 525   | Just (tc, _) <- splitTyConApp_maybe arg_ty
 526   , Just lit <- absentLiteralOf tc
 527   = Just (Let (NonRec arg (Lit lit)))
 528   | arg_ty `coreEqType` realWorldStatePrimTy
 529   = Just (Let (NonRec arg (Var realWorldPrimId)))
 530   | otherwise
 531   = WARN( True, ptext (sLit "No absent value for") <+> ppr arg_ty )
 532     Nothing
 533   where
 534     arg_ty  = idType arg
 535     abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
 536     msg     = showSDocDebug (ppr arg <+> ppr (idType arg))
 537
 538 mk_seq_case :: Id -> CoreExpr -> CoreExpr
 539 mk_seq_case arg body = Case (Var arg) (sanitiseCaseBndr arg) (exprType body) [(DEFAULT, [], body)]
 540
 541 sanitiseCaseBndr :: Id -> Id
 542 -- The argument we are scrutinising has the right type to be
 543 -- a case binder, so it's convenient to re-use it for that purpose.
 544 -- But we *must* throw away all its IdInfo.  In particular, the argument
 545 -- will have demand info on it, and that demand info may be incorrect for
 546 -- the case binder.  e.g.       case ww_arg of ww_arg { I# x -> ... }
 547 -- Quite likely ww_arg isn't used in '...'.  The case may get discarded
 548 -- if the case binder says "I'm demanded".  This happened in a situation
 549 -- like         (x+y) `seq` ....
 550 sanitiseCaseBndr id = id `setIdInfo` vanillaIdInfo
 551
 552 mk_ww_local :: Unique -> Type -> Id
 553 mk_ww_local uniq ty = mkSysLocal (fsLit "ww") uniq ty
 554 \end{code}