#5809: Arity analysis could be better
---------------------------------+------------------------------------------
Reporter: simonmar | Owner: simonpj
Type: bug | Status: new
Priority: normal | Milestone: 7.6.1
Component: Compiler | Version: 7.5
Keywords: | Os: Unknown/Multiple
Architecture: Unknown/Multiple | Failure: Runtime performance bug
Difficulty: Unknown | Testcase:
Blockedby: | Blocking:
Related: |
---------------------------------+------------------------------------------
Here's an example I tripped over while optimising Hoopl. Given the
following source code:
{{{
-- | if the graph being analyzed is open at the entry, there must
-- be no other entry point, or all goes horribly wrong...
analyzeFwd
:: forall n f e . NonLocal n =>
FwdPass FuelUniqSM n f
-> MaybeC e [Label]
-> Graph n e C -> Fact e f
-> FactBase f
analyzeFwd FwdPass { fp_lattice = lattice,
fp_transfer = FwdTransfer3 (ftr, mtr, ltr) }
entries g in_fact = graph g in_fact
where
graph :: Graph n e C -> Fact e f -> FactBase f
graph (GMany entry blockmap NothingO)
= case (entries, entry) of
(NothingC, JustO entry) -> block entry `cat` body (successors
entry)
(JustC entries, NothingO) -> body entries
_ -> error "bogus GADT pattern match failure"
where
body :: [Label] -> Fact C f -> Fact C f
body entries f
= fixpoint_anal Fwd lattice do_block entries blockmap f
where
do_block :: forall x . Block n C x -> FactBase f -> Fact x f
do_block b fb = block b entryFact
where entryFact = getFact lattice (entryLabel b) fb
block :: forall e x . Block n e x -> f -> Fact x f
block BNil = id
block (BlockCO n b) = ftr n `cat` block b
block (BlockCC l b n) = ftr l `cat` block b `cat` ltr n
block (BlockOC b n) = block b `cat` ltr n
block (BMiddle n) = mtr n
block (BCat b1 b2) = block b1 `cat` block b2
block (BHead h n) = block h `cat` mtr n
block (BTail n t) = mtr n `cat` block t
{-# INLINE cat #-}
cat ft1 ft2 = \f -> ft2 (ft1 f)
}}}
GHC does not eta-expand `block`, resulting in terrible code.
{{{
block_s2bB [Occ=LoopBreaker]
:: forall e1_aPa x_aPb.
Compiler.Hoopl.Graph.Block n_aGr e1_aPa x_aPb
-> f_aGs -> Compiler.Hoopl.Dataflow.Fact x_aPb f_aGs
[LclId, Arity=1, Str=DmdType S]
block_s2bB =
\ (@ e1_a1g7)
(@ x_a1g8)
(ds1_d1Le :: Compiler.Hoopl.Graph.Block n_aGr e1_a1g7 x_a1g8) ->
case ds1_d1Le of _ {
Compiler.Hoopl.Graph.BlockCO rb1_d1QD rb2_d1QE n_aPo b_aPp ->
let {
a4_s2ri [Dmd=Just L]
:: f_aGs
-> Compiler.Hoopl.Dataflow.Fact
Compiler.Hoopl.Graph.O f_aGs
[LclId, Str=DmdType]
a4_s2ri =
block_s2bB
@ Compiler.Hoopl.Graph.O @ Compiler.Hoopl.Graph.O
b_aPp } in
let {
ft1_aPC [Dmd=Just L] :: f_aGs -> f_aGs
[LclId, Str=DmdType]
ft1_aPC = ww2_s2Dc n_aPo } in
(\ (f_aPE :: f_aGs) -> a4_s2ri (ft1_aPC f_aPE))
`cast` (<f_aGs>
-> Compiler.Hoopl.Dataflow.TFCo:R:FactOf
(Sym
(Compiler.Hoopl.Dataflow.TFCo:R:FactOf
<f_aGs>) ; Compiler.Hoopl.Dataflow.Fact
(Sym rb2_d1QE) <f_aGs>)
:: (f_aGs
-> Compiler.Hoopl.Dataflow.Fact
Compiler.Hoopl.Graph.O
(Compiler.Hoopl.Dataflow.R:FactOf f_aGs))
~#
(f_aGs
-> Compiler.Hoopl.Dataflow.R:FactOf
(Compiler.Hoopl.Dataflow.Fact x_a1g8
f_aGs)));
}}}
In order to eta-expand `block`, GHC would have to realise that `graph` is
always called with 2 arguments, which means that `block` is always called
with 2 arguments (even though it calls itself recursively with only one
argument).
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5809>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
