Skip to content

StaticPointers pragma changes generated code even when the feature is not used

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 ()
Trac metadata
Trac field Value
Version
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information