GHC/Event/Unique.hs

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