Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,393
    • Issues 4,393
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 378
    • Merge Requests 378
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #18231

Closed
Open
Opened May 25, 2020 by Sebastian Graf@sgraf812Developer

FloatOut should only eta-expand a dead-ending RHS when arity will increase

Eta-expansion can turn trivial RHSs into non-trivial RHSs. That leads to more top-level bindings after the next Simplifier run, meaning more churn. We should therefore only eta-expand (at least trivial RHSs) if we actually need to (OTOH that's only the case for CorePrep).

FloatOut is currently a bit careless in that regard. Consider

module Lib where

import Control.Monad (forever)
import Control.Monad.Trans.State.Strict

inc :: State Int ()
inc = modify' (+1)

m :: State Int ()
m = forever inc

After the second FloatOut (after demand analysis), we have

...

m :: State Int ()
m = ...

Rec {
-- RHS size: {terms: 6, types: 1, coercions: 0, joins: 0/0}
lvl_sOv
  :: GHC.Prim.Int# -> Data.Functor.Identity.Identity ((), Int)
[LclId, Arity=1, Str=<L,U>b, Cpr=b]
lvl_sOv
  = \ (x_aNg :: GHC.Prim.Int#) ->
      a'_sO0 (GHC.Types.I# (GHC.Prim.+# x_aNg 1#))

-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
a'_sO0 [Occ=LoopBreaker]
  :: Int -> Data.Functor.Identity.Identity ((), Int)
[LclId, Arity=1, Str=<L,U>b, Cpr=b]
a'_sO0
  = \ (s1_aNP :: Int) ->
      case s1_aNP of { GHC.Types.I# x_aNg [Dmd=<B,A>] -> lvl_sOv x_aNg }
end Rec }

-- RHS size: {terms: 3, types: 1, coercions: 5, joins: 0/0}
a :: State Int ()
[LclIdX,
 Arity=1,
 Str=<B,1*H>b,
 Cpr=b,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)
         Tmpl= a'_sO0
               `cast` (Sym (Control.Monad.Trans.State.Strict.N:StateT[0]
                                <Int>_N <Data.Functor.Identity.Identity>_R <()>_N)
                       :: (Int -> Data.Functor.Identity.Identity ((), Int))
                          ~R# StateT Int Data.Functor.Identity.Identity ())}]
a = (\ (eta_B1 :: Int) -> a'_sO0 eta_B1)
    `cast` (Sym (Control.Monad.Trans.State.Strict.N:StateT[0]
                     <Int>_N <Data.Functor.Identity.Identity>_R <()>_N)
            :: (Int -> Data.Functor.Identity.Identity ((), Int))
               ~R# StateT Int Data.Functor.Identity.Identity ())

Both lvl and the eta-expanded RHS of a (which will lead to yet another top-level binding after the next simplifier run) are unnecessary.

Also we end up allocating an I# box in each loop iteration (in lvl). But that is probably due to the Simplifier refraining from inlining dead-ending functions. Or SetLevels. I don't know. I think we should inline that, but don't know on what grounds and if we would punish code using error by that. I have to understand Note [Bottoming floats]. Or maybe it's because we don't do strictness WW for dead-ending functions. Anyway, the allocation isn't too concerning, but the extra binding is annoying.

Edited May 25, 2020 by Sebastian Graf
Assignee
Assign to
None
Milestone
None
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#18231