module Control.Concurrent.STM.Counter (Counter, getCounter, mkCounter, incr, get, getAndIncr) where

import Data.IORef

import System.IO.Unsafe

type Counter = IORef Int
{-# NOINLINE getCounter #-} 
getCounter :: Counter
getCounter = unsafePerformIO (newIORef 0) --(newMVar [0..])

getLocalCounter :: Counter
getLocalCounter = unsafePerformIO (newIORef 0) 

mkCounter :: Int -> IO Counter
mkCounter i = newIORef i
                 
get :: Counter -> IO Int
get c = readIORef c

incr :: Counter -> IO ()
incr c = atomicModifyIORef c (\a -> (a+1,()))

getAndIncr :: Counter -> IO Int
getAndIncr c = do old <- atomicModifyIORef c (\a -> (a+1,a))
                  return old

getAndIncrWithoutSync :: Counter -> IO Int
getAndIncrWithoutSync c = do old <- get c 
                             writeIORef c (old+1)
                             return old