[Haskell-cafe] cap 3: stopping thread 3 (stackoverflow)
Claude Heiland-Allen
claude at goto10.org
Tue Jun 7 18:00:23 CEST 2011
Hi,
On 07/06/11 14:22, Johannes Waldmann wrote:
> Would this work better with Data.Sequence instead of List?
> (Is there a really cheap way (O(1)) to split some Data.Sequence roughly in half?)
I came up with this using immutable unboxed arrays, which gives a nice
parallel speedup (and somehow avoids the stack overflows, I didn't work
out where they were coming from unfortunately):
SPARKS: 1000268 (102821 converted, 0 pruned)
INIT time 0.02s ( 0.02s elapsed)
MUT time 0.90s ( 0.46s elapsed)
GC time 0.03s ( 0.03s elapsed)
EXIT time 0.01s ( 0.04s elapsed)
Total time 0.97s ( 0.53s elapsed)
%GC time 3.1% (5.8% elapsed)
Alloc rate 586,961,335 bytes per MUT second
Productivity 94.4% of total user, 173.5% of total elapsed
on my dual-core laptop until around 1e6 elements when I compile with:
ghc -O2 -Wall --make -threaded -rtsopts -fforce-recomp Subseqsum.hs
and run with:
./Subseqsum 1e6 +RTS -N -s -M1G -A512M
but after that (eg: 1e7) the GC time dominates and it slows right down.
Note that I haven't tested it for correctness! So there may be bugs:
----8<----
import Data.List (unfoldr)
import Control.Parallel (par, pseq)
import Data.Monoid (Monoid, mempty, mappend)
import Data.Array.Unboxed (UArray, listArray, (!))
import System.Environment (getArgs)
main :: IO ()
main = do
[ nn ] <- getArgs
let n = read nn
xs = stuff
a = listArray (0, n - 1) xs
print . t $ sss 0 n a
stuff :: [Int]
stuff = unfoldr ( \ x -> seq x $ Just ( x, mod (113 * x + 558) 335 - 167
) ) 0
data O = O { s :: ! Int, l :: !Int, r :: !Int , t :: !Int }
instance Monoid O where
mempty = O { s = 0, r = 0, l = 0, t = 0 }
o1 `mappend` o2 =
let s' = s o1 + s o2
r' = max (r o2) ( s o2 + r o1 )
l' = max (l o1) ( s o1 + l o2 )
t' = max (r o1 + l o2)
$ max ( t o1 ) ( t o2 )
in O { s = s', r = r', l = l', t = t' }
msingle :: Int -> O
msingle x = O { s = x, r = max x 0, l = max x 0, t = max x 0}
sss :: Int -> Int -> UArray Int Int -> O
sss lo hi a
| lo == hi = mempty
| lo + 1 == hi = msingle (a ! lo)
| otherwise =
let mid = (lo + hi) `div` 2
x = sss lo mid a
y = sss mid hi a
in x `par` y `pseq` (x `mappend` y)
----8<----
> PS: I keep telling my students that "structural parallel programming"
I don't know that term, so I might be missing the point. Sorry if so.
Thanks,
Claude
--
http://claudiusmaximus.goto10.org
More information about the Haskell-Cafe
mailing list