Atomics.hs

-- |
-- Module      : Streamly.Internal.Data.Atomics
-- Copyright   : (c) 2018-2019 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

module Streamly.Internal.Data.Atomics
    (
      atomicModifyIORefCAS
    , atomicModifyIORefCAS_
    , writeBarrier
    , storeLoadBarrier
    )
where

import Data.IORef (IORef, atomicModifyIORef)
#ifdef ghcjs_HOST_OS
import Data.IORef (modifyIORef)
#else
import qualified Data.Atomics as A
#endif

#ifndef ghcjs_HOST_OS

-- XXX Does it make sense to have replacements for atomicModifyIORef etc. on a
-- single threaded system.
--
-- Slightly faster version of CAS. Gained some improvement by avoiding the use
-- of "evaluate" because we know we do not have exceptions in fn.
{-# INLINE atomicModifyIORefCAS #-}
atomicModifyIORefCAS :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORefCAS ref fn = do
    tkt <- A.readForCAS ref
    loop tkt retries

    where

    retries = 25 :: Int
    loop _   0     = atomicModifyIORef ref fn
    loop old tries = do
        let (new, result) = fn $ A.peekTicket old
        (success, tkt) <- A.casIORef ref old new
        if success
        then return result
        else loop tkt (tries - 1)

{-# INLINE atomicModifyIORefCAS_ #-}
atomicModifyIORefCAS_ :: IORef t -> (t -> t) -> IO ()
atomicModifyIORefCAS_ = A.atomicModifyIORefCAS_

{-# INLINE writeBarrier #-}
writeBarrier :: IO ()
writeBarrier = A.writeBarrier

{-# INLINE storeLoadBarrier #-}
storeLoadBarrier :: IO ()
storeLoadBarrier = A.storeLoadBarrier

#else

{-# INLINE atomicModifyIORefCAS #-}
atomicModifyIORefCAS :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORefCAS = atomicModifyIORef

{-# INLINE atomicModifyIORefCAS_ #-}
atomicModifyIORefCAS_ :: IORef a -> (a -> a) -> IO ()
atomicModifyIORefCAS_ = modifyIORef

{-# INLINE writeBarrier #-}
writeBarrier :: IO ()
writeBarrier = return ()

{-# INLINE storeLoadBarrier #-}
storeLoadBarrier :: IO ()
storeLoadBarrier = return ()

#endif