Copyright | (c) Alexey Kuleshevich 2020 |
---|---|
License | BSD3 |
Maintainer | Alexey Kuleshevich <[email protected]> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Data.Prim.Ref
Description
Synopsis
- data Ref a s = Ref (MutVar# s a)
- type IORef a = Ref a RW
- type STRef s a = Ref a s
- newRef :: MonadPrim s m => a -> m (Ref a s)
- newDeepRef :: (NFData a, MonadPrim s m) => a -> m (Ref a s)
- isSameRef :: Ref a s -> Ref a s -> Bool
- readRef :: MonadPrim s m => Ref a s -> m a
- swapRef :: MonadPrim s m => Ref a s -> a -> m a
- swapDeepRef :: (NFData a, MonadPrim s m) => Ref a s -> a -> m a
- writeRef :: MonadPrim s m => Ref a s -> a -> m ()
- writeDeepRef :: (NFData a, MonadPrim s m) => Ref a s -> a -> m ()
- modifyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b
- modifyDeepRef :: (NFData a, MonadPrim s m) => Ref a s -> (a -> (a, b)) -> m b
- modifyRef_ :: MonadPrim s m => Ref a s -> (a -> a) -> m ()
- modifyFetchNewRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- modifyFetchOldRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- modifyRefM :: MonadPrim s m => Ref a s -> (a -> m (a, b)) -> m b
- modifyDeepRefM :: (NFData a, MonadPrim s m) => Ref a s -> (a -> m (a, b)) -> m b
- modifyRefM_ :: MonadPrim s m => Ref a s -> (a -> m a) -> m ()
- modifyFetchNewRefM :: MonadPrim s m => Ref a s -> (a -> m a) -> m a
- modifyFetchOldRefM :: MonadPrim s m => Ref a s -> (a -> m a) -> m a
- atomicReadRef :: MonadPrim s m => Ref e s -> m e
- atomicSwapRef :: MonadPrim s m => Ref e s -> e -> m e
- atomicWriteRef :: MonadPrim s m => Ref e s -> e -> m ()
- atomicModifyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b
- atomicModifyRef_ :: MonadPrim s m => Ref a s -> (a -> a) -> m ()
- atomicModifyFetchRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m (a, a, b)
- atomicModifyFetchNewRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- atomicModifyFetchOldRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- atomicModifyFetchBothRef :: MonadPrim s m => Ref a s -> (a -> a) -> m (a, a)
- casRef :: MonadPrim s m => Ref a s -> a -> a -> m (Bool, a)
- atomicModifyRef2 :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b
- atomicModifyRef2_ :: MonadPrim s m => Ref a s -> (a -> a) -> m ()
- atomicModifyFetchNewRef2 :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- atomicModifyFetchOldRef2 :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- atomicModifyFetchBothRef2 :: MonadPrim s m => Ref a s -> (a -> a) -> m (a, a)
- atomicModifyFetchRef2 :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m (a, a, b)
- newLazyRef :: MonadPrim s m => a -> m (Ref a s)
- writeLazyRef :: MonadPrim s m => Ref a s -> a -> m ()
- swapLazyRef :: MonadPrim s m => Ref a s -> a -> m a
- modifyLazyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b
- modifyLazyRefM :: MonadPrim s m => Ref a s -> (a -> m (a, b)) -> m b
- atomicWriteLazyRef :: MonadPrim s m => Ref b s -> b -> m ()
- atomicModifyLazyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b
- atomicModifyFetchNewLazyRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- atomicModifyFetchOldLazyRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a
- atomicModifyFetchBothLazyRef :: MonadPrim s m => Ref a s -> (a -> a) -> m (a, a)
- atomicModifyFetchLazyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m (a, a, b)
- toSTRef :: Ref a s -> STRef s a
- fromSTRef :: STRef s a -> Ref a s
- toIORef :: Ref a RW -> IORef a
- fromIORef :: IORef a -> Ref a RW
- mkWeakRef :: forall a b m. MonadUnliftPrim RW m => Ref a RW -> m b -> m (Weak (Ref a RW))
Documentation
Mutable variable that can hold any value. This is just like STRef
, but
with type arguments flipped and is generalized to work in MonadPrim
. It only stores a
reference to the value which means it works on boxed values. If the type can be unboxed
with Prim
class, consider using
PVar
package instead.
Since: 0.3.0
Create
newRef :: MonadPrim s m => a -> m (Ref a s) Source #
Create a new mutable variable. Initial value will be forced to WHNF (weak head normal form).
Examples
>>>
import Debug.Trace
>>>
import Data.Prim.Ref
>>>
ref <- newRef (trace "Initial value is evaluated" (217 :: Int))
Initial value is evaluated>>>
modifyFetchOldRef ref succ
217>>>
readRef ref
218
Since: 0.3.0
newDeepRef :: (NFData a, MonadPrim s m) => a -> m (Ref a s) Source #
Create a new mutable variable. Same as newRef
, but ensures that value is evaluated
to normal form.
Examples
>>>
import Debug.Trace
>>>
import Data.Prim.Ref
>>>
ref <- newDeepRef (Just (trace "Initial value is evaluated" (217 :: Int)))
Initial value is evaluated>>>
readRef ref
Just 217
Since: 0.3.0
isSameRef :: Ref a s -> Ref a s -> Bool Source #
Check whether supplied Ref
s refer to the exact same one or not.
Since: 0.3.0
Read/write
readRef :: MonadPrim s m => Ref a s -> m a Source #
Read contents of the mutable variable
Examples
>>>
import Data.Prim.Ref
>>>
ref <- newRef "Hello World!"
>>>
readRef ref
"Hello World!"
Since: 0.3.0
swapRef :: MonadPrim s m => Ref a s -> a -> m a Source #
Swap a value of a mutable variable with a new one, while retrieving the old one. New value is evaluated prior to it being written to the variable.
Examples
>>>
ref <- newRef (Left "Initial" :: Either String String)
>>>
swapRef ref (Right "Last")
Left "Initial">>>
readRef ref
Right "Last"
Since: 0.3.0
swapDeepRef :: (NFData a, MonadPrim s m) => Ref a s -> a -> m a Source #
Swap a value of a mutable variable with a new one, while retrieving the old one. New value is evaluated to normal form prior to it being written to the variable.
Examples
>>>
ref <- newRef (Just "Initial")
>>>
swapDeepRef ref (Just (errorWithoutStackTrace "foo"))
*** Exception: foo>>>
readRef ref
Just "Initial"
Since: 0.3.0
writeRef :: MonadPrim s m => Ref a s -> a -> m () Source #
Write a value into a mutable variable strictly. If evaluating a value results in
exception, original value in the mutable variable will not be affected. Another great
benfit of this over writeLazyRef
is that it helps avoiding memory leaks.
Examples
>>>
ref <- newRef "Original value"
>>>
import Control.Prim.Exception
>>>
_ <- try $ writeRef ref undefined :: IO (Either SomeException ())
>>>
readRef ref
"Original value">>>
writeRef ref "New total value"
>>>
readRef ref
"New total value"
Since: 0.3.0
Modify
Pure
modifyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b Source #
Apply a pure function to the contents of a mutable variable strictly. Returns the
artifact produced by the modifying function. Artifact is not forced, therfore it cannot
affect the outcome of modification. This function is a faster alternative to
atomicModifyRef
, except without any guarantees of atomicity and ordering of mutable
operations during concurrent modification of the same Ref
. For lazy version see
modifyLazyRef
and for strict evaluation to normal form see modifyDeepRef
.
Since: 0.3.0
modifyDeepRef :: (NFData a, MonadPrim s m) => Ref a s -> (a -> (a, b)) -> m b Source #
Same as modifyRef
, except it will evaluate result of computation to normal form.
Since: 0.3.0
modifyRef_ :: MonadPrim s m => Ref a s -> (a -> a) -> m () Source #
Apply a pure function to the contents of a mutable variable strictly.
Since: 0.3.0
modifyFetchNewRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
Apply a pure function to the contents of a mutable variable strictly. Returns the new value.
Since: 0.3.0
modifyFetchOldRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
Apply a pure function to the contents of a mutable variable strictly. Returns the old value.
Examples
>>>
ref1 <- newRef (10 :: Int)
>>>
ref2 <- newRef (201 :: Int)
>>>
modifyRefM_ ref1 (\x -> modifyFetchOldRef ref2 (* x))
>>>
readRef ref1
201>>>
readRef ref2
2010
Since: 0.3.0
Monadic
modifyRefM :: MonadPrim s m => Ref a s -> (a -> m (a, b)) -> m b Source #
Modify value of a mutable variable with a monadic action. It is not strict in a
return value of type b
, but the ne value written into the mutable variable is
evaluated to WHNF.
Examples
modifyDeepRefM :: (NFData a, MonadPrim s m) => Ref a s -> (a -> m (a, b)) -> m b Source #
Same as modifyRefM
, except evaluates new value to normal form prior ot it being
written to the mutable ref.
modifyRefM_ :: MonadPrim s m => Ref a s -> (a -> m a) -> m () Source #
Modify value of a mutable variable with a monadic action. Result is written strictly.
Examples
>>>
ref <- newRef (Just "Some value")
>>>
modifyRefM_ ref $ \ mv -> Nothing <$ mapM_ putStrLn mv
Some value>>>
readRef ref
Nothing
Since: 0.3.0
modifyFetchNewRefM :: MonadPrim s m => Ref a s -> (a -> m a) -> m a Source #
Apply a monadic action to the contents of a mutable variable strictly. Returns the new value.
Since: 0.3.0
modifyFetchOldRefM :: MonadPrim s m => Ref a s -> (a -> m a) -> m a Source #
Apply a monadic action to the contents of a mutable variable strictly. Returns the old value.
Examples
>>>
refName <- newRef "My name is: "
>>>
refMyName <- newRef "Alexey"
>>>
myName <- modifyFetchOldRefM refMyName $ \ name -> "Leo" <$ modifyRef_ refName (++ name)
>>>
readRef refName >>= putStrLn
My name is: Alexey>>>
putStrLn myName
Alexey>>>
readRef refMyName >>= putStrLn
Leo
Since: 0.3.0
Atomic
atomicReadRef :: MonadPrim s m => Ref e s -> m e Source #
atomicSwapRef :: MonadPrim s m => Ref e s -> e -> m e Source #
Same as atomicWriteRef
, but also returns the old value.
Since: 0.3.0
atomicWriteRef :: MonadPrim s m => Ref e s -> e -> m () Source #
Evaluate a value and write it atomically into a Ref
. This is different from
writeRef
because a memory barrier
will be issued. Use this instead of writeRef
in order to guarantee the ordering of
operations in a concurrent environment.
Since: 0.3.0
atomicModifyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b Source #
Apply a function to the value stored in a mutable Ref
atomically. Function is
applied strictly with respect to the newly returned value, which matches the semantics
of atomicModifyIORef
`, however the difference is that the artifact returned by the
action is not evaluated.
Example
>>>
Since: 0.3.0
atomicModifyRef_ :: MonadPrim s m => Ref a s -> (a -> a) -> m () Source #
atomicModifyFetchRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m (a, a, b) Source #
Appy a function to the value in mutable Ref
atomically
Since: 0.3.0
atomicModifyFetchNewRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
atomicModifyFetchOldRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
atomicModifyFetchBothRef :: MonadPrim s m => Ref a s -> (a -> a) -> m (a, a) Source #
Original
atomicModifyRef2 :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b Source #
atomicModifyRef2_ :: MonadPrim s m => Ref a s -> (a -> a) -> m () Source #
atomicModifyFetchNewRef2 :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
atomicModifyFetchOldRef2 :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
atomicModifyFetchBothRef2 :: MonadPrim s m => Ref a s -> (a -> a) -> m (a, a) Source #
atomicModifyFetchRef2 :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m (a, a, b) Source #
Lazy
newLazyRef :: MonadPrim s m => a -> m (Ref a s) Source #
Create a new mutable variable. Initial value stays unevaluated.
Examples
In below example you will see that initial value is never evaluated.
>>>
import Debug.Trace
>>>
import Data.Prim.Ref
>>>
ref <- newLazyRef (trace "Initial value is evaluated" (undefined :: Int))
>>>
writeRef ref 1024
>>>
modifyFetchNewRef ref succ
1025
Since: 0.3.0
writeLazyRef :: MonadPrim s m => Ref a s -> a -> m () Source #
Write a value into a mutable variable lazily.
Examples
>>>
ref <- newRef "Original value"
>>>
import Debug.Trace
>>>
writeLazyRef ref (trace "'New string' is evaluated" "New string")
>>>
x <- readRef ref
>>>
writeRef ref (trace "'Totally new string' is evaluated" "Totally new string")
'Totally new string' is evaluated>>>
putStrLn x
'New string' is evaluated New string
Since: 0.3.0
swapLazyRef :: MonadPrim s m => Ref a s -> a -> m a Source #
Swap a value of a mutable variable with a new one lazily, while retrieving the old one. New value is not evaluated prior to it being written to the variable.
Examples
>>>
ref <- newRef "Initial"
>>>
swapLazyRef ref undefined
"Initial">>>
_ <- swapLazyRef ref "Different"
>>>
readRef ref
"Different"
Since: 0.3.0
modifyLazyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b Source #
Apply a pure function to the contents of a mutable variable lazily. Returns the artifact produced by the modifying function.
Since: 0.3.0
modifyLazyRefM :: MonadPrim s m => Ref a s -> (a -> m (a, b)) -> m b Source #
Same as modifyRefM
, but do not evaluate the new value written into the Ref
.
Since: 0.3.0
atomicWriteLazyRef :: MonadPrim s m => Ref b s -> b -> m () Source #
atomicModifyLazyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m b Source #
atomicModifyFetchNewLazyRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
atomicModifyFetchOldLazyRef :: MonadPrim s m => Ref a s -> (a -> a) -> m a Source #
atomicModifyFetchBothLazyRef :: MonadPrim s m => Ref a s -> (a -> a) -> m (a, a) Source #
atomicModifyFetchLazyRef :: MonadPrim s m => Ref a s -> (a -> (a, b)) -> m (a, a, b) Source #