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 7{-# LANGUAGE CPP #-} 8 9module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs 10 , deepSplitProductType_maybe, findTypeShape 11 , isWorkerSmallEnough 12 ) where 13 14#include "HsVersions.h" 15 16import GhcPrelude 17 18import CoreSyn 19import CoreUtils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase ) 20import Id 21import IdInfo ( JoinArity ) 22import DataCon 23import Demand 24import MkCore ( mkAbsentErrorApp, mkCoreUbxTup 25 , mkCoreApp, mkCoreLet ) 26import MkId ( voidArgId, voidPrimId ) 27import TysWiredIn ( tupleDataCon ) 28import TysPrim ( voidPrimTy ) 29import Literal ( absentLiteralOf, rubbishLit ) 30import VarEnv ( mkInScopeSet ) 31import VarSet ( VarSet ) 32import Type 33import Predicate ( isClassPred ) 34import RepType ( isVoidTy, typePrimRep ) 35import Coercion 36import FamInstEnv 37import BasicTypes ( Boxity(..) ) 38import TyCon 39import UniqSupply 40import Unique 41import Maybes 42import Util 43import Outputable 44import DynFlags 45import FastString 46import ListSetOps 47 48{- 49************************************************************************ 50* * 51\subsection[mkWrapperAndWorker]{@mkWrapperAndWorker@} 52* * 53************************************************************************ 54 55Here's an example. The original function is: 56 57\begin{verbatim} 58g :: forall a . Int -> [a] -> a 59 60g = \/\ a -> \ x ys -> 61 case x of 62 0 -> head ys 63 _ -> head (tail ys) 64\end{verbatim} 65 66From this, we want to produce: 67\begin{verbatim} 68-- wrapper (an unfolding) 69g :: forall a . Int -> [a] -> a 70 71g = \/\ a -> \ x ys -> 72 case x of 73 I# x# -> $wg a x# ys 74 -- call the worker; don't forget the type args! 75 76-- worker 77$wg :: forall a . Int# -> [a] -> a 78 79$wg = \/\ a -> \ x# ys -> 80 let 81 x = I# x# 82 in 83 case x of -- note: body of g moved intact 84 0 -> head ys 85 _ -> head (tail ys) 86\end{verbatim} 87 88Something we have to be careful about: Here's an example: 89 90\begin{verbatim} 91-- "f" strictness: U(P)U(P) 92f (I# a) (I# b) = a +# b 93 94g = f -- "g" strictness same as "f" 95\end{verbatim} 96 97\tr{f} will get a worker all nice and friendly-like; that's good. 98{\em But we don't want a worker for \tr{g}}, even though it has the 99same strictness as \tr{f}. Doing so could break laziness, at best. 100 101Consequently, we insist that the number of strictness-info items is 102exactly the same as the number of lambda-bound arguments. (This is 103probably slightly paranoid, but OK in practice.) If it isn't the 104same, we ``revise'' the strictness info, so that we won't propagate 105the unusable strictness-info into the interfaces. 106 107 108************************************************************************ 109* * 110\subsection{The worker wrapper core} 111* * 112************************************************************************ 113 114@mkWwBodies@ is called when doing the worker\/wrapper split inside a module. 115-} 116 117type WwResult 118 = ([Demand], -- Demands for worker (value) args 119 JoinArity, -- Number of worker (type OR value) args 120 Id -> CoreExpr, -- Wrapper body, lacking only the worker Id 121 CoreExpr -> CoreExpr) -- Worker body, lacking the original function rhs 122 123mkWwBodies :: DynFlags 124 -> FamInstEnvs 125 -> VarSet -- Free vars of RHS 126 -- See Note [Freshen WW arguments] 127 -> Id -- The original function 128 -> [Demand] -- Strictness of original function 129 -> DmdResult -- Info about function result 130 -> UniqSM (Maybe WwResult) 131 132-- wrap_fn_args E = \x y -> E 133-- work_fn_args E = E x y 134 135-- wrap_fn_str E = case x of { (a,b) -> 136-- case a of { (a1,a2) -> 137-- E a1 a2 b y }} 138-- work_fn_str E = \a1 a2 b y -> 139-- let a = (a1,a2) in 140-- let x = (a,b) in 141-- E 142 143mkWwBodies dflags fam_envs rhs_fvs fun_id demands res_info 144 = do { let empty_subst = mkEmptyTCvSubst (mkInScopeSet rhs_fvs) 145 -- See Note [Freshen WW arguments] 146 147 ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) 148 <- mkWWargs empty_subst fun_ty demands 149 ; (useful1, work_args, wrap_fn_str, work_fn_str) 150 <- mkWWstr dflags fam_envs has_inlineable_prag wrap_args 151 152 -- Do CPR w/w. See Note [Always do CPR w/w] 153 ; (useful2, wrap_fn_cpr, work_fn_cpr, cpr_res_ty) 154 <- mkWWcpr (gopt Opt_CprAnal dflags) fam_envs res_ty res_info 155 156 ; let (work_lam_args, work_call_args) = mkWorkerArgs dflags work_args cpr_res_ty 157 worker_args_dmds = [idDemandInfo v | v <- work_call_args, isId v] 158 wrapper_body = wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var 159 worker_body = mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args 160 161 ; if isWorkerSmallEnough dflags work_args 162 && not (too_many_args_for_join_point wrap_args) 163 && ((useful1 && not only_one_void_argument) || useful2) 164 then return (Just (worker_args_dmds, length work_call_args, 165 wrapper_body, worker_body)) 166 else return Nothing 167 } 168 -- We use an INLINE unconditionally, even if the wrapper turns out to be 169 -- something trivial like 170 -- fw = ... 171 -- f = __inline__ (coerce T fw) 172 -- The point is to propagate the coerce to f's call sites, so even though 173 -- f's RHS is now trivial (size 1) we still want the __inline__ to prevent 174 -- fw from being inlined into f's RHS 175 where 176 fun_ty = idType fun_id 177 mb_join_arity = isJoinId_maybe fun_id 178 has_inlineable_prag = isStableUnfolding (realIdUnfolding fun_id) 179 -- See Note [Do not unpack class dictionaries] 180 181 -- Note [Do not split void functions] 182 only_one_void_argument 183 | [d] <- demands 184 , Just (arg_ty1, _) <- splitFunTy_maybe fun_ty 185 , isAbsDmd d && isVoidTy arg_ty1 186 = True 187 | otherwise 188 = False 189 190 -- Note [Join points returning functions] 191 too_many_args_for_join_point wrap_args 192 | Just join_arity <- mb_join_arity 193 , wrap_args `lengthExceeds` join_arity 194 = WARN(True, text "Unable to worker/wrapper join point with arity " <+> 195 int join_arity <+> text "but" <+> 196 int (length wrap_args) <+> text "args") 197 True 198 | otherwise 199 = False 200 201-- See Note [Limit w/w arity] 202isWorkerSmallEnough :: DynFlags -> [Var] -> Bool 203isWorkerSmallEnough dflags vars = count isId vars <= maxWorkerArgs dflags 204 -- We count only Free variables (isId) to skip Type, Kind 205 -- variables which have no runtime representation. 206 207{- 208Note [Always do CPR w/w] 209~~~~~~~~~~~~~~~~~~~~~~~~ 210At one time we refrained from doing CPR w/w for thunks, on the grounds that 211we might duplicate work. But that is already handled by the demand analyser, 212which doesn't give the CPR proprety if w/w might waste work: see 213Note [CPR for thunks] in DmdAnal. 214 215And if something *has* been given the CPR property and we don't w/w, it's 216a disaster, because then the enclosing function might say it has the CPR 217property, but now doesn't and there a cascade of disaster. A good example 218is #5920. 219 220Note [Limit w/w arity] 221~~~~~~~~~~~~~~~~~~~~~~~~ 222Guard against high worker arity as it generates a lot of stack traffic. 223A simplified example is #11565#comment:6 224 225Current strategy is very simple: don't perform w/w transformation at all 226if the result produces a wrapper with arity higher than -fmax-worker-args=. 227 228It is a bit all or nothing, consider 229 230 f (x,y) (a,b,c,d,e ... , z) = rhs 231 232Currently we will remove all w/w ness entirely. But actually we could 233w/w on the (x,y) pair... it's the huge product that is the problem. 234 235Could we instead refrain from w/w on an arg-by-arg basis? Yes, that'd 236solve f. But we can get a lot of args from deeply-nested products: 237 238 g (a, (b, (c, (d, ...)))) = rhs 239 240This is harder to spot on an arg-by-arg basis. Previously mkWwStr was 241given some "fuel" saying how many arguments it could add; when we ran 242out of fuel it would stop w/wing. 243Still not very clever because it had a left-right bias. 244 245************************************************************************ 246* * 247\subsection{Making wrapper args} 248* * 249************************************************************************ 250 251During worker-wrapper stuff we may end up with an unlifted thing 252which we want to let-bind without losing laziness. So we 253add a void argument. E.g. 254 255 f = /\a -> \x y z -> E::Int# -- E does not mention x,y,z 256==> 257 fw = /\ a -> \void -> E 258 f = /\ a -> \x y z -> fw realworld 259 260We use the state-token type which generates no code. 261-} 262 263mkWorkerArgs :: DynFlags -> [Var] 264 -> Type -- Type of body 265 -> ([Var], -- Lambda bound args 266 [Var]) -- Args at call site 267mkWorkerArgs dflags args res_ty 268 | any isId args || not needsAValueLambda 269 = (args, args) 270 | otherwise 271 = (args ++ [voidArgId], args ++ [voidPrimId]) 272 where 273 -- See "Making wrapper args" section above 274 needsAValueLambda = 275 lifted 276 -- We may encounter a levity-polymorphic result, in which case we 277 -- conservatively assume that we have laziness that needs preservation. 278 -- See #15186. 279 || not (gopt Opt_FunToThunk dflags) 280 -- see Note [Protecting the last value argument] 281 282 -- Might the result be lifted? 283 lifted = 284 case isLiftedType_maybe res_ty of 285 Just lifted -> lifted 286 Nothing -> True 287 288{- 289Note [Protecting the last value argument] 290~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 291If the user writes (\_ -> E), they might be intentionally disallowing 292the sharing of E. Since absence analysis and worker-wrapper are keen 293to remove such unused arguments, we add in a void argument to prevent 294the function from becoming a thunk. 295 296The user can avoid adding the void argument with the -ffun-to-thunk 297flag. However, this can create sharing, which may be bad in two ways. 1) It can 298create a space leak. 2) It can prevent inlining *under a lambda*. If w/w 299removes the last argument from a function f, then f now looks like a thunk, and 300so f can't be inlined *under a lambda*. 301 302Note [Join points and beta-redexes] 303~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 304 305Originally, the worker would invoke the original function by calling it with 306arguments, thus producing a beta-redex for the simplifier to munch away: 307 308 \x y z -> e => (\x y z -> e) wx wy wz 309 310Now that we have special rules about join points, however, this is Not Good if 311the original function is itself a join point, as then it may contain invocations 312of other join points: 313 314 join j1 x = ... 315 join j2 y = if y == 0 then 0 else j1 y 316 317 => 318 319 join j1 x = ... 320 join $wj2 y# = let wy = I# y# in (\y -> if y == 0 then 0 else jump j1 y) wy 321 join j2 y = case y of I# y# -> jump $wj2 y# 322 323There can't be an intervening lambda between a join point's declaration and its 324occurrences, so $wj2 here is wrong. But of course, this is easy enough to fix: 325 326 ... 327 let join $wj2 y# = let wy = I# y# in let y = wy in if y == 0 then 0 else j1 y 328 ... 329 330Hence we simply do the beta-reduction here. (This would be harder if we had to 331worry about hygiene, but luckily wy is freshly generated.) 332 333Note [Join points returning functions] 334~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 335 336It is crucial that the arity of a join point depends on its *callers,* not its 337own syntax. What this means is that a join point can have "extra lambdas": 338 339f :: Int -> Int -> (Int, Int) -> Int 340f x y = join j (z, w) = \(u, v) -> ... 341 in jump j (x, y) 342 343Typically this happens with functions that are seen as computing functions, 344rather than being curried. (The real-life example was GraphOps.addConflicts.) 345 346When we create the wrapper, it *must* be in "eta-contracted" form so that the 347jump has the right number of arguments: 348 349f x y = join $wj z' w' = \u' v' -> let {z = z'; w = w'; u = u'; v = v'} in ... 350 j (z, w) = jump $wj z w 351 352(See Note [Join points and beta-redexes] for where the lets come from.) If j 353were a function, we would instead say 354 355f x y = let $wj = \z' w' u' v' -> let {z = z'; w = w'; u = u'; v = v'} in ... 356 j (z, w) (u, v) = $wj z w u v 357 358Notice that the worker ends up with the same lambdas; it's only the wrapper we 359have to be concerned about. 360 361FIXME Currently the functionality to produce "eta-contracted" wrappers is 362unimplemented; we simply give up. 363 364************************************************************************ 365* * 366\subsection{Coercion stuff} 367* * 368************************************************************************ 369 370We really want to "look through" coerces. 371Reason: I've seen this situation: 372 373 let f = coerce T (\s -> E) 374 in \x -> case x of 375 p -> coerce T' f 376 q -> \s -> E2 377 r -> coerce T' f 378 379If only we w/w'd f, we'd get 380 let f = coerce T (\s -> fw s) 381 fw = \s -> E 382 in ... 383 384Now we'll inline f to get 385 386 let fw = \s -> E 387 in \x -> case x of 388 p -> fw 389 q -> \s -> E2 390 r -> fw 391 392Now we'll see that fw has arity 1, and will arity expand 393the \x to get what we want. 394-} 395 396-- mkWWargs just does eta expansion 397-- is driven off the function type and arity. 398-- It chomps bites off foralls, arrows, newtypes 399-- and keeps repeating that until it's satisfied the supplied arity 400 401mkWWargs :: TCvSubst -- Freshening substitution to apply to the type 402 -- See Note [Freshen WW arguments] 403 -> Type -- The type of the function 404 -> [Demand] -- Demands and one-shot info for value arguments 405 -> UniqSM ([Var], -- Wrapper args 406 CoreExpr -> CoreExpr, -- Wrapper fn 407 CoreExpr -> CoreExpr, -- Worker fn 408 Type) -- Type of wrapper body 409 410mkWWargs subst fun_ty demands 411 | null demands 412 = return ([], id, id, substTy subst fun_ty) 413 414 | (dmd:demands') <- demands 415 , Just (arg_ty, fun_ty') <- splitFunTy_maybe fun_ty 416 = do { uniq <- getUniqueM 417 ; let arg_ty' = substTy subst arg_ty 418 id = mk_wrap_arg uniq arg_ty' dmd 419 ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) 420 <- mkWWargs subst fun_ty' demands' 421 ; return (id : wrap_args, 422 Lam id . wrap_fn_args, 423 apply_or_bind_then work_fn_args (varToCoreExpr id), 424 res_ty) } 425 426 | Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty 427 = do { uniq <- getUniqueM 428 ; let (subst', tv') = cloneTyVarBndr subst tv uniq 429 -- See Note [Freshen WW arguments] 430 ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) 431 <- mkWWargs subst' fun_ty' demands 432 ; return (tv' : wrap_args, 433 Lam tv' . wrap_fn_args, 434 apply_or_bind_then work_fn_args (mkTyArg (mkTyVarTy tv')), 435 res_ty) } 436 437 | Just (co, rep_ty) <- topNormaliseNewType_maybe fun_ty 438 -- The newtype case is for when the function has 439 -- a newtype after the arrow (rare) 440 -- 441 -- It's also important when we have a function returning (say) a pair 442 -- wrapped in a newtype, at least if CPR analysis can look 443 -- through such newtypes, which it probably can since they are 444 -- simply coerces. 445 446 = do { (wrap_args, wrap_fn_args, work_fn_args, res_ty) 447 <- mkWWargs subst rep_ty demands 448 ; let co' = substCo subst co 449 ; return (wrap_args, 450 \e -> Cast (wrap_fn_args e) (mkSymCo co'), 451 \e -> work_fn_args (Cast e co'), 452 res_ty) } 453 454 | otherwise 455 = WARN( True, ppr fun_ty ) -- Should not happen: if there is a demand 456 return ([], id, id, substTy subst fun_ty) -- then there should be a function arrow 457 where 458 -- See Note [Join points and beta-redexes] 459 apply_or_bind_then k arg (Lam bndr body) 460 = mkCoreLet (NonRec bndr arg) (k body) -- Important that arg is fresh! 461 apply_or_bind_then k arg fun 462 = k $ mkCoreApp (text "mkWWargs") fun arg 463applyToVars :: [Var] -> CoreExpr -> CoreExpr 464applyToVars vars fn = mkVarApps fn vars 465 466mk_wrap_arg :: Unique -> Type -> Demand -> Id 467mk_wrap_arg uniq ty dmd 468 = mkSysLocalOrCoVar (fsLit "w") uniq ty 469 `setIdDemandInfo` dmd 470 471{- Note [Freshen WW arguments] 472~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 473Wen we do a worker/wrapper split, we must not in-scope names as the arguments 474of the worker, else we'll get name capture. E.g. 475 476 -- y1 is in scope from further out 477 f x = ..y1.. 478 479If we accidentally choose y1 as a worker argument disaster results: 480 481 fww y1 y2 = let x = (y1,y2) in ...y1... 482 483To avoid this: 484 485 * We use a fresh unique for both type-variable and term-variable binders 486 Originally we lacked this freshness for type variables, and that led 487 to the very obscure #12562. (A type variable in the worker shadowed 488 an outer term-variable binding.) 489 490 * Because of this cloning we have to substitute in the type/kind of the 491 new binders. That's why we carry the TCvSubst through mkWWargs. 492 493 So we need a decent in-scope set, just in case that type/kind 494 itself has foralls. We get this from the free vars of the RHS of the 495 function since those are the only variables that might be captured. 496 It's a lazy thunk, which will only be poked if the type/kind has a forall. 497 498 Another tricky case was when f :: forall a. a -> forall a. a->a 499 (i.e. with shadowing), and then the worker used the same 'a' twice. 500 501************************************************************************ 502* * 503\subsection{Strictness stuff} 504* * 505************************************************************************ 506-} 507 508mkWWstr :: DynFlags 509 -> FamInstEnvs 510 -> Bool -- True <=> INLINEABLE pragma on this function defn 511 -- See Note [Do not unpack class dictionaries] 512 -> [Var] -- Wrapper args; have their demand info on them 513 -- *Includes type variables* 514 -> UniqSM (Bool, -- Is this useful 515 [Var], -- Worker args 516 CoreExpr -> CoreExpr, -- Wrapper body, lacking the worker call 517 -- and without its lambdas 518 -- This fn adds the unboxing 519 520 CoreExpr -> CoreExpr) -- Worker body, lacking the original body of the function, 521 -- and lacking its lambdas. 522 -- This fn does the reboxing 523mkWWstr dflags fam_envs has_inlineable_prag args 524 = go args 525 where 526 go_one arg = mkWWstr_one dflags fam_envs has_inlineable_prag arg 527 528 go [] = return (False, [], nop_fn, nop_fn) 529 go (arg : args) = do { (useful1, args1, wrap_fn1, work_fn1) <- go_one arg 530 ; (useful2, args2, wrap_fn2, work_fn2) <- go args 531 ; return ( useful1 || useful2 532 , args1 ++ args2 533 , wrap_fn1 . wrap_fn2 534 , work_fn1 . work_fn2) } 535 536{- 537Note [Unpacking arguments with product and polymorphic demands] 538~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 539The argument is unpacked in a case if it has a product type and has a 540strict *and* used demand put on it. I.e., arguments, with demands such 541as the following ones: 542 543 <S,U(U, L)> 544 <S(L,S),U> 545 546will be unpacked, but 547 548 <S,U> or <B,U> 549 550will not, because the pieces aren't used. This is quite important otherwise 551we end up unpacking massive tuples passed to the bottoming function. Example: 552 553 f :: ((Int,Int) -> String) -> (Int,Int) -> a 554 f g pr = error (g pr) 555 556 main = print (f fst (1, error "no")) 557 558Does 'main' print "error 1" or "error no"? We don't really want 'f' 559to unbox its second argument. This actually happened in GHC's onwn 560source code, in Packages.applyPackageFlag, which ended up un-boxing 561the enormous DynFlags tuple, and being strict in the 562as-yet-un-filled-in pkgState files. 563-} 564 565---------------------- 566-- mkWWstr_one wrap_arg = (useful, work_args, wrap_fn, work_fn) 567-- * wrap_fn assumes wrap_arg is in scope, 568-- brings into scope work_args (via cases) 569-- * work_fn assumes work_args are in scope, a 570-- brings into scope wrap_arg (via lets) 571-- See Note [How to do the worker/wrapper split] 572mkWWstr_one :: DynFlags -> FamInstEnvs 573 -> Bool -- True <=> INLINEABLE pragma on this function defn 574 -- See Note [Do not unpack class dictionaries] 575 -> Var 576 -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) 577mkWWstr_one dflags fam_envs has_inlineable_prag arg 578 | isTyVar arg 579 = return (False, [arg], nop_fn, nop_fn) 580 581 | isAbsDmd dmd 582 , Just work_fn <- mk_absent_let dflags arg 583 -- Absent case. We can't always handle absence for arbitrary 584 -- unlifted types, so we need to choose just the cases we can 585 -- (that's what mk_absent_let does) 586 = return (True, [], nop_fn, work_fn) 587 588 | isStrictDmd dmd 589 , Just cs <- splitProdDmd_maybe dmd 590 -- See Note [Unpacking arguments with product and polymorphic demands] 591 , not (has_inlineable_prag && isClassPred arg_ty) 592 -- See Note [Do not unpack class dictionaries] 593 , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty 594 , cs `equalLength` inst_con_arg_tys 595 -- See Note [mkWWstr and unsafeCoerce] 596 = unbox_one dflags fam_envs arg cs stuff 597 598 | isSeqDmd dmd -- For seqDmd, splitProdDmd_maybe will return Nothing, but 599 -- it should behave like <S, U(AAAA)>, for some suitable arity 600 , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty 601 , let abs_dmds = map (const absDmd) inst_con_arg_tys 602 = unbox_one dflags fam_envs arg abs_dmds stuff 603 604 | otherwise -- Other cases 605 = return (False, [arg], nop_fn, nop_fn) 606 607 where 608 arg_ty = idType arg 609 dmd = idDemandInfo arg 610 611unbox_one :: DynFlags -> FamInstEnvs -> Var 612 -> [Demand] 613 -> (DataCon, [Type], [(Type, StrictnessMark)], Coercion) 614 -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) 615unbox_one dflags fam_envs arg cs 616 (data_con, inst_tys, inst_con_arg_tys, co) 617 = do { (uniq1:uniqs) <- getUniquesM 618 ; let -- See Note [Add demands for strict constructors] 619 cs' = addDataConStrictness data_con cs 620 unpk_args = zipWith3 mk_ww_arg uniqs inst_con_arg_tys cs' 621 unbox_fn = mkUnpackCase (Var arg) co uniq1 622 data_con unpk_args 623 arg_no_unf = zapStableUnfolding arg 624 -- See Note [Zap unfolding when beta-reducing] 625 -- in Simplify.hs; and see #13890 626 rebox_fn = Let (NonRec arg_no_unf con_app) 627 con_app = mkConApp2 data_con inst_tys unpk_args `mkCast` mkSymCo co 628 ; (_, worker_args, wrap_fn, work_fn) <- mkWWstr dflags fam_envs False unpk_args 629 ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } 630 -- Don't pass the arg, rebox instead 631 where 632 mk_ww_arg uniq ty sub_dmd = setIdDemandInfo (mk_ww_local uniq ty) sub_dmd 633 634---------------------- 635nop_fn :: CoreExpr -> CoreExpr 636nop_fn body = body 637 638addDataConStrictness :: DataCon -> [Demand] -> [Demand] 639-- See Note [Add demands for strict constructors] 640addDataConStrictness con ds 641 = ASSERT2( equalLength strs ds, ppr con $$ ppr strs $$ ppr ds ) 642 zipWith add ds strs 643 where 644 strs = dataConRepStrictness con 645 add dmd str | isMarkedStrict str = strictifyDmd dmd 646 | otherwise = dmd 647 648{- Note [How to do the worker/wrapper split] 649~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 650The worker-wrapper transformation, mkWWstr_one, takes into account 651several possibilities to decide if the function is worthy for 652splitting: 653 6541. If an argument is absent, it would be silly to pass it to 655 the worker. Hence the isAbsDmd case. This case must come 656 first because a demand like <S,A> or <B,A> is possible. 657 E.g. <B,A> comes from a function like 658 f x = error "urk" 659 and <S,A> can come from Note [Add demands for strict constructors] 660 6612. If the argument is evaluated strictly, and we can split the 662 product demand (splitProdDmd_maybe), then unbox it and w/w its 663 pieces. For example 664 665 f :: (Int, Int) -> Int 666 f p = (case p of (a,b) -> a) + 1 667 is split to 668 f :: (Int, Int) -> Int 669 f p = case p of (a,b) -> $wf a 670 671 $wf :: Int -> Int 672 $wf a = a + 1 673 674 and 675 g :: Bool -> (Int, Int) -> Int 676 g c p = case p of (a,b) -> 677 if c then a else b 678 is split to 679 g c p = case p of (a,b) -> $gw c a b 680 $gw c a b = if c then a else b 681 6822a But do /not/ split if the components are not used; that is, the 683 usage is just 'Used' rather than 'UProd'. In this case 684 splitProdDmd_maybe returns Nothing. Otherwise we risk decomposing 685 a massive tuple which is barely used. Example: 686 687 f :: ((Int,Int) -> String) -> (Int,Int) -> a 688 f g pr = error (g pr) 689 690 main = print (f fst (1, error "no")) 691 692 Here, f does not take 'pr' apart, and it's stupid to do so. 693 Imagine that it had millions of fields. This actually happened 694 in GHC itself where the tuple was DynFlags 695 6963. A plain 'seqDmd', which is head-strict with usage UHead, can't 697 be split by splitProdDmd_maybe. But we want it to behave just 698 like U(AAAA) for suitable number of absent demands. So we have 699 a special case for it, with arity coming from the data constructor. 700 701Note [Worker-wrapper for bottoming functions] 702~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 703We used not to split if the result is bottom. 704[Justification: there's no efficiency to be gained.] 705 706But it's sometimes bad not to make a wrapper. Consider 707 fw = \x# -> let x = I# x# in case e of 708 p1 -> error_fn x 709 p2 -> error_fn x 710 p3 -> the real stuff 711The re-boxing code won't go away unless error_fn gets a wrapper too. 712[We don't do reboxing now, but in general it's better to pass an 713unboxed thing to f, and have it reboxed in the error cases....] 714 715Note [Add demands for strict constructors] 716~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 717Consider this program (due to Roman): 718 719 data X a = X !a 720 721 foo :: X Int -> Int -> Int 722 foo (X a) n = go 0 723 where 724 go i | i < n = a + go (i+1) 725 | otherwise = 0 726 727We want the worker for 'foo' too look like this: 728 729 $wfoo :: Int# -> Int# -> Int# 730 731with the first argument unboxed, so that it is not eval'd each time 732around the 'go' loop (which would otherwise happen, since 'foo' is not 733strict in 'a'). It is sound for the wrapper to pass an unboxed arg 734because X is strict, so its argument must be evaluated. And if we 735*don't* pass an unboxed argument, we can't even repair it by adding a 736`seq` thus: 737 738 foo (X a) n = a `seq` go 0 739 740because the seq is discarded (very early) since X is strict! 741 742So here's what we do 743 744* We leave the demand-analysis alone. The demand on 'a' in the 745 definition of 'foo' is <L, U(U)>; the strictness info is Lazy 746 because foo's body may or may not evaluate 'a'; but the usage info 747 says that 'a' is unpacked and its content is used. 748 749* During worker/wrapper, if we unpack a strict constructor (as we do 750 for 'foo'), we use 'addDataConStrictness' to bump up the strictness on 751 the strict arguments of the data constructor. 752 753* That in turn means that, if the usage info supports doing so 754 (i.e. splitProdDmd_maybe returns Just), we will unpack that argument 755 -- even though the original demand (e.g. on 'a') was lazy. 756 757* What does "bump up the strictness" mean? Just add a head-strict 758 demand to the strictness! Even for a demand like <L,A> we can 759 safely turn it into <S,A>; remember case (1) of 760 Note [How to do the worker/wrapper split]. 761 762The net effect is that the w/w transformation is more aggressive about 763unpacking the strict arguments of a data constructor, when that 764eagerness is supported by the usage info. 765 766There is the usual danger of reboxing, which as usual we ignore. But 767if X is monomorphic, and has an UNPACK pragma, then this optimisation 768is even more important. We don't want the wrapper to rebox an unboxed 769argument, and pass an Int to $wfoo! 770 771This works in nested situations like 772 773 data family Bar a 774 data instance Bar (a, b) = BarPair !(Bar a) !(Bar b) 775 newtype instance Bar Int = Bar Int 776 777 foo :: Bar ((Int, Int), Int) -> Int -> Int 778 foo f k = case f of BarPair x y -> 779 case burble of 780 True -> case x of 781 BarPair p q -> ... 782 False -> ... 783 784The extra eagerness lets us produce a worker of type: 785 $wfoo :: Int# -> Int# -> Int# -> Int -> Int 786 $wfoo p# q# y# = ... 787 788even though the `case x` is only lazily evaluated. 789 790--------- Historical note ------------ 791We used to add data-con strictness demands when demand analysing case 792expression. However, it was noticed in #15696 that this misses some cases. For 793instance, consider the program (from T10482) 794 795 data family Bar a 796 data instance Bar (a, b) = BarPair !(Bar a) !(Bar b) 797 newtype instance Bar Int = Bar Int 798 799 foo :: Bar ((Int, Int), Int) -> Int -> Int 800 foo f k = 801 case f of 802 BarPair x y -> case burble of 803 True -> case x of 804 BarPair p q -> ... 805 False -> ... 806 807We really should be able to assume that `p` is already evaluated since it came 808from a strict field of BarPair. This strictness would allow us to produce a 809worker of type: 810 811 $wfoo :: Int# -> Int# -> Int# -> Int -> Int 812 $wfoo p# q# y# = ... 813 814even though the `case x` is only lazily evaluated 815 816Indeed before we fixed #15696 this would happen since we would float the inner 817`case x` through the `case burble` to get: 818 819 foo f k = 820 case f of 821 BarPair x y -> case x of 822 BarPair p q -> case burble of 823 True -> ... 824 False -> ... 825 826However, after fixing #15696 this could no longer happen (for the reasons 827discussed in ticket:15696#comment:76). This means that the demand placed on `f` 828would then be significantly weaker (since the False branch of the case on 829`burble` is not strict in `p` or `q`). 830 831Consequently, we now instead account for data-con strictness in mkWWstr_one, 832applying the strictness demands to the final result of DmdAnal. The result is 833that we get the strict demand signature we wanted even if we can't float 834the case on `x` up through the case on `burble`. 835 836 837Note [mkWWstr and unsafeCoerce] 838~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 839By using unsafeCoerce, it is possible to make the number of demands fail to 840match the number of constructor arguments; this happened in #8037. 841If so, the worker/wrapper split doesn't work right and we get a Core Lint 842bug. The fix here is simply to decline to do w/w if that happens. 843 844Note [Record evaluated-ness in worker/wrapper] 845~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 846Suppose we have 847 848 data T = MkT !Int Int 849 850 f :: T -> T 851 f x = e 852 853and f's is strict, and has the CPR property. The we are going to generate 854this w/w split 855 856 f x = case x of 857 MkT x1 x2 -> case $wf x1 x2 of 858 (# r1, r2 #) -> MkT r1 r2 859 860 $wfw x1 x2 = let x = MkT x1 x2 in 861 case e of 862 MkT r1 r2 -> (# r1, r2 #) 863 864Note that 865 866* In the worker $wf, inside 'e' we can be sure that x1 will be 867 evaluated (it came from unpacking the argument MkT. But that's no 868 immediately apparent in $wf 869 870* In the wrapper 'f', which we'll inline at call sites, we can be sure 871 that 'r1' has been evaluated (because it came from unpacking the result 872 MkT. But that is not immediately apparent from the wrapper code. 873 874Missing these facts isn't unsound, but it loses possible future 875opportunities for optimisation. 876 877Solution: use setCaseBndrEvald when creating 878 (A) The arg binders x1,x2 in mkWstr_one 879 See #13077, test T13077 880 (B) The result binders r1,r2 in mkWWcpr_help 881 See Trace #13077, test T13077a 882 And #13027 comment:20, item (4) 883to record that the relevant binder is evaluated. 884 885 886************************************************************************ 887* * 888 Type scrutiny that is specific to demand analysis 889* * 890************************************************************************ 891 892Note [Do not unpack class dictionaries] 893~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 894If we have 895 f :: Ord a => [a] -> Int -> a 896 {-# INLINABLE f #-} 897and we worker/wrapper f, we'll get a worker with an INLINABLE pragma 898(see Note [Worker-wrapper for INLINABLE functions] in WorkWrap), which 899can still be specialised by the type-class specialiser, something like 900 fw :: Ord a => [a] -> Int# -> a 901 902BUT if f is strict in the Ord dictionary, we might unpack it, to get 903 fw :: (a->a->Bool) -> [a] -> Int# -> a 904and the type-class specialiser can't specialise that. An example is 905#6056. 906 907But in any other situation a dictionary is just an ordinary value, 908and can be unpacked. So we track the INLINABLE pragma, and switch 909off the unpacking in mkWWstr_one (see the isClassPred test). 910 911Historical note: #14955 describes how I got this fix wrong 912the first time. 913-} 914 915deepSplitProductType_maybe 916 :: FamInstEnvs -> Type 917 -> Maybe (DataCon, [Type], [(Type, StrictnessMark)], Coercion) 918-- If deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co) 919-- then dc @ tys (args::arg_tys) :: rep_ty 920-- co :: ty ~ rep_ty 921-- Why do we return the strictness of the data-con arguments? 922-- Answer: see Note [Record evaluated-ness in worker/wrapper] 923deepSplitProductType_maybe fam_envs ty 924 | let (co, ty1) = topNormaliseType_maybe fam_envs ty 925 `orElse` (mkRepReflCo ty, ty) 926 , Just (tc, tc_args) <- splitTyConApp_maybe ty1 927 , Just con <- isDataProductTyCon_maybe tc 928 , let arg_tys = dataConInstArgTys con tc_args 929 strict_marks = dataConRepStrictness con 930 = Just (con, tc_args, zipEqual "dspt" arg_tys strict_marks, co) 931deepSplitProductType_maybe _ _ = Nothing 932 933deepSplitCprType_maybe 934 :: FamInstEnvs -> ConTag -> Type 935 -> Maybe (DataCon, [Type], [(Type, StrictnessMark)], Coercion) 936-- If deepSplitCprType_maybe n ty = Just (dc, tys, arg_tys, co) 937-- then dc @ tys (args::arg_tys) :: rep_ty 938-- co :: ty ~ rep_ty 939-- Why do we return the strictness of the data-con arguments? 940-- Answer: see Note [Record evaluated-ness in worker/wrapper] 941deepSplitCprType_maybe fam_envs con_tag ty 942 | let (co, ty1) = topNormaliseType_maybe fam_envs ty 943 `orElse` (mkRepReflCo ty, ty) 944 , Just (tc, tc_args) <- splitTyConApp_maybe ty1 945 , isDataTyCon tc 946 , let cons = tyConDataCons tc 947 , cons `lengthAtLeast` con_tag -- This might not be true if we import the 948 -- type constructor via a .hs-bool file (#8743) 949 , let con = cons `getNth` (con_tag - fIRST_TAG) 950 arg_tys = dataConInstArgTys con tc_args 951 strict_marks = dataConRepStrictness con 952 = Just (con, tc_args, zipEqual "dsct" arg_tys strict_marks, co) 953deepSplitCprType_maybe _ _ _ = Nothing 954 955findTypeShape :: FamInstEnvs -> Type -> TypeShape 956-- Uncover the arrow and product shape of a type 957-- The data type TypeShape is defined in Demand 958-- See Note [Trimming a demand to a type] in Demand 959findTypeShape fam_envs ty 960 | Just (tc, tc_args) <- splitTyConApp_maybe ty 961 , Just con <- isDataProductTyCon_maybe tc 962 = TsProd (map (findTypeShape fam_envs) $ dataConInstArgTys con tc_args) 963 964 | Just (_, res) <- splitFunTy_maybe ty 965 = TsFun (findTypeShape fam_envs res) 966 967 | Just (_, ty') <- splitForAllTy_maybe ty 968 = findTypeShape fam_envs ty' 969 970 | Just (_, ty') <- topNormaliseType_maybe fam_envs ty 971 = findTypeShape fam_envs ty' 972 973 | otherwise 974 = TsUnk 975 976{- 977************************************************************************ 978* * 979\subsection{CPR stuff} 980* * 981************************************************************************ 982 983 984@mkWWcpr@ takes the worker/wrapper pair produced from the strictness 985info and adds in the CPR transformation. The worker returns an 986unboxed tuple containing non-CPR components. The wrapper takes this 987tuple and re-produces the correct structured output. 988 989The non-CPR results appear ordered in the unboxed tuple as if by a 990left-to-right traversal of the result structure. 991-} 992 993mkWWcpr :: Bool 994 -> FamInstEnvs 995 -> Type -- function body type 996 -> DmdResult -- CPR analysis results 997 -> UniqSM (Bool, -- Is w/w'ing useful? 998 CoreExpr -> CoreExpr, -- New wrapper 999 CoreExpr -> CoreExpr, -- New worker 1000 Type) -- Type of worker's body 1001 1002mkWWcpr opt_CprAnal fam_envs body_ty res 1003 -- CPR explicitly turned off (or in -O0) 1004 | not opt_CprAnal = return (False, id, id, body_ty) 1005 -- CPR is turned on by default for -O and O2 1006 | otherwise 1007 = case returnsCPR_maybe res of 1008 Nothing -> return (False, id, id, body_ty) -- No CPR info 1009 Just con_tag | Just stuff <- deepSplitCprType_maybe fam_envs con_tag body_ty 1010 -> mkWWcpr_help stuff 1011 | otherwise 1012 -- See Note [non-algebraic or open body type warning] 1013 -> WARN( True, text "mkWWcpr: non-algebraic or open body type" <+> ppr body_ty ) 1014 return (False, id, id, body_ty) 1015 1016mkWWcpr_help :: (DataCon, [Type], [(Type,StrictnessMark)], Coercion) 1017 -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) 1018 1019mkWWcpr_help (data_con, inst_tys, arg_tys, co) 1020 | [arg1@(arg_ty1, _)] <- arg_tys 1021 , isUnliftedType arg_ty1 1022 -- Special case when there is a single result of unlifted type 1023 -- 1024 -- Wrapper: case (..call worker..) of x -> C x 1025 -- Worker: case ( ..body.. ) of C x -> x 1026 = do { (work_uniq : arg_uniq : _) <- getUniquesM 1027 ; let arg = mk_ww_local arg_uniq arg1 1028 con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co 1029 1030 ; return ( True 1031 , \ wkr_call -> mkDefaultCase wkr_call arg con_app 1032 , \ body -> mkUnpackCase body co work_uniq data_con [arg] (varToCoreExpr arg) 1033 -- varToCoreExpr important here: arg can be a coercion 1034 -- Lacking this caused #10658 1035 , arg_ty1 ) } 1036 1037 | otherwise -- The general case 1038 -- Wrapper: case (..call worker..) of (# a, b #) -> C a b 1039 -- Worker: case ( ...body... ) of C a b -> (# a, b #) 1040 = do { (work_uniq : wild_uniq : uniqs) <- getUniquesM 1041 ; let wrap_wild = mk_ww_local wild_uniq (ubx_tup_ty,MarkedStrict) 1042 args = zipWith mk_ww_local uniqs arg_tys 1043 ubx_tup_ty = exprType ubx_tup_app 1044 ubx_tup_app = mkCoreUbxTup (map fst arg_tys) (map varToCoreExpr args) 1045 con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co 1046 tup_con = tupleDataCon Unboxed (length arg_tys) 1047 1048 ; return (True 1049 , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild 1050 (DataAlt tup_con) args con_app 1051 , \ body -> mkUnpackCase body co work_uniq data_con args ubx_tup_app 1052 , ubx_tup_ty ) } 1053 1054mkUnpackCase :: CoreExpr -> Coercion -> Unique -> DataCon -> [Id] -> CoreExpr -> CoreExpr 1055-- (mkUnpackCase e co uniq Con args body) 1056-- returns 1057-- case e |> co of bndr { Con args -> body } 1058 1059mkUnpackCase (Tick tickish e) co uniq con args body -- See Note [Profiling and unpacking] 1060 = Tick tickish (mkUnpackCase e co uniq con args body) 1061mkUnpackCase scrut co uniq boxing_con unpk_args body 1062 = mkSingleAltCase casted_scrut bndr 1063 (DataAlt boxing_con) unpk_args body 1064 where 1065 casted_scrut = scrut `mkCast` co 1066 bndr = mk_ww_local uniq (exprType casted_scrut, MarkedStrict) 1067 1068{- 1069Note [non-algebraic or open body type warning] 1070~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1071 1072There are a few cases where the W/W transformation is told that something 1073returns a constructor, but the type at hand doesn't really match this. One 1074real-world example involves unsafeCoerce: 1075 foo = IO a 1076 foo = unsafeCoerce c_exit 1077 foreign import ccall "c_exit" c_exit :: IO () 1078Here CPR will tell you that `foo` returns a () constructor for sure, but trying 1079to create a worker/wrapper for type `a` obviously fails. 1080(This was a real example until ee8e792 in libraries/base.) 1081 1082It does not seem feasible to avoid all such cases already in the analyser (and 1083after all, the analysis is not really wrong), so we simply do nothing here in 1084mkWWcpr. But we still want to emit warning with -DDEBUG, to hopefully catch 1085other cases where something went avoidably wrong. 1086 1087 1088Note [Profiling and unpacking] 1089~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1090If the original function looked like 1091 f = \ x -> {-# SCC "foo" #-} E 1092 1093then we want the CPR'd worker to look like 1094 \ x -> {-# SCC "foo" #-} (case E of I# x -> x) 1095and definitely not 1096 \ x -> case ({-# SCC "foo" #-} E) of I# x -> x) 1097 1098This transform doesn't move work or allocation 1099from one cost centre to another. 1100 1101Later [SDM]: presumably this is because we want the simplifier to 1102eliminate the case, and the scc would get in the way? I'm ok with 1103including the case itself in the cost centre, since it is morally 1104part of the function (post transformation) anyway. 1105 1106 1107************************************************************************ 1108* * 1109\subsection{Utilities} 1110* * 1111************************************************************************ 1112 1113Note [Absent errors] 1114~~~~~~~~~~~~~~~~~~~~ 1115We make a new binding for Ids that are marked absent, thus 1116 let x = absentError "x :: Int" 1117The idea is that this binding will never be used; but if it 1118buggily is used we'll get a runtime error message. 1119 1120Coping with absence for *unlifted* types is important; see, for 1121example, #4306 and #15627. In the UnliftedRep case, we can 1122use LitRubbish, which we need to apply to the required type. 1123For the unlifted types of singleton kind like Float#, Addr#, etc. we 1124also find a suitable literal, using Literal.absentLiteralOf. We don't 1125have literals for every primitive type, so the function is partial. 1126 1127Note: I did try the experiment of using an error thunk for unlifted 1128things too, relying on the simplifier to drop it as dead code. 1129But this is fragile 1130 1131 - It fails when profiling is on, which disables various optimisations 1132 1133 - It fails when reboxing happens. E.g. 1134 data T = MkT Int Int# 1135 f p@(MkT a _) = ...g p.... 1136 where g is /lazy/ in 'p', but only uses the first component. Then 1137 'f' is /strict/ in 'p', and only uses the first component. So we only 1138 pass that component to the worker for 'f', which reconstructs 'p' to 1139 pass it to 'g'. Alas we can't say 1140 ...f (MkT a (absentError Int# "blah"))... 1141 bacause `MkT` is strict in its Int# argument, so we get an absentError 1142 exception when we shouldn't. Very annoying! 1143 1144So absentError is only used for lifted types. 1145-} 1146 1147-- | Tries to find a suitable dummy RHS to bind the given absent identifier to. 1148-- 1149-- If @mk_absent_let _ id == Just wrap@, then @wrap e@ will wrap a let binding 1150-- for @id@ with that RHS around @e@. Otherwise, there could no suitable RHS be 1151-- found (currently only happens for bindings of 'VecRep' representation). 1152mk_absent_let :: DynFlags -> Id -> Maybe (CoreExpr -> CoreExpr) 1153mk_absent_let dflags arg 1154 -- The lifted case: Bind 'absentError' 1155 -- See Note [Absent errors] 1156 | not (isUnliftedType arg_ty) 1157 = Just (Let (NonRec lifted_arg abs_rhs)) 1158 -- The 'UnliftedRep' (because polymorphic) case: Bind @__RUBBISH \@arg_ty@ 1159 -- See Note [Absent errors] 1160 | [UnliftedRep] <- typePrimRep arg_ty 1161 = Just (Let (NonRec arg unlifted_rhs)) 1162 -- The monomorphic unlifted cases: Bind to some literal, if possible 1163 -- See Note [Absent errors] 1164 | Just tc <- tyConAppTyCon_maybe arg_ty 1165 , Just lit <- absentLiteralOf tc 1166 = Just (Let (NonRec arg (Lit lit))) 1167 | arg_ty `eqType` voidPrimTy 1168 = Just (Let (NonRec arg (Var voidPrimId))) 1169 | otherwise 1170 = WARN( True, text "No absent value for" <+> ppr arg_ty ) 1171 Nothing -- Can happen for 'State#' and things of 'VecRep' 1172 where 1173 lifted_arg = arg `setIdStrictness` botSig 1174 -- Note in strictness signature that this is bottoming 1175 -- (for the sake of the "empty case scrutinee not known to 1176 -- diverge for sure lint" warning) 1177 arg_ty = idType arg 1178 abs_rhs = mkAbsentErrorApp arg_ty msg 1179 msg = showSDoc (gopt_set dflags Opt_SuppressUniques) 1180 (ppr arg <+> ppr (idType arg)) 1181 -- We need to suppress uniques here because otherwise they'd 1182 -- end up in the generated code as strings. This is bad for 1183 -- determinism, because with different uniques the strings 1184 -- will have different lengths and hence different costs for 1185 -- the inliner leading to different inlining. 1186 -- See also Note [Unique Determinism] in Unique 1187 unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty] 1188 1189mk_ww_local :: Unique -> (Type, StrictnessMark) -> Id 1190-- The StrictnessMark comes form the data constructor and says 1191-- whether this field is strict 1192-- See Note [Record evaluated-ness in worker/wrapper] 1193mk_ww_local uniq (ty,str) 1194 = setCaseBndrEvald str $ 1195 mkSysLocalOrCoVar (fsLit "ww") uniq ty 1196