{-# LANGUAGE CPP #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Trustworthy #-}

-- | An abstract interface to a concurrent unique symbol generator.
--
-- Unlike @Data.Unique@ from @base@ the values are not a member of 'Ord'. However, there is no global bottleneck.
module Control.Concurrent.Unique
  ( Unique, newUnique
  ) where

import Data.Hashable (Hashable (..))
import GHC.IO
import GHC.Exts

-- $setup
-- >>> import Data.Hashable

-- | Unique identifiers are created by creating heap objects in kind # that
-- can be compared for value equality and then hashing them using their initial allocation
-- address.
--
-- >>> x <- newUnique
-- >>> y <- newUnique
-- >>> z <- newUnique
--
-- >>> [x == x, y == y, z == z]
-- [True,True,True]
--
-- >>> [x == y, y == z, z == x]
-- [False,False,False]
--
-- The hashes could be same, in theory, but in practice they are different
-- as well.
--
-- >>> [ hash x == hash x, hash y == hash y, hash z == hash z]
-- [True,True,True]
--
-- >>> [ hash x == hash y, hash y == hash z, hash z == hash x]
-- [False,False,False]

-- TODO: If, due to a small heap size we find we have high collision rate on initial allocation location
-- we might consider upgrading this initial hash with something fast and volatile, e.g. rdtsc
data Unique = Unique !Int (MutableByteArray# RealWorld)

instance Eq Unique where
#if MIN_VERSION_base(4,7,0)
  Unique Int
_ MutableByteArray# RealWorld
p == :: Unique -> Unique -> Bool
== Unique Int
_ MutableByteArray# RealWorld
q = Int# -> Bool
isTrue# (MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> Int#
forall d. MutableByteArray# d -> MutableByteArray# d -> Int#
sameMutableByteArray# MutableByteArray# RealWorld
p MutableByteArray# RealWorld
q)
#else
  Unique _ p == Unique _ q = sameMutableByteArray# p q
#endif

instance Hashable Unique where
  hash :: Unique -> Int
hash (Unique Int
i MutableByteArray# RealWorld
_) = Int
i
  hashWithSalt :: Int -> Unique -> Int
hashWithSalt Int
d (Unique Int
i MutableByteArray# RealWorld
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
d Int
i

-- | Allocate a new 'Unique' value. The value returned will not compare equal to any other value of type 'Unique' returned by previous calls to 'newUnique'. There is no limit on the number of times 'newUnique' may be called.
newUnique :: IO Unique
newUnique :: IO Unique
newUnique = (State# RealWorld -> (# State# RealWorld, Unique #)) -> IO Unique
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Unique #)) -> IO Unique)
-> (State# RealWorld -> (# State# RealWorld, Unique #))
-> IO Unique
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
0# State# RealWorld
s of
  (# State# RealWorld
s', MutableByteArray# RealWorld
ba #) -> (# State# RealWorld
s', Int -> MutableByteArray# RealWorld -> Unique
Unique (Int# -> Int
I# (Addr# -> Int#
addr2Int# (MutableByteArray# RealWorld -> Addr#
unsafeCoerce# MutableByteArray# RealWorld
ba))) MutableByteArray# RealWorld
ba #)