{-# LANGUAGE MagicHash, UnboxedTuples #-}
-- Test the primops in GHC 7.8.1 directly.

module Main where

import GHC.Prim
import GHC.IORef
import GHC.STRef
import GHC.ST
import GHC.IO

{-# NOINLINE str #-}
str :: String
str = "hello"

t :: MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
t = casMutVar#

(===) :: Int# -> Int# -> Bool
(===) x y = case x ==# y of { 0# -> False; _ -> True }

----------------------------------------

-- | Performs a machine-level compare and swap operation on an
-- 'STRef'. Returns a tuple containing a 'Bool' which is 'True' when a
-- swap is performed, along with the 'current' value from the 'STRef'.
-- 
-- Note \"compare\" here means pointer equality in the sense of
-- 'GHC.Prim.reallyUnsafePtrEquality#'.
casSTRef :: STRef s a -- ^ The 'STRef' containing a value 'current'
         -> a -- ^ The 'old' value to compare
         -> a -- ^ The 'new' value to replace 'current' if @old == current@
         -> ST s (Bool, a) 
casSTRef (STRef var#) old new = ST $ \s1# ->
   -- The primop treats the boolean as a sort of error code.
   -- Zero means the CAS worked, one that it didn't.
   -- We flip that here:
    case casMutVar# var# old new s1# of
      (# s2#, x#, res #) -> (# s2#, (x# === 0#, res) #)

-- | Performs a machine-level compare and swap operation on an
-- 'IORef'. Returns a tuple containing a 'Bool' which is 'True' when a
-- swap is performed, along with the 'current' value from the 'IORef'.
-- 
-- Note \"compare\" here means pointer equality in the sense of
-- 'GHC.Prim.reallyUnsafePtrEquality#'.
casIORef :: IORef a -- ^ The 'IORef' containing a value 'current'
         -> a -- ^ The 'old' value to compare
         -> a -- ^ The 'new' value to replace 'current' if @old == current@
         -> IO (Bool, a) 
casIORef (IORef var) old new = stToIO (casSTRef var old new)

--------------------------------------------------------------------------------

main :: IO ()
main = do 
  r <- newIORef str
  pr <- casIORef r str "new str"
  print pr