Opened 8 years ago

Closed 6 years ago

#5809 closed bug (fixed)

Arity analysis could be better

Reported by: simonmar Owned by: simonpj
Priority: normal Milestone: 7.6.2
Component: Compiler Version: 7.5
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: Runtime performance bug Test Case:
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:


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...
   :: 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
    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"
       body  :: [Label] -> Fact C f -> Fact C f
       body entries f
         = fixpoint_anal Fwd lattice do_block entries blockmap f
           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 =
                    @ 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
                                 <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))
                          -> 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).

Change History (2)

comment:1 Changed 7 years ago by igloo


comment:2 Changed 6 years ago by nomeata

Resolution: fixed
Status: newclosed

Judging from the code, the new callartiy analysis should do exactly that (see that block is called with two arguments). Unfortunately, there is no small example here to verify this; but I’m optimistic. If you find that it does not work with today’s HEAD, I’d like to hear about it.

Note: See TracTickets for help on using tickets.