Data.STRef (original) (raw)
Description
Mutable references in the (strict) ST monad.
Synopsis
- data STRef s a
- newSTRef :: a -> ST s (STRef s a)
- readSTRef :: STRef s a -> ST s a
- writeSTRef :: STRef s a -> a -> ST s ()
- modifySTRef :: STRef s a -> (a -> a) -> ST s ()
- modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
a value of type STRef s a
is a mutable variable in state thread s
, containing a value of type a
>>>
**:{** **
**runST (do
ref <- newSTRef "hello"
x <- readSTRef ref
writeSTRef ref (x ++ "world")
readSTRef ref )
:}
"helloworld"
modifySTRef :: STRef s a -> (a -> a) -> ST s () Source #
Mutate the contents of an [STRef](Data-STRef.html#t:STRef "Data.STRef")
.
>>>
**:{** **
**runST (do
ref <- newSTRef ""
modifySTRef ref (const "world")
modifySTRef ref (++ "!")
modifySTRef ref ("Hello, " ++)
readSTRef ref )
:}
"Hello, world!"
Be warned that [modifySTRef](Data-STRef.html#v:modifySTRef "Data.STRef")
does not apply the function strictly. This means if the program calls [modifySTRef](Data-STRef.html#v:modifySTRef "Data.STRef")
many times, but seldomly uses the value, thunks will pile up in memory resulting in a space leak. This is a common mistake made when using an STRef as a counter. For example, the following will leak memory and may produce a stack overflow:
>>>
import Control.Monad (replicateM_)** **
>>>
**:{** **
**print (runST (do
ref <- newSTRef 0
replicateM_ 1000 $ modifySTRef ref (+1)
readSTRef ref ))
:}
1000
To avoid this problem, use [modifySTRef'](Data-STRef.html#v:modifySTRef-39- "Data.STRef")
instead.