blob: 643251995e5c2a9c74f5f8dfa978b7a71151cb1f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, NoImplicitPrelude #-}
module GHC.Event.Unique
(
UniqueSource
, Unique(..)
, newSource
, newUnique
) where
import Data.Int (Int64)
import GHC.Base
import GHC.Conc.Sync (TVar, atomically, newTVarIO, readTVar, writeTVar)
import GHC.Num (Num(..))
import GHC.Show (Show(..))
-- We used to use IORefs here, but Simon switched us to STM when we
-- found that our use of atomicModifyIORef was subject to a severe RTS
-- performance problem when used in a tight loop from multiple
-- threads: http://hackage.haskell.org/trac/ghc/ticket/3838
--
-- There seems to be no performance cost to using a TVar instead.
newtype UniqueSource = US (TVar Int64)
newtype Unique = Unique { asInt64 :: Int64 }
deriving (Eq, Ord, Num)
instance Show Unique where
show = show . asInt64
newSource :: IO UniqueSource
newSource = US `fmap` newTVarIO 0
newUnique :: UniqueSource -> IO Unique
newUnique (US ref) = atomically $ do
u <- readTVar ref
let !u' = u+1
writeTVar ref u'
return $ Unique u'
{-# INLINE newUnique #-}
|
