Simon Peyton Jones pushed to branch wip/T26831 at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/CoreToStg/Prep.hs
    ... ... @@ -1539,7 +1539,12 @@ cpeArg env dmd arg
    1539 1539
                            arg3  = cpeEtaExpand arity arg2
    
    1540 1540
                            -- See Note [Eta expansion of arguments in CorePrep]
    
    1541 1541
                      ; let (arg_float, v') = mkNonRecFloat env lev v arg3
    
    1542
    -                 ---; pprTraceM "cpeArg" (ppr arg1 $$ ppr dec $$ ppr arg2)
    
    1542
    +                 ; pprTraceM "cpeArg" (vcat [ text "arg1" <+> ppr arg1
    
    1543
    +                                            , text "decision" <+>  ppr dec
    
    1544
    +                                            , text "arg2" <+> ppr arg2
    
    1545
    +                                            , text "arity" <+> ppr arity
    
    1546
    +                                            , text "arg3" <+> ppr arg3
    
    1547
    +                                            ])
    
    1543 1548
                      ; return (snocFloat floats2 arg_float, varToCoreExpr v') }
    
    1544 1549
            }
    
    1545 1550
     
    
    ... ... @@ -1578,9 +1583,15 @@ eta_would_wreck_join _ = False
    1578 1583
     
    
    1579 1584
     maybeSaturate :: Id -> CpeApp -> Int -> [CoreTickish] -> UniqSM CpeRhs
    
    1580 1585
     maybeSaturate fn expr n_args unsat_ticks
    
    1586
    +  | hasNoBinding fn || excess_arity > 0
    
    1587
    +  = return $ wrapLamBody (mkTicks unsat_ticks) sat_expr
    
    1588
    +  | otherwise
    
    1589
    +  = return expr
    
    1590
    +
    
    1591
    +{-
    
    1581 1592
       | hasNoBinding fn        -- There's no binding
    
    1582 1593
         -- See Note [Eta expansion of hasNoBinding things in CorePrep]
    
    1583
    -  = return $ wrapLamBody (\body -> foldr mkTick body unsat_ticks) sat_expr
    
    1594
    +  = return $ wrapLamBody (mkTicks unsat_ticks) sat_expr
    
    1584 1595
     
    
    1585 1596
       | mark_arity > 0 -- A call-by-value function.
    
    1586 1597
                        -- See Note [CBV Function Ids: overview]
    
    ... ... @@ -1605,6 +1616,7 @@ maybeSaturate fn expr n_args unsat_ticks
    1605 1616
       | otherwise
    
    1606 1617
       = assert (null unsat_ticks) $
    
    1607 1618
         return expr
    
    1619
    +-}
    
    1608 1620
       where
    
    1609 1621
         mark_arity    = idCbvMarkArity fn
    
    1610 1622
         fn_arity      = idArity fn