withStorableArray making IORefs
Hal Daume III
hdaume@ISI.EDU
Fri, 9 Aug 2002 12:23:05 -0700 (PDT)
I'm guessing it's not safe to use "newIORef" as the function argument to
withStorableArray, but in a simple case [1], it seems to work okay. I
suppose the danger is if the RTS decides to move the array. Does this
happen IRL?
- Hal
[1]: the example program is something like:
module Main
where
import Data.Array.Storable
import Foreign
import Data.IORef
mkArray :: Int -> IO (StorableArray Int Int)
mkArray sz = newArray_ (1,sz) >>= \arr ->
mapM_ (\i -> writeArray arr i i) [1..sz] >>
return arr
foo :: Ptr Int -> IO Int
foo ptr = peek ptr >>= \v -> poke ptr (v+1) >> return v
bar =
do arr <- mkArray 10
ptr <- withStorableArray arr newIORef >>= readIORef
foo ptr >> foo ptr >> foo ptr
withStorableArray arr foo
main = bar >>= print >> bar >>= print >> bar >>= print
--
Hal Daume III
"Computer science is no more about computers | hdaume@isi.edu
than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume