{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Internal.Data.IOURef
-- Copyright   :  (c) Masahiro Sakai 2014
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- Simple unboxed IORef-like type based on IOUArray
--
-----------------------------------------------------------------------------
module ToySolver.Internal.Data.IOURef
  ( IOURef
  , newIOURef
  , readIOURef
  , writeIOURef
  , modifyIOURef
  ) where

import Data.Array.Base
import Data.Array.IO

newtype IOURef a = IOURef (IOUArray Int a) deriving (IOURef a -> IOURef a -> Bool
(IOURef a -> IOURef a -> Bool)
-> (IOURef a -> IOURef a -> Bool) -> Eq (IOURef a)
forall a. IOURef a -> IOURef a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IOURef a -> IOURef a -> Bool
$c/= :: forall a. IOURef a -> IOURef a -> Bool
== :: IOURef a -> IOURef a -> Bool
$c== :: forall a. IOURef a -> IOURef a -> Bool
Eq)

{-# INLINEABLE newIOURef #-}
newIOURef :: (MArray IOUArray a IO) => a -> IO (IOURef a)
newIOURef :: a -> IO (IOURef a)
newIOURef a
x = do
  IOUArray Int a
a <- (Int, Int) -> a -> IO (IOUArray Int a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
0) a
x
  IOURef a -> IO (IOURef a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IOURef a -> IO (IOURef a)) -> IOURef a -> IO (IOURef a)
forall a b. (a -> b) -> a -> b
$ IOUArray Int a -> IOURef a
forall a. IOUArray Int a -> IOURef a
IOURef IOUArray Int a
a

{-# INLINEABLE readIOURef #-}
readIOURef :: (MArray IOUArray a IO) => IOURef a -> IO a
readIOURef :: IOURef a -> IO a
readIOURef (IOURef IOUArray Int a
a) = IOUArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead IOUArray Int a
a Int
0

{-# INLINEABLE writeIOURef #-}
writeIOURef :: (MArray IOUArray a IO) => IOURef a -> a -> IO ()
writeIOURef :: IOURef a -> a -> IO ()
writeIOURef (IOURef IOUArray Int a
a) a
x = IOUArray Int a -> Int -> a -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite IOUArray Int a
a Int
0 a
x

{-# INLINEABLE modifyIOURef #-}
modifyIOURef :: (MArray IOUArray a IO) => IOURef a -> (a -> a) -> IO ()
modifyIOURef :: IOURef a -> (a -> a) -> IO ()
modifyIOURef IOURef a
ref a -> a
f = do
  a
x <- IOURef a -> IO a
forall a. MArray IOUArray a IO => IOURef a -> IO a
readIOURef IOURef a
ref
  IOURef a -> a -> IO ()
forall a. MArray IOUArray a IO => IOURef a -> a -> IO ()
writeIOURef IOURef a
ref (a -> a
f a
x)