| ... |
... |
@@ -1569,9 +1569,8 @@ cpeArg :: CorePrepEnv -> Demand |
|
1569
|
1569
|
-> CoreArg -> UniqSM (Floats, CpeArg)
|
|
1570
|
1570
|
cpeArg env dmd arg
|
|
1571
|
1571
|
= do { (floats1, arg1) <- cpeRhsE env arg -- arg1 can be a lambda
|
|
1572
|
|
- ; let arg_ty = exprType arg
|
|
1573
|
|
- lev = typeLevity arg_ty
|
|
1574
|
|
- dec = wantFloatLocal NonRecursive dmd lev floats1 arg1
|
|
|
1572
|
+ ; let lev = typeLevity (exprType arg1)
|
|
|
1573
|
+ dec = wantFloatLocal NonRecursive dmd lev floats1 arg1
|
|
1575
|
1574
|
; (floats2, arg2) <- executeFloatDecision env dec floats1 arg1
|
|
1576
|
1575
|
-- Else case: arg1 might have lambdas, and we can't
|
|
1577
|
1576
|
-- put them inside a wrapBinds
|
| ... |
... |
@@ -1581,7 +1580,13 @@ cpeArg env dmd arg |
|
1581
|
1580
|
-- see Note [ANF-ising literal string arguments]
|
|
1582
|
1581
|
; if exprIsTrivial arg2
|
|
1583
|
1582
|
then return (floats2, arg2)
|
|
1584
|
|
- else do { v <- (`setIdDemandInfo` dmd) <$> newVar env arg_ty
|
|
|
1583
|
+ else do { let arg_ty = exprType arg2
|
|
|
1584
|
+ -- NB: arg_ty might not be same as (exprType arg1) because
|
|
|
1585
|
+ -- the latter has the floats wrapped around it
|
|
|
1586
|
+ -- E.g. let a = Int in id @a{=Int} 3
|
|
|
1587
|
+ -- exprType arg1 will be `a`, but if we didn't float then
|
|
|
1588
|
+ -- exprType arg2 will be `Int`
|
|
|
1589
|
+ ; v <- (`setIdDemandInfo` dmd) <$> newVar env arg_ty
|
|
1585
|
1590
|
-- See Note [Pin demand info on floats]
|
|
1586
|
1591
|
; let arity = cpeArgArity env dec floats1 arg2
|
|
1587
|
1592
|
arg3 = cpeEtaExpand arity arg2
|