module Data.SyntaxSugar where
import Control.Monad.ST (ST)
import Data.ArrayBZ.IO
import Data.ArrayBZ.ST
import Data.ArrayBZ.Storable
import Data.HashTable as Hash
import Data.Ref
import Data.Unboxed
import Foreign.Storable
class (Monad m) => Mutable m r a | r->a where
readVar :: r -> m a
writeVar :: r -> a -> m ()
modifyVar :: (Mutable m r b) => r -> (b -> b) -> m ()
modifyVar var f = readVar var >>= writeVar var . f
modifyVarM :: (Mutable m r a) => r -> (a -> m a) -> m ()
modifyVarM var f = readVar var >>= f >>= writeVar var
instance Mutable IO (IORef a) a where
readVar = readRef
writeVar = writeRef
instance Mutable (ST s) (STRef s a) a where
readVar = readRef
writeVar = writeRef
instance (Unboxed a) => Mutable IO (IOURef a) a where
readVar = readURef
writeVar = writeURef
instance (Unboxed a) => Mutable (ST s) (STURef s a) a where
readVar = readURef
writeVar = writeURef
instance (Ix i) => Mutable IO (IOArray i e, i) e where
readVar (arr,i) = readArray arr i
writeVar (arr,i) = writeArray arr i
instance (Unboxed e, Ix i) => Mutable IO (IOUArray i e, i) e where
readVar (arr,i) = readArray arr i
writeVar (arr,i) = writeArray arr i
instance (Storable e, Ix i) => Mutable IO (StorableArray i e, i) e where
readVar (arr,i) = readArray arr i
writeVar (arr,i) = writeArray arr i
instance (Ix i) => Mutable (ST s) (STArray s i e, i) e where
readVar (arr,i) = readArray arr i
writeVar (arr,i) = writeArray arr i
instance (Unboxed e, Ix i) => Mutable (ST s) (STUArray s i e, i) e where
readVar (arr,i) = readArray arr i
writeVar (arr,i) = writeArray arr i
instance (MArray a e m, Ix i, Ix j) => Mutable m (a (i,j) e, i, j) e where
readVar (arr,i,j) = readArray arr (i,j)
writeVar (arr,i,j) = writeArray arr (i,j)
instance (MArray a e m, Ix i, Ix j, Ix k) => Mutable m (a (i,j,k) e, i, j, k) e where
readVar (arr,i,j,k) = readArray arr (i,j,k)
writeVar (arr,i,j,k) = writeArray arr (i,j,k)
instance Mutable IO (HashTable key e, key) e where
readVar (table,key) = do (Just x) <- Hash.lookup table key
return x
writeVar (table,key) e = hashUpdate table key e >> return ()
#if defined(__HUGS_VERSION__) || defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 604)
hashUpdate :: HashTable key val -> key -> val -> IO Bool
hashUpdate table = Hash.update table
#else
hashUpdate table key e = do Hash.delete table key
Hash.insert table key e
#endif
infixl 0 =:, +=, -=, .=, .<-
ref :: (Ref m r) => a -> m (r a)
ref x = newRef x
uref :: (Unboxed a, URef m r) => a -> m (r a)
uref x = newURef x
val :: (Mutable m r a) => r -> m a
val var = readVar var
(=:) :: (Mutable m r a) => r -> a -> m ()
var=:x = writeVar var x
(+=) :: (Mutable m r b, Num b) => r -> b -> m ()
var+=x = modifyVar var (\old -> old+x)
(-=) :: (Mutable m r b, Num b) => r -> b -> m ()
var-=x = modifyVar var (\old -> oldx)
(.=) :: (Mutable m r b) => r -> (b -> b) -> m ()
var.=f = modifyVar var (\old -> f old)
(.<-) :: (Mutable m r a) => r -> (a -> m a) -> m ()
var.<-f = modifyVarM var (\old -> f old)