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