1{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable, CPP #-} 2 3-- | 4-- Module : Data.Primitive.MutVar 5-- Copyright : (c) Justin Bonnar 2011, Roman Leshchinskiy 2011-2012 6-- License : BSD-style 7-- 8-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> 9-- Portability : non-portable 10-- 11-- Primitive boxed mutable variables 12-- 13 14module Data.Primitive.MutVar ( 15 MutVar(..), 16 17 newMutVar, 18 readMutVar, 19 writeMutVar, 20 21 atomicModifyMutVar, 22 atomicModifyMutVar', 23 modifyMutVar, 24 modifyMutVar' 25) where 26 27import Control.Monad.Primitive ( PrimMonad(..), primitive_ ) 28import GHC.Exts ( MutVar#, sameMutVar#, newMutVar#, 29 readMutVar#, writeMutVar#, atomicModifyMutVar# ) 30import Data.Primitive.Internal.Compat ( isTrue# ) 31import Data.Typeable ( Typeable ) 32 33-- | A 'MutVar' behaves like a single-element mutable array associated 34-- with a primitive state token. 35data MutVar s a = MutVar (MutVar# s a) 36 deriving ( Typeable ) 37 38instance Eq (MutVar s a) where 39 MutVar mva# == MutVar mvb# = isTrue# (sameMutVar# mva# mvb#) 40 41-- | Create a new 'MutVar' with the specified initial value 42newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a) 43{-# INLINE newMutVar #-} 44newMutVar initialValue = primitive $ \s# -> 45 case newMutVar# initialValue s# of 46 (# s'#, mv# #) -> (# s'#, MutVar mv# #) 47 48-- | Read the value of a 'MutVar' 49readMutVar :: PrimMonad m => MutVar (PrimState m) a -> m a 50{-# INLINE readMutVar #-} 51readMutVar (MutVar mv#) = primitive (readMutVar# mv#) 52 53-- | Write a new value into a 'MutVar' 54writeMutVar :: PrimMonad m => MutVar (PrimState m) a -> a -> m () 55{-# INLINE writeMutVar #-} 56writeMutVar (MutVar mv#) newValue = primitive_ (writeMutVar# mv# newValue) 57 58-- | Atomically mutate the contents of a 'MutVar' 59atomicModifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a,b)) -> m b 60{-# INLINE atomicModifyMutVar #-} 61atomicModifyMutVar (MutVar mv#) f = primitive $ atomicModifyMutVar# mv# f 62 63-- | Strict version of 'atomicModifyMutVar'. This forces both the value stored 64-- in the 'MutVar' as well as the value returned. 65atomicModifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a, b)) -> m b 66{-# INLINE atomicModifyMutVar' #-} 67atomicModifyMutVar' mv f = do 68 b <- atomicModifyMutVar mv force 69 b `seq` return b 70 where 71 force x = case f x of 72 v@(x',_) -> x' `seq` v 73 74-- | Mutate the contents of a 'MutVar' 75modifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () 76{-# INLINE modifyMutVar #-} 77modifyMutVar (MutVar mv#) g = primitive_ $ \s# -> 78 case readMutVar# mv# s# of 79 (# s'#, a #) -> writeMutVar# mv# (g a) s'# 80 81-- | Strict version of 'modifyMutVar' 82modifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () 83{-# INLINE modifyMutVar' #-} 84modifyMutVar' (MutVar mv#) g = primitive_ $ \s# -> 85 case readMutVar# mv# s# of 86 (# s'#, a #) -> let a' = g a in a' `seq` writeMutVar# mv# a' s'# 87