[Haskell-cafe] Getting results of of runSTUArray

Henry Laxen nadine.and.henry at pobox.com
Wed Oct 20 12:42:31 EDT 2010


1{-
Dear Group,

I am trying to do something that I think should be very simple, but I
just can't seem to figure out how.  The idea is that I want to use
runSTUArray to build up an array, but I want to look at the array
after each iteration and possiblely accumulate some elements.  

-}

import Debug.Trace
import Control.Monad
import Control.Monad.ST
import Data.Array.ST

incArray arr index = do
  x <- readArray arr index
  writeArray arr index (x+1) 
  
checkArray = filter (\(i,e) -> e == 1) 

run = runSTUArray ( do
  a <- newArray (0,9) 0 :: ST s (STUArray s Int Int)
  all <- forM [1..10] (\i -> do
    let j = i `mod` 4
    incArray a j
    b <- getAssocs a
    -- now run something like checkArray and build up a list of "wanted" elements
    -- which I would like to return from run, but I don't see how
    return b)
  -- Or, if I cound run (lazily) on "all" (the result of the forM) 
  -- I could do my accumulation
  let theAnswerIWant = concatMap checkArray all   
  return (trace (show theAnswerIWant) a)) -- I can't seem to return anything but a here

{- result is:    

array [(1,1),(1,1),(2,1),(1,1),(2,1),(3,1),(0,1),
(1,1),(2,1),(3,1),(0,1),(2,1),(3,1),(0,1),(3,1),
(0,1)]
(0,9) [(0,2),(1,3),(2,3),(3,2),(4,0),(5,0),(6,0),(7,0),(8,0),(9,0)]

is there any way to get theAnswerIWant out of run?

Thanks in advance for any insights.

-}




More information about the Haskell-Cafe mailing list