global-io-ref.md

Copied from @hysl20's comment at ghc-proposals/ghc-proposals#766 (comment), saved as a Gist for reference (since GitHub PR comment links don't always navigate directly to the comment, e.g. if it's hidden)

---

I think there is a lightweight alternative that isn't in the wiki and that doesn't require changing the language:

• use an OPAQUE helper function to hide unsafePerformIO
• require Typeable a: no risk of having a top-level forall a. IORef [a] and segfaults
• use HasCallStack to guarantee that each call is unique: avoid CSE of global variables

{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module TopLevel where

import Data.Typeable
import GHC.Stack
import Data.IORef
import System.IO.Unsafe
-- for globalByteArray
import GHC.Exts  
import GHC.Base
import Data.Array.Byte

-- | Create a global variable.
--
-- OPAQUE and HasCallStack constraint are here to guarantee that CSE doesn't
-- occur. Typeable avoids foralls in globals.
--
-- WARNING: don't wrap this function into another without HasCallStack!
{-# OPAQUE globalIO #-}
globalIO :: (Typeable a, HasCallStack) => IO a -> a
globalIO act = unsafePerformIO (?callStack `seq` act)
-- seq: make sure callStack is not detected absent (OPAQUE isn't really OPAQUE...)

globalRef :: (Typeable a, HasCallStack) => a -> IORef a
globalRef a = withFrozenCallStack (globalIO (newIORef a))

globalByteArray :: HasCallStack => Int -> MutableByteArray RealWorld
globalByteArray (I# n) = withFrozenCallStack (globalIO mk)
  where
    mk = IO (\s -> case newByteArray# n s of
                    (# s1, ba #) -> (# s1, MutableByteArray ba #) )

Usage example:

module Main where

import TopLevel
import Data.IORef

foo = globalRef (10 :: Int)
bar = globalRef (10 :: Int)
-- baz = globalRef ([] :: [a]) -- not definable : No instance for ‘Typeable a0’ arising from a use of ‘globalRef’
arr1 = globalByteArray 10
arr2 = globalByteArray 10 

main = do
  print =<< readIORef foo
  writeIORef foo 42
  print =<< readIORef foo

  print =<< readIORef bar
  writeIORef bar 0
  print =<< readIORef bar       

❯ ./Test
10
42
10 -- no CSE happened between foo and bar
0

If we look at Core, we see that even if the entry code is shared, global variables aren't thanks to the callstack (IP):

arr1
  = globalIO
      (C:Typeable globalByteArray1)
      (C:IP arr5)
      (arr4 `cast` <Co:4> :: ...)

arr2
  = globalIO
      (C:Typeable globalByteArray1)
      (C:IP arr14)
      (arr4 `cast` <Co:4> :: ...)