{-# LANGUAGE CPP         #-}

-- |
-- 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 :: IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORefCAS IORef a
ref a -> (a, b)
fn = do
    Ticket a
tkt <- IORef a -> IO (Ticket a)
forall a. IORef a -> IO (Ticket a)
A.readForCAS IORef a
ref
    Ticket a -> Int -> IO b
forall t. (Eq t, Num t) => Ticket a -> t -> IO b
loop Ticket a
tkt Int
retries

    where

    retries :: Int
retries = Int
25 :: Int
    loop :: Ticket a -> t -> IO b
loop Ticket a
_   t
0     = IORef a -> (a -> (a, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
ref a -> (a, b)
fn
    loop Ticket a
old t
tries = do
        let (a
new, b
result) = a -> (a, b)
fn (a -> (a, b)) -> a -> (a, b)
forall a b. (a -> b) -> a -> b
$ Ticket a -> a
forall a. Ticket a -> a
A.peekTicket Ticket a
old
        (Bool
success, Ticket a
tkt) <- IORef a -> Ticket a -> a -> IO (Bool, Ticket a)
forall a. IORef a -> Ticket a -> a -> IO (Bool, Ticket a)
A.casIORef IORef a
ref Ticket a
old a
new
        if Bool
success
        then b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
result
        else Ticket a -> t -> IO b
loop Ticket a
tkt (t
tries t -> t -> t
forall a. Num a => a -> a -> a
- t
1)

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

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

{-# INLINE storeLoadBarrier #-}
storeLoadBarrier :: IO ()
storeLoadBarrier :: IO ()
storeLoadBarrier = IO ()
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