Re: [GHC] #7258: Compiling DynFlags is jolly slow

24 Oct 2017

      #7258: Compiling DynFlags is jolly slow
-------------------------------------+-------------------------------------
        Reporter:  simonpj           |                Owner:  simonpj
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  7.6.1
      Resolution:                    |             Keywords:  deriving-perf
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Compile-time      |  Unknown/Multiple
  performance bug                    |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by tdammers):

 Core for monadic-bind style Read instance:

 {{{
 [1 of 1] Compiling D                ( examples/t-10-read.hs,
 examples/t-10-read.o )

 ==================== Tidy Core ====================
 Result size of Tidy Core = {terms: 373, types: 324, coercions: 0}

 -- RHS size: {terms: 269, types: 160, coercions: 0}
 $creadPrec_r1Hl
 $creadPrec_r1Hl =
   parens
     (prec
        (I# 11#)
        (>>
           $fMonadReadPrec
           (expectP (Ident (unpackCString# "DT"#)))
           (>>
              $fMonadReadPrec
              (expectP (Punc (unpackCString# "{"#)))
              (>>
                 $fMonadReadPrec
                 (expectP (Ident (unpackCString# "field0"#)))
                 (>>
                    $fMonadReadPrec
                    (expectP (Punc (unpackCString# "="#)))
                    (>>=
                       $fMonadReadPrec
                       (reset (readPrec $fReadInt))
                       (\ a1_a1tq ->
                          >>
                            $fMonadReadPrec
                            (expectP (Punc (unpackCString# ","#)))
                            (>>
                               $fMonadReadPrec
                               (expectP (Ident (unpackCString# "field2"#)))
                               (>>
                                  $fMonadReadPrec
                                  (expectP (Punc (unpackCString# "="#)))
                                  (>>=
                                     $fMonadReadPrec
                                     (reset (readPrec $fReadInt))
                                     (\ a2_a1tr ->
                                        >>
                                          $fMonadReadPrec
                                          (expectP (Punc (unpackCString#
 ","#)))
                                          (>>
                                             $fMonadReadPrec
                                             (expectP (Ident
 (unpackCString# "field3"#)))
                                             (>>
                                                $fMonadReadPrec
                                                (expectP (Punc
 (unpackCString# "="#)))
                                                (>>=
                                                   $fMonadReadPrec
                                                   (reset (readPrec
 $fReadInt))
                                                   (\ a3_a1ts ->
                                                      >>
                                                        $fMonadReadPrec
                                                        (expectP (Punc
 (unpackCString# ","#)))
                                                        (>>
                                                           $fMonadReadPrec
                                                           (expectP
                                                              (Ident
 (unpackCString# "field4"#)))
                                                           (>>
 $fMonadReadPrec
                                                              (expectP
 (Punc (unpackCString# "="#)))
                                                              (>>=
 $fMonadReadPrec
                                                                 (reset
 (readPrec $fReadInt))
                                                                 (\ a4_a1tt
 ->
                                                                    >>
 $fMonadReadPrec
 (expectP
 (Punc
 (unpackCString# ","#)))
                                                                      (>>
 $fMonadReadPrec
 (expectP
 (Ident
 (unpackCString#
 "field5"#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 "="#)))
 (>>=
 $fMonadReadPrec
 (reset
 (readPrec
 $fReadInt))
 (\ a5_a1tu ->
...
...
$fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 ","#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Ident
 (unpackCString#
 "field6"#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 "="#)))
 (>>=
 $fMonadReadPrec
 (reset
 (readPrec
 $fReadInt))
 (\ a6_a1tv ->
...
$fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 ","#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Ident
 (unpackCString#
 "field7"#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 "="#)))
 (>>=
 $fMonadReadPrec
 (reset
 (readPrec
 $fReadInt))
 (\ a7_a1tw ->
...
$fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 ","#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Ident
 (unpackCString#
 "field8"#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 "="#)))
 (>>=
 $fMonadReadPrec
 (reset
 (readPrec
 $fReadInt))
 (\ a8_a1tx ->
...
$fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 ","#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Ident
 (unpackCString#
 "field9"#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 "="#)))
 (>>=
 $fMonadReadPrec
 (reset
 (readPrec
 $fReadInt))
 (\ a9_a1ty ->
...
$fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 ","#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Ident
 (unpackCString#
 "field10"#)))
 (>>
 $fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 "="#)))
 (>>=
 $fMonadReadPrec
 (reset
 (readPrec
 $fReadInt))
 (\ a10_a1tz ->
...
$fMonadReadPrec
 (expectP
 (Punc
 (unpackCString#
 "}"#)))
 (return
 $fMonadReadPrec
 (DT
 a1_a1tq
 a2_a1tr
 a3_a1ts
 a4_a1tt
 a5_a1tu
 a6_a1tv
 a7_a1tw
 a8_a1tx
 a9_a1ty
 a10_a1tz)))))))))))))))))))))))))))))))))))))))))))))
Rec {
 -- RHS size: {terms: 5, types: 1, coercions: 0}
 $fReadDT
 $fReadDT =
   C:Read
     $creadsPrec_r1I5
     $creadList_r1I6
     $creadPrec_r1Hl
     $creadListPrec_r1I7

 -- RHS size: {terms: 2, types: 1, coercions: 0}
 $creadsPrec_r1I5
 $creadsPrec_r1I5 = $dmreadsPrec $fReadDT

 -- RHS size: {terms: 2, types: 1, coercions: 0}
 $creadList_r1I6
 $creadList_r1I6 = readListDefault $fReadDT

 -- RHS size: {terms: 2, types: 1, coercions: 0}
 $creadListPrec_r1I7
 $creadListPrec_r1I7 = readListPrecDefault $fReadDT
 end Rec }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field9
 field9 =
   \ ds_d1H8 ->
     case ds_d1H8
     of _
     { DT ds1_d1H9 ds2_d1Ha ds3_d1Hb ds4_d1Hc ds5_d1Hd ds6_d1He ds7_d1Hf
          ds8_d1Hg ds9_d1Hh ds10_d1Hi ->
     ds9_d1Hh
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field8
 field8 =
   \ ds_d1GX ->
     case ds_d1GX
     of _
     { DT ds1_d1GY ds2_d1GZ ds3_d1H0 ds4_d1H1 ds5_d1H2 ds6_d1H3 ds7_d1H4
          ds8_d1H5 ds9_d1H6 ds10_d1H7 ->
     ds8_d1H5
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field7
 field7 =
   \ ds_d1GM ->
     case ds_d1GM
     of _
     { DT ds1_d1GN ds2_d1GO ds3_d1GP ds4_d1GQ ds5_d1GR ds6_d1GS ds7_d1GT
          ds8_d1GU ds9_d1GV ds10_d1GW ->
     ds7_d1GT
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field6
 field6 =
   \ ds_d1GB ->
     case ds_d1GB
     of _
     { DT ds1_d1GC ds2_d1GD ds3_d1GE ds4_d1GF ds5_d1GG ds6_d1GH ds7_d1GI
          ds8_d1GJ ds9_d1GK ds10_d1GL ->
     ds6_d1GH
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field5
 field5 =
   \ ds_d1Gq ->
     case ds_d1Gq
     of _
     { DT ds1_d1Gr ds2_d1Gs ds3_d1Gt ds4_d1Gu ds5_d1Gv ds6_d1Gw ds7_d1Gx
          ds8_d1Gy ds9_d1Gz ds10_d1GA ->
     ds5_d1Gv
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field4
 field4 =
   \ ds_d1Gf ->
     case ds_d1Gf
     of _
     { DT ds1_d1Gg ds2_d1Gh ds3_d1Gi ds4_d1Gj ds5_d1Gk ds6_d1Gl ds7_d1Gm
          ds8_d1Gn ds9_d1Go ds10_d1Gp ->
     ds4_d1Gj
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field3
 field3 =
   \ ds_d1G4 ->
     case ds_d1G4
     of _
     { DT ds1_d1G5 ds2_d1G6 ds3_d1G7 ds4_d1G8 ds5_d1G9 ds6_d1Ga ds7_d1Gb
          ds8_d1Gc ds9_d1Gd ds10_d1Ge ->
     ds3_d1G7
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field2
 field2 =
   \ ds_d1FT ->
     case ds_d1FT
     of _
     { DT ds1_d1FU ds2_d1FV ds3_d1FW ds4_d1FX ds5_d1FY ds6_d1FZ ds7_d1G0
          ds8_d1G1 ds9_d1G2 ds10_d1G3 ->
     ds2_d1FV
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field10
 field10 =
   \ ds_d1FI ->
     case ds_d1FI
     of _
     { DT ds1_d1FJ ds2_d1FK ds3_d1FL ds4_d1FM ds5_d1FN ds6_d1FO ds7_d1FP
          ds8_d1FQ ds9_d1FR ds10_d1FS ->
     ds10_d1FS
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field0
 field0 =
   \ ds_d1Fx ->
     case ds_d1Fx
     of _
     { DT ds1_d1Fy ds2_d1Fz ds3_d1FA ds4_d1FB ds5_d1FC ds6_d1FD ds7_d1FE
          ds8_d1FF ds9_d1FG ds10_d1FH ->
     ds1_d1Fy
     }

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $trModule1_r1I8
 $trModule1_r1I8 = TrNameS "main"#

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $trModule2_r1I9
 $trModule2_r1I9 = TrNameS "D"#

 -- RHS size: {terms: 3, types: 0, coercions: 0}
 $trModule
 $trModule = Module $trModule1_r1I8 $trModule2_r1I9

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $tc'DT1_r1Ia
 $tc'DT1_r1Ia = TrNameS "'DT"#

 -- RHS size: {terms: 5, types: 0, coercions: 0}
 $tc'DT
 $tc'DT =
   TyCon
     9521127001609462311## 17424978011088396301## $trModule $tc'DT1_r1Ia

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $tcDT1_r1Ib
 $tcDT1_r1Ib = TrNameS "DT"#

 -- RHS size: {terms: 5, types: 0, coercions: 0}
 $tcDT
 $tcDT =
   TyCon
     14693474152448962618## 5168028270650093369## $trModule $tcDT1_r1Ib
 }}}

 And for applicative-style Read implementation:
 {{{
 [1 of 1] Compiling D                ( examples/t-10-read-appl.hs,
 examples/t-10-read-appl.o )

 ==================== Tidy Core ====================
 Result size of Tidy Core = {terms: 272, types: 324, coercions: 0}

 -- RHS size: {terms: 168, types: 160, coercions: 0}
 $creadsPrec_r1Gi
 $creadsPrec_r1Gi =
   \ p_aNu ->
     readP_to_S
       (<*
          $fApplicativeReadP
          (*>
             $fApplicativeReadP
             (string (unpackCString# "DT{"#))
             (<*>
                $fApplicativeReadP
                (<*>
                   $fApplicativeReadP
                   (<*>
                      $fApplicativeReadP
                      (<*>
                         $fApplicativeReadP
                         (<*>
                            $fApplicativeReadP
                            (<*>
                               $fApplicativeReadP
                               (<*>
                                  $fApplicativeReadP
                                  (<*>
                                     $fApplicativeReadP
                                     (<*>
                                        $fApplicativeReadP
                                        (<$>
                                           $fFunctorReadP
                                           DT
                                           (*>
                                              $fApplicativeReadP
                                              (string (unpackCString#
 "field0="#))
                                              (readS_to_P (readsPrec
 $fReadInt p_aNu))))
                                        (*>
                                           $fApplicativeReadP
                                           (string (unpackCString# ","#))
                                           (*>
                                              $fApplicativeReadP
                                              (string (unpackCString#
 "field1="#))
                                              (readS_to_P (readsPrec
 $fReadInt p_aNu)))))
                                     (*>
                                        $fApplicativeReadP
                                        (string (unpackCString# ","#))
                                        (*>
                                           $fApplicativeReadP
                                           (string (unpackCString#
 "field2="#))
                                           (readS_to_P (readsPrec $fReadInt
 p_aNu)))))
                                  (*>
                                     $fApplicativeReadP
                                     (string (unpackCString# ","#))
                                     (*>
                                        $fApplicativeReadP
                                        (string (unpackCString#
 "field3="#))
                                        (readS_to_P (readsPrec $fReadInt
 p_aNu)))))
                               (*>
                                  $fApplicativeReadP
                                  (string (unpackCString# ","#))
                                  (*>
                                     $fApplicativeReadP
                                     (string (unpackCString# "field4="#))
                                     (readS_to_P (readsPrec $fReadInt
 p_aNu)))))
                            (*>
                               $fApplicativeReadP
                               (string (unpackCString# ","#))
                               (*>
                                  $fApplicativeReadP
                                  (string (unpackCString# "field5="#))
                                  (readS_to_P (readsPrec $fReadInt
 p_aNu)))))
                         (*>
                            $fApplicativeReadP
                            (string (unpackCString# ","#))
                            (*>
                               $fApplicativeReadP
                               (string (unpackCString# "field6="#))
                               (readS_to_P (readsPrec $fReadInt p_aNu)))))
                      (*>
                         $fApplicativeReadP
                         (string (unpackCString# ","#))
                         (*>
                            $fApplicativeReadP
                            (string (unpackCString# "field7="#))
                            (readS_to_P (readsPrec $fReadInt p_aNu)))))
                   (*>
                      $fApplicativeReadP
                      (string (unpackCString# ","#))
                      (*>
                         $fApplicativeReadP
                         (string (unpackCString# "field8="#))
                         (readS_to_P (readsPrec $fReadInt p_aNu)))))
                (*>
                   $fApplicativeReadP
                   (string (unpackCString# ","#))
                   (*>
                      $fApplicativeReadP
                      (string (unpackCString# "field9="#))
                      (readS_to_P (readsPrec $fReadInt p_aNu))))))
          (string (unpackCString# "}"#)))

 Rec {
 -- RHS size: {terms: 5, types: 1, coercions: 0}
 $fReadDT
 $fReadDT =
   C:Read
     $creadsPrec_r1Gi
     $creadList_r1GT
     $creadPrec_r1GU
     $creadListPrec_r1GV

 -- RHS size: {terms: 2, types: 1, coercions: 0}
 $creadList_r1GT
 $creadList_r1GT = $dmreadList $fReadDT

 -- RHS size: {terms: 2, types: 1, coercions: 0}
 $creadPrec_r1GU
 $creadPrec_r1GU = $dmreadPrec $fReadDT

 -- RHS size: {terms: 2, types: 1, coercions: 0}
 $creadListPrec_r1GV
 $creadListPrec_r1GV = $dmreadListPrec $fReadDT
 end Rec }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field9
 field9 =
   \ ds_d1G5 ->
     case ds_d1G5
     of _
     { DT ds1_d1G6 ds2_d1G7 ds3_d1G8 ds4_d1G9 ds5_d1Ga ds6_d1Gb ds7_d1Gc
          ds8_d1Gd ds9_d1Ge ds10_d1Gf ->
     ds9_d1Ge
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field8
 field8 =
   \ ds_d1FU ->
     case ds_d1FU
     of _
     { DT ds1_d1FV ds2_d1FW ds3_d1FX ds4_d1FY ds5_d1FZ ds6_d1G0 ds7_d1G1
          ds8_d1G2 ds9_d1G3 ds10_d1G4 ->
     ds8_d1G2
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field7
 field7 =
   \ ds_d1FJ ->
     case ds_d1FJ
     of _
     { DT ds1_d1FK ds2_d1FL ds3_d1FM ds4_d1FN ds5_d1FO ds6_d1FP ds7_d1FQ
          ds8_d1FR ds9_d1FS ds10_d1FT ->
     ds7_d1FQ
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field6
 field6 =
   \ ds_d1Fy ->
     case ds_d1Fy
     of _
     { DT ds1_d1Fz ds2_d1FA ds3_d1FB ds4_d1FC ds5_d1FD ds6_d1FE ds7_d1FF
          ds8_d1FG ds9_d1FH ds10_d1FI ->
     ds6_d1FE
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field5
 field5 =
   \ ds_d1Fn ->
     case ds_d1Fn
     of _
     { DT ds1_d1Fo ds2_d1Fp ds3_d1Fq ds4_d1Fr ds5_d1Fs ds6_d1Ft ds7_d1Fu
          ds8_d1Fv ds9_d1Fw ds10_d1Fx ->
     ds5_d1Fs
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field4
 field4 =
   \ ds_d1Fc ->
     case ds_d1Fc
     of _
     { DT ds1_d1Fd ds2_d1Fe ds3_d1Ff ds4_d1Fg ds5_d1Fh ds6_d1Fi ds7_d1Fj
          ds8_d1Fk ds9_d1Fl ds10_d1Fm ->
     ds4_d1Fg
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field3
 field3 =
   \ ds_d1F1 ->
     case ds_d1F1
     of _
     { DT ds1_d1F2 ds2_d1F3 ds3_d1F4 ds4_d1F5 ds5_d1F6 ds6_d1F7 ds7_d1F8
          ds8_d1F9 ds9_d1Fa ds10_d1Fb ->
     ds3_d1F4
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field2
 field2 =
   \ ds_d1EQ ->
     case ds_d1EQ
     of _
     { DT ds1_d1ER ds2_d1ES ds3_d1ET ds4_d1EU ds5_d1EV ds6_d1EW ds7_d1EX
          ds8_d1EY ds9_d1EZ ds10_d1F0 ->
     ds2_d1ES
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field10
 field10 =
   \ ds_d1EF ->
     case ds_d1EF
     of _
     { DT ds1_d1EG ds2_d1EH ds3_d1EI ds4_d1EJ ds5_d1EK ds6_d1EL ds7_d1EM
          ds8_d1EN ds9_d1EO ds10_d1EP ->
     ds10_d1EP
     }

 -- RHS size: {terms: 5, types: 12, coercions: 0}
 field0
 field0 =
   \ ds_d1Eu ->
     case ds_d1Eu
     of _
     { DT ds1_d1Ev ds2_d1Ew ds3_d1Ex ds4_d1Ey ds5_d1Ez ds6_d1EA ds7_d1EB
          ds8_d1EC ds9_d1ED ds10_d1EE ->
     ds1_d1Ev
     }

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $trModule1_r1GW
 $trModule1_r1GW = TrNameS "main"#

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $trModule2_r1GX
 $trModule2_r1GX = TrNameS "D"#

 -- RHS size: {terms: 3, types: 0, coercions: 0}
 $trModule
 $trModule = Module $trModule1_r1GW $trModule2_r1GX

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $tc'DT1_r1GY
 $tc'DT1_r1GY = TrNameS "'DT"#

 -- RHS size: {terms: 5, types: 0, coercions: 0}
 $tc'DT
 $tc'DT =
   TyCon
     9521127001609462311## 17424978011088396301## $trModule $tc'DT1_r1GY

 -- RHS size: {terms: 2, types: 0, coercions: 0}
 $tcDT1_r1GZ
 $tcDT1_r1GZ = TrNameS "DT"#

 -- RHS size: {terms: 5, types: 0, coercions: 0}
 $tcDT
 $tcDT =
   TyCon
     14693474152448962618## 5168028270650093369## $trModule $tcDT1_r1GZ
 }}}

-- 
Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/7258#comment:45
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler