[GHC] #16283: StaticPointers pragma changes generated code even when the feature is not used
GHC
ghc-devs at haskell.org
Mon Feb 4 09:22:51 UTC 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
More information about the ghc-tickets
mailing list