Arity analysis could be better
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).
Trac metadata
Trac field | Value |
---|---|
Version | 7.5 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |