High performance unique timestamp id for multiple threads in Haskell

Question

I have multiple threads processing events. I want to assign a nanosecond timestamp to each event. It must be a unique id, though. So, in the odd case that two events arrive such that they would be assigned the same timestamp, I want one of them to be incremented by one nanosecond. Given that the real precision is not at the nanosecond level, that's ok as far as the time stamp nature of the system.

In one thread, this is a trivial problem. But across multiple threads, it gets more challenging. Performance is absolutely critical so the idea of naively synchronizing on a typical id generator type of thing seems like it would block far too much.

Is there some approach that solves this with minimal or no locking?

Answer 1

Why not separate the concerns of timestamping and unique ID generation? For example, there's the standard module Data.Unique, which provides a global supply of unique values in IO and should be fast enough for most purposes. Or, if you need something fancier, the concurrent-supply package offers a high-performance, concurrent unique ID supply with a pure interface.

That said, you could probably use the POSIX monotonic clock for this purpose, using e.g. the clock package:

import Control.Monad
import qualified System.Posix.Clock as Clock

main :: IO ()
main = replicateM_ 100 $ do
  time <- Clock.getTime Clock.Monotonic
  print (Clock.sec time, Clock.nsec time)

Answer 2

Could you use two pieces of information as the unique id? If so, give each thread a unique id and record for each event the nanosecond timestamp and the id of the thread that assigns the timestamp. Then the problem reduces to whatever you would have done in the single threaded case to guarantee the uniqueness of the timestamps. And with no synchronisation at all after initialisation.

Answer 3

You can use atomicModifyIORef to implement an atomic counter. With GHC, it's implemented using atomic operations, not locks.

import Data.IORef
import System.IO.Unsafe

counter :: IO Int
counter = unsafePerformIO $ newIORef 0

getUnique :: IO Int
getUnique = atomicModifyIORef counter $ \x -> let y = x + 1 in (y, y)