    {-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, NoImplicitPrelude #-}
    module System.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 #-}