[GHC] #16283: StaticPointers pragma changes generated code even when the feature is not used

4 Feb 2019


      #16283: StaticPointers pragma changes generated code even when the feature is not
used
-------------------------------------+-------------------------------------
           Reporter:  osa1           |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Compiler       |           Version:
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 Tried with GHC HEAD. Program:

 {{{
 module Main where

 import Control.Concurrent
 import System.Mem

 nats :: [Int]
 nats = [0 .. ]

 main = do
   let z = nats !! 400
   print z
   performGC
   threadDelay 1000000
   print (nats !! 900)
 }}}

 Compile without any flags:

 {{{
 ==================== Tidy Core ====================
 2019-02-04 09:16:26.121849511 UTC

 Result size of Tidy Core
   = {terms: 45, types: 26, coercions: 0, joins: 0/0}

 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule1_r1zg :: GHC.Prim.Addr#
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule1_r1zg = "main"#

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule2_r1zt :: GHC.Types.TrName
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule2_r1zt = GHC.Types.TrNameS $trModule1_r1zg

 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule3_r1zu :: GHC.Prim.Addr#
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule3_r1zu = "Main"#

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule4_r1zv :: GHC.Types.TrName
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule4_r1zv = GHC.Types.TrNameS $trModule3_r1zu

 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 Main.$trModule :: GHC.Types.Module
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 Main.$trModule = GHC.Types.Module $trModule2_r1zt $trModule4_r1zv

 -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
 nats :: [Int]
 [GblId]
 nats = enumFrom @ Int GHC.Enum.$fEnumInt (GHC.Types.I# 0#)

 -- RHS size: {terms: 22, types: 13, coercions: 0, joins: 0/0}
 main :: IO ()
 [GblId]
 main
   = >>
       @ IO
       GHC.Base.$fMonadIO
       @ ()
       @ ()
       (print
          @ Int GHC.Show.$fShowInt (!! @ Int nats (GHC.Types.I# 400#)))
       (>>
          @ IO
          GHC.Base.$fMonadIO
          @ ()
          @ ()
          performGC
          (>>
             @ IO
             GHC.Base.$fMonadIO
             @ ()
             @ ()
             (threadDelay (GHC.Types.I# 1000000#))
             (print
                @ Int GHC.Show.$fShowInt (!! @ Int nats (GHC.Types.I#
 900#)))))

 -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
 :Main.main :: IO ()
 [GblId]
 :Main.main = GHC.TopHandler.runMainIO @ () main
 }}}

 Compile with `-XStaticPointers`:

 {{{

 ==================== Tidy Core ====================
 2019-02-04 09:16:35.678350955 UTC

 Result size of Tidy Core
   = {terms: 67, types: 42, coercions: 0, joins: 0/0}

 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule1_r1zg :: GHC.Prim.Addr#
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule1_r1zg = "main"#

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule2_r1zF :: GHC.Types.TrName
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule2_r1zF = GHC.Types.TrNameS $trModule1_r1zg

 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 $trModule3_r1zG :: GHC.Prim.Addr#
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule3_r1zG = "Main"#

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 $trModule4_r1zH :: GHC.Types.TrName
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 $trModule4_r1zH = GHC.Types.TrNameS $trModule3_r1zG

 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
 Main.$trModule :: GHC.Types.Module
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 Main.$trModule = GHC.Types.Module $trModule2_r1zF $trModule4_r1zH

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl_r1zI :: Int
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 lvl_r1zI = GHC.Types.I# 0#

 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 nats :: [Int]
 [GblId]
 nats = enumFrom @ Int GHC.Enum.$fEnumInt lvl_r1zI

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl1_r1zJ :: Int
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 lvl1_r1zJ = GHC.Types.I# 400#

 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 lvl2_r1zK :: Int
 [GblId]
 lvl2_r1zK = !! @ Int nats lvl1_r1zJ

 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 lvl3_r1zL :: IO ()
 [GblId]
 lvl3_r1zL = print @ Int GHC.Show.$fShowInt lvl2_r1zK

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl4_r1zM :: Int
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 lvl4_r1zM = GHC.Types.I# 1000000#

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl5_r1zN :: IO ()
 [GblId]
 lvl5_r1zN = threadDelay lvl4_r1zM

 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 lvl6_r1zO :: Int
 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 lvl6_r1zO = GHC.Types.I# 900#

 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 lvl7_r1zP :: Int
 [GblId]
 lvl7_r1zP = !! @ Int nats lvl6_r1zO

 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 lvl8_r1zQ :: IO ()
 [GblId]
 lvl8_r1zQ = print @ Int GHC.Show.$fShowInt lvl7_r1zP

 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 lvl9_r1zR :: IO ()
 [GblId]
 lvl9_r1zR
   = >> @ IO GHC.Base.$fMonadIO @ () @ () lvl5_r1zN lvl8_r1zQ

 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 lvl10_r1zS :: IO ()
 [GblId]
 lvl10_r1zS
   = >> @ IO GHC.Base.$fMonadIO @ () @ () performGC lvl9_r1zR

 -- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 main :: IO ()
 [GblId]
 main = >> @ IO GHC.Base.$fMonadIO @ () @ () lvl3_r1zL lvl10_r1zS

 -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
 :Main.main :: IO ()
 [GblId]
 :Main.main = GHC.TopHandler.runMainIO @ () main
 }}}

 Diff:

 {{{
 --- no_static_ptrs/GcStaticPointers.dump-simpl  2019-02-04
 12:16:26.120066655 +0300
 +++ static_ptrs/GcStaticPointers.dump-simpl     2019-02-04
 12:16:35.675924328 +0300
 @@ -1,9 +1,9 @@

  ==================== Tidy Core ====================
 -2019-02-04 09:16:26.121849511 UTC
 +2019-02-04 09:16:35.678350955 UTC

  Result size of Tidy Core
 -  = {terms: 45, types: 26, coercions: 0, joins: 0/0}
 +  = {terms: 67, types: 42, coercions: 0, joins: 0/0}

  -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
  $trModule1_r1zg :: GHC.Prim.Addr#
 @@ -11,55 +11,91 @@
  $trModule1_r1zg = "main"#

  -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 -$trModule2_r1zt :: GHC.Types.TrName
 +$trModule2_r1zF :: GHC.Types.TrName
  [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 -$trModule2_r1zt = GHC.Types.TrNameS $trModule1_r1zg
 +$trModule2_r1zF = GHC.Types.TrNameS $trModule1_r1zg

  -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 -$trModule3_r1zu :: GHC.Prim.Addr#
 +$trModule3_r1zG :: GHC.Prim.Addr#
  [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 -$trModule3_r1zu = "Main"#
 +$trModule3_r1zG = "Main"#

  -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 -$trModule4_r1zv :: GHC.Types.TrName
 +$trModule4_r1zH :: GHC.Types.TrName
  [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 -$trModule4_r1zv = GHC.Types.TrNameS $trModule3_r1zu
 +$trModule4_r1zH = GHC.Types.TrNameS $trModule3_r1zG

  -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
  Main.$trModule :: GHC.Types.Module
  [GblId, Caf=NoCafRefs, Unf=OtherCon []]
 -Main.$trModule = GHC.Types.Module $trModule2_r1zt $trModule4_r1zv
 +Main.$trModule = GHC.Types.Module $trModule2_r1zF $trModule4_r1zH

 --- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 +lvl_r1zI :: Int
 +[GblId, Caf=NoCafRefs, Unf=OtherCon []]
 +lvl_r1zI = GHC.Types.I# 0#
 +
 +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
  nats :: [Int]
  [GblId]
 -nats = enumFrom @ Int GHC.Enum.$fEnumInt (GHC.Types.I# 0#)
 +nats = enumFrom @ Int GHC.Enum.$fEnumInt lvl_r1zI
 +
 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 +lvl1_r1zJ :: Int
 +[GblId, Caf=NoCafRefs, Unf=OtherCon []]
 +lvl1_r1zJ = GHC.Types.I# 400#
 +
 +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 +lvl2_r1zK :: Int
 +[GblId]
 +lvl2_r1zK = !! @ Int nats lvl1_r1zJ
 +
 +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 +lvl3_r1zL :: IO ()
 +[GblId]
 +lvl3_r1zL = print @ Int GHC.Show.$fShowInt lvl2_r1zK
 +
 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 +lvl4_r1zM :: Int
 +[GblId, Caf=NoCafRefs, Unf=OtherCon []]
 +lvl4_r1zM = GHC.Types.I# 1000000#
 +
 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 +lvl5_r1zN :: IO ()
 +[GblId]
 +lvl5_r1zN = threadDelay lvl4_r1zM
 +
 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 +lvl6_r1zO :: Int
 +[GblId, Caf=NoCafRefs, Unf=OtherCon []]
 +lvl6_r1zO = GHC.Types.I# 900#
 +
 +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 +lvl7_r1zP :: Int
 +[GblId]
 +lvl7_r1zP = !! @ Int nats lvl6_r1zO
 +
 +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
 +lvl8_r1zQ :: IO ()
 +[GblId]
 +lvl8_r1zQ = print @ Int GHC.Show.$fShowInt lvl7_r1zP
 +
 +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 +lvl9_r1zR :: IO ()
 +[GblId]
 +lvl9_r1zR
 +  = >> @ IO GHC.Base.$fMonadIO @ () @ () lvl5_r1zN lvl8_r1zQ
 +
 +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
 +lvl10_r1zS :: IO ()
 +[GblId]
 +lvl10_r1zS
 +  = >> @ IO GHC.Base.$fMonadIO @ () @ () performGC lvl9_r1zR

 --- RHS size: {terms: 22, types: 13, coercions: 0, joins: 0/0}
 +-- RHS size: {terms: 4, types: 3, coercions: 0, joins: 0/0}
  main :: IO ()
  [GblId]
 -main
 -  = >>
 -      @ IO
 -      GHC.Base.$fMonadIO
 -      @ ()
 -      @ ()
 -      (print
 -         @ Int GHC.Show.$fShowInt (!! @ Int nats (GHC.Types.I# 400#)))
 -      (>>
 -         @ IO
 -         GHC.Base.$fMonadIO
 -         @ ()
 -         @ ()
 -         performGC
 -         (>>
 -            @ IO
 -            GHC.Base.$fMonadIO
 -            @ ()
 -            @ ()
 -            (threadDelay (GHC.Types.I# 1000000#))
 -            (print
 -               @ Int GHC.Show.$fShowInt (!! @ Int nats (GHC.Types.I#
 900#)))))
 +main = >> @ IO GHC.Base.$fMonadIO @ () @ () lvl3_r1zL lvl10_r1zS

  -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
  :Main.main :: IO ()
 }}}

-- 
Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/16283
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler