{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Vector.Storable.Mutable.CAS where

import Control.Monad
import Foreign.Storable
import Data.Vector.Storable.Mutable
import GHC.Exts
import GHC.Float
import GHC.ForeignPtr
import GHC.IO


-- | Returns whether the CAS succeeded, as well as the /old/ value in the array.
--
-- This function only works on platforms where 'Double#' and 'Word#' are the same size.
casIOVectorDouble :: IOVector Double -> Int -> Double -> Double -> IO (Bool, Double)
casIOVectorDouble :: IOVector Double -> Int -> Double -> Double -> IO (Bool, Double)
casIOVectorDouble (MVector Int
_ (ForeignPtr Addr#
addr ForeignPtrContents
_)) Int
idx (D# Double#
check) (D# Double#
repl) = do
  let size :: Int
size = Word -> Int
forall a. Storable a => a -> Int
sizeOf (Word
forall a. HasCallStack => a
undefined :: Word)

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double -> Int
forall a. Storable a => a -> Int
sizeOf (Double
forall a. HasCallStack => a
undefined :: Double) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"casIOVectorDouble: Double is not word-sized (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            Int -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Int
forall a. Storable a => a -> Int
sizeOf (Double
forall a. HasCallStack => a
undefined :: Double)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" /= " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

  let checkword :: Word#
checkword = Word64# -> Word#
word64ToWord# (Double# -> Word64#
stgDoubleToWord64 Double#
check)
      replword :: Word#
replword = Word64# -> Word#
word64ToWord# (Double# -> Word64#
stgDoubleToWord64 Double#
repl)
      !(I# Int#
byteoff) = Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size
  (State# RealWorld -> (# State# RealWorld, (Bool, Double) #))
-> IO (Bool, Double)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, (Bool, Double) #))
 -> IO (Bool, Double))
-> (State# RealWorld -> (# State# RealWorld, (Bool, Double) #))
-> IO (Bool, Double)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case Addr#
-> Word#
-> Word#
-> State# RealWorld
-> (# State# RealWorld, Word# #)
forall d.
Addr# -> Word# -> Word# -> State# d -> (# State# d, Word# #)
atomicCasWordAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr Int#
byteoff) Word#
checkword Word#
replword State# RealWorld
s of
               (# State# RealWorld
s', Word#
oldword #) ->
                 (# State# RealWorld
s', (Word# -> Word
W# Word#
oldword Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word# -> Word
W# Word#
checkword
                        ,Double# -> Double
D# (Word64# -> Double#
stgWord64ToDouble (Word# -> Word64#
wordToWord64# Word#
oldword))) #)