#4081: Strict constructor fields inspected in loop
---------------------------------+------------------------------------------
    Reporter:  rl                |        Owner:  benl                   
        Type:  bug               |       Status:  new                    
    Priority:  normal            |    Milestone:  7.2.1                  
   Component:  Compiler          |      Version:  6.13                   
    Keywords:                    |     Testcase:                         
   Blockedby:                    |   Difficulty:                         
          Os:  Unknown/Multiple  |     Blocking:                         
Architecture:  Unknown/Multiple  |      Failure:  Runtime performance bug
---------------------------------+------------------------------------------
Changes (by simonpj):

  * owner:  => benl


Comment:

 Right this is done, I think.  Give it a try.  '''Ben or Roman''' do you
 think you might think of a way to test this?  I can think of two possible
 ways:
  * Find a case where there is a big runtime difference, and measure that.
 But that is fragile to which system you are running on.
  * Dump the Core and grep for something or other.  Perhaps in your example
 all the primops should be together, rather than separated by unboxing?
 I'd just like a test that'll trip if this optimisation stops happening.
 Thanks.

 Two main patches:
 {{{
 commit 9cb20b488d4986c122b0461a54bc5c970f9d8502
 Author: Simon Peyton Jones <[email protected]>
 Date:   Mon Jun 27 08:54:29 2011 +0100

     Add case-floating to the float-out pass

     There are two things in this patch. First, a new feature.
     Given     (case x of I# y -> ...)
     where 'x' is known to be evaluated, the float-out pass
     will float the case outwards towards x's binding.  Of
     course this doesn't happen if 'x' is evaluated because
     of an enclosing case (becuase then the inner case would
     be eliminated) but it *does* happen when x is bound by
     a constructor with a strict field.  This happens in DPH.
     Trac #4081.

     The second change is a significant refactoring of the
     way the let-floater works.  Now SetLevels makes a decision
     about whether the let (or case) will move, and records
     that decision in the FloatSpec flag.  This change makes
     the whole caboodle much easier to think about.

  compiler/simplCore/FloatOut.lhs  |  297
 +++++++++++++++++++++----------------
  compiler/simplCore/SetLevels.lhs |  302
 ++++++++++++++++++++++----------------
  2 files changed, 343 insertions(+), 256 deletions(-)
 }}}
 and a follow-up
 {{{
 commit a347cd7c384eb255b5507a40840205d052f137c6
 Author: Simon Peyton Jones <[email protected]>
 Date:   Thu Jun 30 14:48:16 2011 +0100

     A second bite at the case-floating patch

     When floating a case outwards we must be careful to clone
     the binders, since their scope is widening.

     Plus lots of tidying up.

  compiler/coreSyn/CoreSubst.lhs   |   20 +++++++-
  compiler/simplCore/SetLevels.lhs |   94
 ++++++++++++++++++++++---------------
  compiler/types/Type.lhs          |   13 ++++-
  3 files changed, 85 insertions(+), 42 deletions(-)
 }}}
 This work tickled a scoping bug in CSE, which I fixed too
 {{{
 commit 3acc4683f128641a93d53a0d4e9d50e10e5e4ff0
 Author: Simon Peyton Jones <[email protected]>
 Date:   Thu Jun 30 14:40:25 2011 +0100

     Fix CSE to do substitution properly

     It was inconsistent before, now it's right

  compiler/simplCore/CSE.lhs |  130
 +++++++++++++++++++++++---------------------
  1 files changed, 68 insertions(+), 62 deletions(-)
 }}}
 Now the code you get for `$wfoo` in the "example that Ben was looking at"
 looks better
 {{{
 T4081.$wfoo =
   \ (w_sr0 :: T4081.Thing) (ww_sr3 :: GHC.Prim.Int#) ->
     case w_sr0 of _ {
       T4081.Manifest i_ab6 ->
         case i_ab6 of _ { GHC.Types.I# x_sri ->            -- <---- Int
 unboxed here!
         letrec {
           $wgo_sra [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int#
           [LclId, Arity=1, Str=DmdType L]
           $wgo_sra =
             \ (ww1_sqS :: GHC.Prim.Int#) ->
               case ww1_sqS of ds_Xpg {
                 __DEFAULT ->
                   letrec {
                     $wloopInner_srb [Occ=LoopBreaker] :: GHC.Prim.Int# ->
 GHC.Prim.Int#
                     [LclId, Arity=1, Str=DmdType L]
                     $wloopInner_srb =
                       \ (ww2_sqA :: GHC.Prim.Int#) ->
                         case ww2_sqA of ds1_XoZ {
                           __DEFAULT ->
                             case $wloopInner_srb (GHC.Prim.-# ds1_XoZ 1)
                             of ww3_sqE { __DEFAULT ->
                             GHC.Prim.+#
                               (GHC.Prim.+# (GHC.Prim.+# x_sri ds1_XoZ)
 ds_Xpg) ww3_sqE
                             };
                           0 -> 0
                         }; } in
                   letrec {
                     $wloopOuter_src [Occ=LoopBreaker] :: GHC.Prim.Int# ->
 GHC.Prim.Int#
                     [LclId, Arity=1, Str=DmdType L]
                     $wloopOuter_src =
                       \ (ww2_sqJ :: GHC.Prim.Int#) ->
                         case ww2_sqJ of wild2_Xj {
                           __DEFAULT ->
                             case $wloopInner_srb ww_sr3 of ww3_sqE {
 __DEFAULT ->
                             case $wloopOuter_src (GHC.Prim.-# wild2_Xj 1)
                             of ww4_sqN { __DEFAULT ->
                             GHC.Prim.+# ww3_sqE ww4_sqN
                             }
                             };
                           0 -> 0
                         }; } in
                   case $wloopOuter_src ww_sr3 of ww2_sqN { __DEFAULT ->
                   case $wgo_sra (GHC.Prim.-# ds_Xpg 1) of ww3_sqW {
 __DEFAULT ->
                   GHC.Prim.+# ww2_sqN ww3_sqW
                   }
                   };
                 0 -> 0
               }; } in
         $wgo_sra ww_sr3
         };
       T4081.None ->
         T4081.foo1
         `cast` (UnsafeCo GHC.Types.Int GHC.Prim.Int#
                 :: GHC.Types.Int ~ GHC.Prim.Int#)
     }
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/4081#comment:13>
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

Reply via email to