Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5ccd462b97f00802936eb75276bedcda6ed9edfb >--------------------------------------------------------------- commit 5ccd462b97f00802936eb75276bedcda6ed9edfb Author: Joey Adams <[email protected]> Date: Sat Jul 7 22:13:52 2012 -0400 Add strict version of modifySTRef Also, add a warning to modifySTRef, mostly copy-pasted from the warning for modifyIORef. >--------------------------------------------------------------- Data/STRef.hs | 24 ++++++++++++++++++++++-- 1 files changed, 22 insertions(+), 2 deletions(-) diff --git a/Data/STRef.hs b/Data/STRef.hs index c628bb6..7c884e5 100644 --- a/Data/STRef.hs +++ b/Data/STRef.hs @@ -21,7 +21,8 @@ module Data.STRef ( 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 () + modifySTRef' -- :: STRef s a -> (a -> a) -> ST s () ) where import Prelude @@ -39,7 +40,26 @@ import Data.Typeable INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef") #endif --- |Mutate the contents of an 'STRef' +-- | Mutate the contents of an 'STRef'. +-- +-- Be warned that 'modifySTRef' does not apply the function strictly. This +-- means if the program calls 'modifySTRef' 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 likely produce a stack overflow: +-- +-- >print $ runST $ do +-- > ref <- newSTRef 0 +-- > replicateM_ 1000000 $ modifySTRef ref (+1) +-- > readSTRef ref +-- +-- To avoid this problem, use 'modifySTRef'' instead. modifySTRef :: STRef s a -> (a -> a) -> ST s () modifySTRef ref f = writeSTRef ref . f =<< readSTRef ref +-- | Strict version of 'modifySTRef' +modifySTRef' :: STRef s a -> (a -> a) -> ST s () +modifySTRef' ref f = do + x <- readSTRef ref + let x' = f x + x' `seq` writeSTRef ref x' _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
