[Haskell-cafe] ST not strict enough?

tomberek tomberek at gmail.com
Wed Nov 16 22:28:14 CET 2011


I ran into a similar problem with modifySTRef causing allocation and
GC. Creating my own strict version of modifySTRef got rid of all that
and my program ran without any allocation at all.

On Nov 16, 3:16 pm, Johan Tibell <johan.tib... at gmail.com> wrote:
> On Wed, Nov 16, 2011 at 12:07 PM, Johan Tibell <johan.tib... at gmail.com>wrote:
>
>
>
>
>
>
>
>
>
> > On Wed, Nov 16, 2011 at 11:58 AM, Jason Dusek <jason.du... at gmail.com>wrote:
>
> >> diff --git a/Rebuild.hs b/Rebuild.hs
> >> @@ -15,6 +15,7 @@ import Data.STRef
> >>  import Data.String
> >>  import Data.Word
>
> >> +import Control.DeepSeq
> >>  import Data.Vector.Unboxed (Vector)
> >>  import qualified Data.Vector.Unboxed as Vector (create, length)
> >>  import qualified Data.Vector.Unboxed.Mutable as Vector hiding (length)
> >> @@ -46,8 +47,8 @@ rebuildAsVector bytes        =  byteVector
> >>     n                       <-  readSTRef counter
> >>     return (Vector.unsafeSlice 0 n v)
> >>   writeOneByte v counter b   =  do n <- readSTRef counter
> >> -                                   Vector.unsafeWrite v n b
> >> +                                   w v n b
> >>                                    modifySTRef counter (+!1)
> >> +  (+!) a b                   =  ((+) $!! a) $!! b
> >> +  w v n b = (Vector.unsafeWrite v $!! n) $!! b
>
> > +! doesn't work unless modifySTRef is already strict in the result of the
> > function application. You need to write modifySTRef' that seq:s the result
> > of the function application before calling writeSTRef.
>
> Just double checked. modifySTRef is too lazy:
>
> -- |Mutate the contents of an 'STRef'
> modifySTRef :: STRef s a -> (a -> a) -> ST s ()
> modifySTRef ref f = writeSTRef ref . f =<< readSTRef ref
>
> We need Data.STRef.Strict
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-C... at haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list