ghc/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 (
   8         mkWwBodies,
   9         worthSplitting, setUnpackStrategy
  10     ) where
  11
  12 #include "HsVersions.h"
  13
  14 import CoreSyn
  15 import CoreUtils        ( exprType, mkInlineMe )
  16 import Id               ( Id, idType, mkSysLocal, idDemandInfo, setIdDemandInfo,
  17                           isOneShotLambda, setOneShotLambda,
  18                           mkWildId, setIdInfo
  19                         )
  20 import IdInfo           ( CprInfo(..), noCprInfo, vanillaIdInfo )
  21 import DataCon          ( DataCon, splitProductType )
  22 import Demand           ( Demand(..), wwLazy, wwPrim )
  23 import PrelInfo         ( realWorldPrimId, aBSENT_ERROR_ID )
  24 import TysPrim          ( realWorldStatePrimTy )
  25 import TysWiredIn       ( unboxedTupleCon, unboxedTupleTyCon )
  26 import Type             ( isUnLiftedType,
  27                           splitForAllTys, splitFunTys,  isAlgType,
  28                           splitAlgTyConApp_maybe, splitNewType_maybe,
  29                           mkTyConApp, mkFunTys,
  30                           Type
  31                         )
  32 import TyCon            ( isNewTyCon, isProductTyCon, TyCon )
  33 import BasicTypes       ( NewOrData(..), Arity )
  34 import Var              ( TyVar, Var, isId )
  35 import UniqSupply       ( returnUs, thenUs, getUniqueUs, getUniquesUs,
  36                           mapUs, UniqSM )
  37 import Util             ( zipWithEqual, zipEqual, lengthExceeds )
  38 import Outputable
  39 import List             ( zipWith4 )
  40 \end{code}
  41
  42
  43 %************************************************************************
  44 %*                                                                      *
  45 \subsection[mkWrapperAndWorker]{@mkWrapperAndWorker@}
  46 %*                                                                      *
  47 %************************************************************************
  48
  49         ************   WARNING  ******************
  50         these comments are rather out of date
  51         *****************************************
  52
  53 @mkWrapperAndWorker@ is given:
  54 \begin{enumerate}
  55 \item
  56 The {\em original function} \tr{f}, of the form:
  57 \begin{verbatim}
  58 f = /\ tyvars -> \ args -> body
  59 \end{verbatim}
  60 The original-binder \tr{f}, the \tr{tyvars}, \tr{args}, and \tr{body}
  61 are given separately.
  62
  63 We use the Id \tr{f} mostly to get its type.
  64
  65 \item
  66 Strictness information about \tr{f}, in the form of a list of
  67 @Demands@.
  68
  69 \item
  70 A @UniqueSupply@.
  71 \end{enumerate}
  72
  73 @mkWrapperAndWorker@ produces (A BIT OUT-OF-DATE...):
  74 \begin{enumerate}
  75 \item
  76 Maybe @Nothing@: no worker/wrappering going on in this case. This can
  77 happen (a)~if the strictness info says that there is nothing
  78 interesting to do or (b)~if *any* of the argument types corresponding
  79 to ``active'' arg postitions is abstract or will be to the outside
  80 world (i.e., {\em this} module can see the constructors, but nobody
  81 else will be able to).  An ``active'' arg position is one which the
  82 wrapper has to unpack.  An importing module can't do this unpacking,
  83 so it simply has to give up and call the wrapper only.
  84
  85 \item
  86 Maybe \tr{Just (wrapper_Id, wrapper_body, worker_Id, worker_body)}.
  87
  88 The @wrapper_Id@ is just the one that was passed in, with its
  89 strictness IdInfo updated.
  90 \end{enumerate}
  91
  92 The \tr{body} of the original function may not be given (i.e., it's
  93 BOTTOM), in which case you'd jolly well better not tug on the
  94 worker-body output!
  95
  96 Here's an example.  The original function is:
  97 \begin{verbatim}
  98 g :: forall a . Int -> [a] -> a
  99
 100 g = /\ a -> \ x ys ->
 101         case x of
 102           0 -> head ys
 103           _ -> head (tail ys)
 104 \end{verbatim}
 105
 106 From this, we want to produce:
 107 \begin{verbatim}
 108 -- wrapper (an unfolding)
 109 g :: forall a . Int -> [a] -> a
 110
 111 g = /\ a -> \ x ys ->
 112         case x of
 113           I# x# -> g.wrk a x# ys
 114             -- call the worker; don't forget the type args!
 115
 116 -- worker
 117 g.wrk :: forall a . Int# -> [a] -> a
 118
 119 g.wrk = /\ a -> \ x# ys ->
 120         let
 121             x = I# x#
 122         in
 123             case x of               -- note: body of g moved intact
 124               0 -> head ys
 125               _ -> head (tail ys)
 126 \end{verbatim}
 127
 128 Something we have to be careful about:  Here's an example:
 129 \begin{verbatim}
 130 -- "f" strictness: U(P)U(P)
 131 f (I# a) (I# b) = a +# b
 132
 133 g = f   -- "g" strictness same as "f"
 134 \end{verbatim}
 135 \tr{f} will get a worker all nice and friendly-like; that's good.
 136 {\em But we don't want a worker for \tr{g}}, even though it has the
 137 same strictness as \tr{f}.  Doing so could break laziness, at best.
 138
 139 Consequently, we insist that the number of strictness-info items is
 140 exactly the same as the number of lambda-bound arguments.  (This is
 141 probably slightly paranoid, but OK in practice.)  If it isn't the
 142 same, we ``revise'' the strictness info, so that we won't propagate
 143 the unusable strictness-info into the interfaces.
 144
 145
 146 %************************************************************************
 147 %*                                                                      *
 148 \subsection{Functions over Demands}
 149 %*                                                                      *
 150 %************************************************************************
 151
 152 \begin{code}
 153 mAX_WORKER_ARGS :: Int          -- ToDo: set via flag
 154 mAX_WORKER_ARGS = 6
 155
 156 setUnpackStrategy :: [Demand] -> [Demand]
 157 setUnpackStrategy ds
 158   = snd (go (mAX_WORKER_ARGS - nonAbsentArgs ds) ds)
 159   where
 160     go :: Int                   -- Max number of args available for sub-components of [Demand]
 161        -> [Demand]
 162        -> (Int, [Demand])       -- Args remaining after subcomponents of [Demand] are unpacked
 163
 164     go n (WwUnpack nd _ cs : ds) | n' >= 0
 165                                  = WwUnpack nd True cs' `cons` go n'' ds
 166                                  | otherwise
 167                                  = WwUnpack nd False cs `cons` go n ds
 168                                  where
 169                                    n' = n + 1 - nonAbsentArgs cs
 170                                         -- Add one because we don't pass the top-level arg any more
 171                                         -- Delete # of non-absent args to which we'll now be committed
 172                                    (n'',cs') = go n' cs
 173
 174     go n (d:ds) = d `cons` go n ds
 175     go n []     = (n,[])
 176
 177     cons d (n,ds) = (n, d:ds)
 178
 179 nonAbsentArgs :: [Demand] -> Int
 180 nonAbsentArgs []                 = 0
 181 nonAbsentArgs (WwLazy True : ds) = nonAbsentArgs ds
 182 nonAbsentArgs (d           : ds) = 1 + nonAbsentArgs ds
 183
 184 worthSplitting :: [Demand]
 185                -> Bool  -- Result is bottom
 186                -> Bool  -- True <=> the wrapper would not be an identity function
 187 worthSplitting ds result_bot = any worth_it ds
 188         -- We used not to split if the result is bottom.
 189         -- [Justification:  there's no efficiency to be gained.]
 190         -- But it's sometimes bad not to make a wrapper.  Consider
 191         --      fw = \x# -> let x = I# x# in case e of
 192         --                                      p1 -> error_fn x
 193         --                                      p2 -> error_fn x
 194         --                                      p3 -> the real stuff
 195         -- The re-boxing code won't go away unless error_fn gets a wrapper too.
 196
 197   where
 198     worth_it (WwLazy True)       = True         -- Absent arg
 199     worth_it (WwUnpack _ True _) = True         -- Arg to unpack
 200     worth_it WwStrict            = False        -- Don't w/w just because of strictness
 201     worth_it other               = False
 202
 203 allAbsent :: [Demand] -> Bool
 204 allAbsent ds = all absent ds
 205   where
 206     absent (WwLazy is_absent)   = is_absent
 207     absent (WwUnpack _ True cs) = allAbsent cs
 208     absent other                = False
 209 \end{code}
 210
 211
 212 %************************************************************************
 213 %*                                                                      *
 214 \subsection{The worker wrapper core}
 215 %*                                                                      *
 216 %************************************************************************
 217
 218 @mkWwBodies@ is called when doing the worker/wrapper split inside a module.
 219
 220 \begin{code}
 221 mkWwBodies :: Type                              -- Type of original function
 222            -> Arity                             -- Arity of original function
 223            -> [Demand]                          -- Strictness of original function
 224            -> Bool                              -- True <=> function returns bottom
 225            -> [Bool]                            -- One-shot-ness of the function
 226            -> CprInfo                           -- Result of CPR analysis
 227            -> UniqSM ([Demand],                 -- Demands for worker (value) args
 228                       Id -> CoreExpr,           -- Wrapper body, lacking only the worker Id
 229                       CoreExpr -> CoreExpr)     -- Worker body, lacking the original function rhs
 230
 231 mkWwBodies fun_ty arity demands res_bot one_shots cpr_info
 232   = mkWWargs fun_ty arity demands' res_bot one_shots'   `thenUs` \ (wrap_args, wrap_fn_args,   work_fn_args, res_ty) ->
 233     mkWWstr wrap_args                                   `thenUs` \ (work_dmds, wrap_fn_str,    work_fn_str) ->
 234     mkWWcpr res_ty cpr_info                             `thenUs` \ (wrap_fn_cpr,    work_fn_cpr,  cpr_res_ty) ->
 235     mkWWfixup cpr_res_ty work_dmds                      `thenUs` \ (final_work_dmds, wrap_fn_fixup,  work_fn_fixup) ->
 236
 237     returnUs (final_work_dmds,
 238               Note InlineMe . wrap_fn_args . wrap_fn_cpr . wrap_fn_str . wrap_fn_fixup . Var,
 239               work_fn_fixup . work_fn_str . work_fn_cpr . work_fn_args)
 240         -- We use an INLINE unconditionally, even if the wrapper turns out to be
 241         -- something trivial like
 242         --      fw = ...
 243         --      f = __inline__ (coerce T fw)
 244         -- The point is to propagate the coerce to f's call sites, so even though
 245         -- f's RHS is now trivial (size 1) we still want the __inline__ to prevent
 246         -- fw from being inlined into f's RHS
 247   where
 248     demands'   = demands   ++ repeat wwLazy
 249     one_shots' = one_shots ++ repeat False
 250 \end{code}
 251
 252
 253 %************************************************************************
 254 %*                                                                      *
 255 \subsection{Coercion stuff}
 256 %*                                                                      *
 257 %************************************************************************
 258
 259
 260 We really want to "look through" coerces.
 261 Reason: I've seen this situation:
 262
 263         let f = coerce T (\s -> E)
 264         in \x -> case x of
 265                     p -> coerce T' f
 266                     q -> \s -> E2
 267                     r -> coerce T' f
 268
 269 If only we w/w'd f, we'd get
 270         let f = coerce T (\s -> fw s)
 271             fw = \s -> E
 272         in ...
 273
 274 Now we'll inline f to get
 275
 276         let fw = \s -> E
 277         in \x -> case x of
 278                     p -> fw
 279                     q -> \s -> E2
 280                     r -> fw
 281
 282 Now we'll see that fw has arity 1, and will arity expand
 283 the \x to get what we want.
 284
 285 \begin{code}
 286 -- mkWWargs is driven off the function type and arity.
 287 -- It chomps bites off foralls, arrows, newtypes
 288 -- and keeps repeating that until it's satisfied the supplied arity
 289
 290 mkWWargs :: Type -> Arity
 291          -> [Demand] -> Bool -> [Bool]          -- Both these will in due course be derived
 292                                                 -- from the type.  The [Bool] is True for a one-shot arg.
 293                                                 -- ** Both are infinite, extended with neutral values if necy **
 294          -> UniqSM  ([Var],             -- Wrapper args
 295                      CoreExpr -> CoreExpr,      -- Wrapper fn
 296                      CoreExpr -> CoreExpr,      -- Worker fn
 297                      Type)                      -- Type of wrapper body
 298
 299 mkWWargs fun_ty arity demands res_bot one_shots
 300   | (res_bot || arity > 0) && (not (null tyvars) || n_arg_tys > 0)
 301         -- If the function returns bottom, we feel free to
 302         -- build lots of wrapper args:
 303         --        \x. let v=E in \y. bottom
 304         --      = \xy. let v=E in bottom
 305   = getUniquesUs n_args         `thenUs` \ wrap_uniqs ->
 306     let
 307       val_args  = zipWith4 mk_wrap_arg wrap_uniqs arg_tys demands one_shots
 308       wrap_args = tyvars ++ val_args
 309     in
 310     mkWWargs new_fun_ty
 311              (arity - n_args)
 312              (drop n_args demands)
 313              res_bot
 314              (drop n_args one_shots)    `thenUs` \ (more_wrap_args, wrap_fn_args, work_fn_args, res_ty) ->
 315
 316     returnUs (wrap_args ++ more_wrap_args,
 317               mkLams wrap_args . wrap_fn_args,
 318               work_fn_args . applyToVars wrap_args,
 319               res_ty)
 320   where
 321     (tyvars, tau)       = splitForAllTys fun_ty
 322     (arg_tys, body_ty)  = splitFunTys tau
 323     n_arg_tys           = length arg_tys
 324     n_args              | res_bot   = n_arg_tys
 325                         | otherwise = arity `min` n_arg_tys
 326     new_fun_ty          | n_args == n_arg_tys = body_ty
 327                         | otherwise           = mkFunTys (drop n_args arg_tys) body_ty
 328
 329 mkWWargs fun_ty arity demands res_bot one_shots
 330   = case splitNewType_maybe fun_ty of
 331         Nothing     -> returnUs ([], id, id, fun_ty)
 332         Just rep_ty -> mkWWargs rep_ty arity demands res_bot one_shots  `thenUs` \ (wrap_args, wrap_fn_args, work_fn_args, res_ty) ->
 333                        returnUs (wrap_args,
 334                                  Note (Coerce fun_ty rep_ty) . wrap_fn_args,
 335                                  work_fn_args . Note (Coerce rep_ty fun_ty),
 336                                  res_ty)
 337
 338
 339 applyToVars :: [Var] -> CoreExpr -> CoreExpr
 340 applyToVars vars fn = mkVarApps fn vars
 341
 342 mk_wrap_arg uniq ty dmd one_shot
 343   = set_one_shot one_shot (setIdDemandInfo (mkSysLocal SLIT("w") uniq ty) dmd)
 344   where
 345     set_one_shot True  id = setOneShotLambda id
 346     set_one_shot False id = id
 347 \end{code}
 348
 349
 350 %************************************************************************
 351 %*                                                                      *
 352 \subsection{Fixup stuff}
 353 %*                                                                      *
 354 %************************************************************************
 355
 356 \begin{code}
 357 mkWWfixup res_ty work_dmds
 358   | null work_dmds && isUnLiftedType res_ty
 359         -- Horrid special case.  If the worker would have no arguments, and the
 360         -- function returns a primitive type value, that would make the worker into
 361         -- an unboxed value.  We box it by passing a dummy void argument, thus:
 362         --
 363         --      f = /\abc. \xyz. fw abc void
 364         --      fw = /\abc. \v. body
 365         --
 366         -- We use the state-token type which generates no code
 367   = getUniqueUs                 `thenUs` \ void_arg_uniq ->
 368     let
 369             void_arg = mk_ww_local void_arg_uniq realWorldStatePrimTy
 370     in
 371     returnUs ([wwPrim],
 372               \ call_to_worker -> App call_to_worker (Var realWorldPrimId),
 373               \ worker_body    -> Lam void_arg worker_body)
 374
 375   | otherwise
 376   = returnUs (work_dmds, id, id)
 377 \end{code}
 378
 379
 380 %************************************************************************
 381 %*                                                                      *
 382 \subsection{Strictness stuff}
 383 %*                                                                      *
 384 %************************************************************************
 385
 386 \begin{code}
 387 mkWWstr :: [Var]                                -- Wrapper args; have their demand info on them
 388                                                 -- *Includes type variables*
 389         -> UniqSM ([Demand],                    -- Demand on worker (value) args
 390                    CoreExpr -> CoreExpr,        -- Wrapper body, lacking the worker call
 391                                                 -- and without its lambdas
 392                                                 -- This fn adds the unboxing, and makes the
 393                                                 -- call passing the unboxed things
 394
 395                    CoreExpr -> CoreExpr)        -- Worker body, lacking the original body of the function,
 396                                                 -- but *with* lambdas
 397
 398 mkWWstr wrap_args
 399   = mk_ww_str wrap_args         `thenUs` \ (work_args, wrap_fn, work_fn) ->
 400     returnUs ( [idDemandInfo v | v <- work_args, isId v],
 401                \ wrapper_body -> wrap_fn (mkVarApps wrapper_body work_args),
 402                \ worker_body  -> mkLams work_args (work_fn worker_body))
 403
 404         -- Empty case
 405 mk_ww_str []
 406   = returnUs ([],
 407               \ wrapper_body -> wrapper_body,
 408               \ worker_body  -> worker_body)
 409
 410
 411 mk_ww_str (arg : ds)
 412   | isTyVar arg
 413   = mk_ww_str ds                `thenUs` \ (worker_args, wrap_fn, work_fn) ->
 414     returnUs (arg : worker_args, wrap_fn, work_fn)
 415
 416   | otherwise
 417   = case idDemandInfo arg of
 418
 419         -- Absent case
 420       WwLazy True ->
 421         mk_ww_str ds            `thenUs` \ (worker_args, wrap_fn, work_fn) ->
 422         returnUs (worker_args, wrap_fn, mk_absent_let arg . work_fn)
 423
 424         -- Unpack case
 425       WwUnpack new_or_data True cs ->
 426         getUniquesUs (length inst_con_arg_tys)          `thenUs` \ uniqs ->
 427         let
 428           unpk_args      = zipWith mk_ww_local uniqs inst_con_arg_tys
 429           unpk_args_w_ds = zipWithEqual "mk_ww_str" set_worker_arg_info unpk_args cs
 430         in
 431         mk_ww_str (unpk_args_w_ds ++ ds)                `thenUs` \ (worker_args, wrap_fn, work_fn) ->
 432         returnUs (worker_args,
 433                   mk_unpk_case new_or_data arg unpk_args data_con arg_tycon . wrap_fn,
 434                   work_fn . mk_pk_let new_or_data arg data_con tycon_arg_tys unpk_args)
 435         where
 436           (arg_tycon, tycon_arg_tys, data_con, inst_con_arg_tys) = splitProductType "mk_ww_str" (idType arg)
 437
 438         -- Other cases
 439       other_demand ->
 440         mk_ww_str ds            `thenUs` \ (worker_args, wrap_fn, work_fn) ->
 441         returnUs (arg : worker_args, wrap_fn, work_fn)
 442   where
 443         -- If the wrapper argument is a one-shot lambda, then
 444         -- so should (all) the corresponding worker arguments be
 445         -- This bites when we do w/w on a case join point
 446     set_worker_arg_info worker_arg demand = set_one_shot (setIdDemandInfo worker_arg demand)
 447
 448     set_one_shot | isOneShotLambda arg = setOneShotLambda
 449                  | otherwise           = \x -> x
 450 \end{code}
 451
 452
 453 %************************************************************************
 454 %*                                                                      *
 455 \subsection{CPR stuff}
 456 %*                                                                      *
 457 %************************************************************************
 458
 459
 460 @mkWWcpr@ takes the worker/wrapper pair produced from the strictness
 461 info and adds in the CPR transformation.  The worker returns an
 462 unboxed tuple containing non-CPR components.  The wrapper takes this
 463 tuple and re-produces the correct structured output.
 464
 465 The non-CPR results appear ordered in the unboxed tuple as if by a
 466 left-to-right traversal of the result structure.
 467
 468
 469 \begin{code}
 470 mkWWcpr :: Type                              -- function body type
 471         -> CprInfo                           -- CPR analysis results
 472         -> UniqSM (CoreExpr -> CoreExpr,             -- New wrapper
 473                    CoreExpr -> CoreExpr,             -- New worker
 474                    Type)                        -- Type of worker's body
 475
 476 mkWWcpr body_ty NoCPRInfo
 477     = returnUs (id, id, body_ty)      -- Must be just the strictness transf.
 478
 479 mkWWcpr body_ty ReturnsCPR
 480     | not (isAlgType body_ty)
 481     = WARN( True, text "mkWWcpr: non-algebraic body type" <+> ppr body_ty )
 482       returnUs (id, id, body_ty)
 483
 484     | n_con_args == 1 && isUnLiftedType con_arg_ty1
 485         -- Special case when there is a single result of unlifted type
 486     = getUniquesUs 2                    `thenUs` \ [work_uniq, arg_uniq] ->
 487       let
 488         work_wild = mk_ww_local work_uniq body_ty
 489         arg       = mk_ww_local arg_uniq  con_arg_ty1
 490       in
 491       returnUs (\ wkr_call -> Case wkr_call arg       [(DEFAULT, [], mkConApp data_con (map Type tycon_arg_tys ++ [Var arg]))],
 492                 \ body     -> Case body     work_wild [(DataAlt data_con, [arg], Var arg)],
 493                 con_arg_ty1)
 494
 495     | otherwise         -- The general case
 496     = getUniquesUs (n_con_args + 2)     `thenUs` \ uniqs ->
 497       let
 498         (wrap_wild : work_wild : args) = zipWith mk_ww_local uniqs (ubx_tup_ty : body_ty : con_arg_tys)
 499         arg_vars                       = map Var args
 500         ubx_tup_con                    = unboxedTupleCon n_con_args
 501         ubx_tup_ty                     = exprType ubx_tup_app
 502         ubx_tup_app                    = mkConApp ubx_tup_con (map Type con_arg_tys   ++ arg_vars)
 503         con_app                        = mkConApp data_con    (map Type tycon_arg_tys ++ arg_vars)
 504       in
 505       returnUs (\ wkr_call -> Case wkr_call wrap_wild [(DataAlt ubx_tup_con, args, con_app)],
 506                 \ body     -> Case body     work_wild [(DataAlt data_con,    args, ubx_tup_app)],
 507                 ubx_tup_ty)
 508     where
 509       (tycon, tycon_arg_tys, data_con, con_arg_tys) = splitProductType "mkWWcpr" body_ty
 510       n_con_args  = length con_arg_tys
 511       con_arg_ty1 = head con_arg_tys
 512 \end{code}
 513
 514
 515 %************************************************************************
 516 %*                                                                      *
 517 \subsection{Utilities}
 518 %*                                                                      *
 519 %************************************************************************
 520
 521
 522 \begin{code}
 523 mk_absent_let arg body
 524   | not (isUnLiftedType arg_ty)
 525   = Let (NonRec arg (mkTyApps (Var aBSENT_ERROR_ID) [arg_ty])) body
 526   | otherwise
 527   = panic "WwLib: haven't done mk_absent_let for primitives yet"
 528   where
 529     arg_ty = idType arg
 530
 531 mk_unpk_case NewType arg unpk_args boxing_con boxing_tycon body
 532         -- A newtype!  Use a coercion not a case
 533   = ASSERT( null other_args )
 534     Case (Note (Coerce (idType unpk_arg) (idType arg)) (Var arg))
 535          (sanitiseCaseBndr unpk_arg)
 536          [(DEFAULT,[],body)]
 537   where
 538     (unpk_arg:other_args) = unpk_args
 539
 540 mk_unpk_case DataType arg unpk_args boxing_con boxing_tycon body
 541         -- A data type
 542   = Case (Var arg)
 543          (sanitiseCaseBndr arg)
 544          [(DataAlt boxing_con, unpk_args, body)]
 545
 546 sanitiseCaseBndr :: Id -> Id
 547 -- The argument we are scrutinising has the right type to be
 548 -- a case binder, so it's convenient to re-use it for that purpose.
 549 -- But we *must* throw away all its IdInfo.  In particular, the argument
 550 -- will have demand info on it, and that demand info may be incorrect for
 551 -- the case binder.  e.g.       case ww_arg of ww_arg { I# x -> ... }
 552 -- Quite likely ww_arg isn't used in '...'.  The case may get discarded
 553 -- if the case binder says "I'm demanded".  This happened in a situation
 554 -- like         (x+y) `seq` ....
 555 sanitiseCaseBndr id = id `setIdInfo` vanillaIdInfo
 556
 557 mk_pk_let NewType arg boxing_con con_tys unpk_args body
 558   = ASSERT( null other_args )
 559     Let (NonRec arg (Note (Coerce (idType arg) (idType unpk_arg)) (Var unpk_arg))) body
 560   where
 561     (unpk_arg:other_args) = unpk_args
 562
 563 mk_pk_let DataType arg boxing_con con_tys unpk_args body
 564   = Let (NonRec arg (mkConApp boxing_con con_args)) body
 565   where
 566     con_args = map Type con_tys ++ map Var unpk_args
 567
 568
 569 mk_ww_local uniq ty = mkSysLocal SLIT("ww") uniq ty
 570
 571 \end{code}