
Am Donnerstag 04 Februar 2010 17:50:57 schrieb Michael Lesniak:
Hello haskell-cafe,
I currently have a problem with running par/pseq in the ST monad. The function testST is the minimal counterexample that works -- or, to be more clear, does not work as expected for me. As a remark, the tasks/function calls in my "real application" are much more computational expensive, but the code is too long to post here.
-- File ST.lhs module Main where import Control.Monad.ST import Control.Parallel main = testST
testST :: IO () testST = do putStrLn "Starting" (runST $ f 10) `pseq` putStrLn "Stopping" where f :: forall s. Int -> ST s () f n = do p $ "\nTask:" ++ show n if n < 0 then return () else do (n1,n2) <- return (n-1,n-2) q n1 q n2 a <- f n1 b <- f n2 (a `par` b) `pseq` return a
-- Some helper functions p x = unsafeIOToST (putStrLn x) q x = unsafeIOToST (print x)
As far as I understand, compiling with
ghc --make -O2 -threaded ST.lhs -o st -XRankNTypes
and running with
./st +RTS -N -s
You'd need to give a number of capacities, I think (-N2 e.g.).
should create sparks that could be run in parallel. The problem I have now, is that sparks are created but not converted, according to -s output:
... a lot of (uninteresting) stuff SPARKS: 232 (0 converted, 0 pruned) ...
I have not found any information on this type of behaviour on the net and would be glad if someone could give me points or hints what's happening and how I can improve this.
I think with the strict ST monad, when you have a <- f n1 b <- f n2 they are already evaluated, so there's no point in sparking evaluation in parallel.
Cheers, Michael