Commit 2640ba70 authored by Simon Marlow's avatar Simon Marlow

update to work with parallel-3.x

parent 01fefbbb
TOP = ..
include $(TOP)/mk/boilerplate.mk
SUBDIRS = parfib partree sumeuler matmult ray gray prsa mandel queens
SUBDIRS = parfib partree sumeuler matmult ray gray prsa mandel queens coins
# CPP SYMBOLS
#
# -DSTRATEGIES_2 to use the version 2 strategies library (default is 3)
# partak: program needs work to make it parallel
......
......@@ -3,6 +3,8 @@
import Data.List
import System.Environment
import Control.Parallel
import Control.Parallel.Strategies
import Control.Applicative
-- Rough results, GHC 6.13: (val=777)
-- V1 (SDM): 2.2s
......@@ -76,7 +78,7 @@ payA_par depth val ((c,q):coins) acc
| otherwise = res
where
res = right `par` left `pseq` append left right
res = unEval $ pure append <*> rpar left <*> rwhnf right
left = payA_par (if q == 1 then (depth-1) else depth) (val - c) coins' (c:acc)
right = payA_par (depth-1) val coins acc
......
......@@ -5,7 +5,7 @@
-- Modified to use stdout (for testing)
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BangPatterns,CPP #-}
module Illumination
( Object
, Light (..)
......@@ -14,6 +14,7 @@ module Illumination
) where
import Control.Parallel
import Control.Parallel.Strategies (withStrategy, parBuffer, rwhnf)
import Array
import Char(chr)
......@@ -33,9 +34,15 @@ render :: (Matrix,Matrix) -> Color -> [Light] -> Object -> Int ->
Radian -> Int -> Int -> String -> IO ()
render (m,m') amb ls obj dep fov wid ht file
= do { debugging
; putStrLn (showBitmap' wid ht (lazyParList 100 (map (\x -> seqList x `pseq` x) pixels)))
; putStrLn (showBitmap' wid ht (parallel pixels))
}
where
#ifdef STRATEGIES_2
parallel = parBuffer 100 rwhnf . map (\x -> seqList x `pseq` x)
#else
parallel = withStrategy (parBuffer 100 rwhnf) . map (\x -> seqList x `pseq` x)
#endif
debugging = return ()
{-
do { putStrLn (show cxt)
......@@ -70,32 +77,10 @@ render (m,m') amb ls obj dep fov wid ht file
| (xd, yd) <- [(-0.333, 0.0), (0.333, 0.0), (0.0, -0.333), (0.0, 0.333)]
]
parListN :: Int -> [a] -> [a]
parListN 0 xs = xs
parListN !n [] = []
parListN !n (x:xs) = x `par` parListN (n-1) xs
-- like parListN, but starts the sparks in reverse order
parListN1 :: Int -> [a] -> [a] -> [a]
parListN1 0 xs ys = parList ys `pseq` xs
parListN1 !n [] ys = parList ys `pseq` []
parListN1 !n (x:xs) ys = parListN1 (n-1) xs (x:ys)
seqList :: [a] -> ()
seqList [] = ()
seqList (x:xs) = x `pseq` seqList xs
parList :: [a] -> ()
parList [] = ()
parList (x:xs) = x `par` parList xs
lazyParList :: Int -> [a] -> [a]
lazyParList !n xs = go xs (parListN1 n xs [])
where
go [] _ys = []
go (x:xs) [] = x : xs
go (x:xs) (y:ys) = y `par` (x : go xs ys)
avg cs = divN (fromIntegral (length cs)) (uncolor (sumCC cs))
where divN n (r,g,b) = color (r / n) (g / n) (b / n)
......
......@@ -7,12 +7,12 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{onlystandalone}
\begin{code}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BangPatterns,CPP #-}
module Mandel where
import Complex -- 1.3
import PortablePixmap
import Control.Parallel
import Control.Parallel.Strategies (using)
import Control.Parallel.Strategies
-- import qualified NewStrategies as NS
default ()
\end{code}
......@@ -125,121 +125,20 @@ the @whenDiverge@ function over a complex plain of values.
\begin{code}
parallelMandel:: [[Complex Double]] -> Int -> Double -> [Int]
parallelMandel mat limit radius
= concat $
-- NewStrategies version:
-- NS.parListBuffer 50 (NS.seqList id) $
-- map (map (whenDiverge limit radius)) mat
-- NewStrategies version:
-- NS.parListBufferRev 50 (NS.seqList id) $
-- map (map (whenDiverge limit radius)) mat
-- lazyParList version:
-- lazyParList 50
-- [ let l = map (whenDiverge limit radius) xs
-- in seqList l `pseq` l
-- | xs <- mat ]
-- lazyParList1 version:
parBuffer 70
[ let l = map (whenDiverge limit radius) xs
in seqList l `pseq` l
| xs <- mat ]
-- = lazyParListChunk 100 100 $ map (whenDiverge limit radius) mat
-- = lazyParMap 512 (whenDiverge limit radius) mat
parBuffer :: Int -> [a] -> [a]
parBuffer n xs = return xs (start n xs)
= concat $ parallel [ let l = map (whenDiverge limit radius) xs
in Mandel.seqList l `pseq` l
| xs <- mat ]
where
return (x:xs) (y:ys) = y `par` (x : return xs ys)
return xs [] = xs
start !n [] = []
start 0 ys = ys
start !n (y:ys) = y `par` start (n-1) ys
-- parListN :: Int -> [a] -> [a]
-- parListN 0 xs = xs
-- parListN !n [] = []
-- parListN !n (x:xs) = x `par` parListN (n-1) xs
lazyParList :: Int -> [a] -> [a]
lazyParList !n xs = go xs (parListN n xs)
where
go [] _ys = []
go (x:xs) [] = x : xs
go (x:xs) (y:ys) = y `par` (x : go xs ys)
lazyParList1 :: Int -> [a] -> [a]
lazyParList1 !n xs = go xs (parListN1 n xs [])
where
go [] _ys = []
go (x:xs) [] = x : xs
go (x:xs) (y:ys) = y `par` (x : go xs ys)
-- parMap :: (a -> b) -> [a] -> [b]
-- parMap f [] = []
-- parMap f (x:xs) = let fx = f x; fxs = parMap f xs in fx `par` fxs `pseq` fx:fxs
parList :: [a] -> ()
parList [] = ()
parList (x:xs) = x `par` parList xs
-- parListN version 1: leads to fights as all capabilities try to
-- steal the early sparks, and the main thread gets blocked.
parListN :: Int -> [a] -> [a]
parListN 0 xs = xs
parListN !n [] = []
parListN !n (x:xs) = x `par` parListN (n-1) xs
-- like parListN, but starts the sparks in reverse order
parListN1 :: Int -> [a] -> [a] -> [a]
parListN1 0 xs ys = parList ys `pseq` xs
parListN1 !n [] ys = parList ys `pseq` []
parListN1 !n (x:xs) ys = parListN1 (n-1) xs (x:ys)
#ifdef STRATEGIES_2
parallel = parBuffer 70 rwhnf
#else
parallel = withStrategy (parBuffer 70 rwhnf)
#endif
seqList :: [a] -> ()
seqList [] = ()
seqList (x:xs) = x `pseq` seqList xs
--
-- parListChunk :: Int -> [a] -> ()
-- parListChunk n [] = ()
-- parListChunk n xs = let (ys,zs) = splitAt n xs in
-- seqList ys `par` parListChunk n zs
-- parListChunkWHNF :: Int -> [a] -> [a]
-- parListChunkWHNF n
-- = concat
-- . (`using` parList)
-- . map (`using` seqList)
-- . chunk n
-- chunk n [] = []
-- chunk n xs = as : chunk n bs where (as,bs) = splitAt n xs
--
-- lazyParList :: Int -> [a] -> [a]
-- lazyParList !n xs = go xs (parListN' n xs [])
-- where
-- go [] _ys = []
-- go (x:xs) [] = x : xs
-- go (x:xs) (y:ys) = y `par` (x : go xs ys)
-- lazyParListChunk :: Int -> Int -> [a] -> [a]
-- lazyParListChunk !n !size xs = go chunks seqchunks (parListN n seqchunks)
-- where
-- chunks = chunkList size xs
-- seqchunks = map seqList chunks
--
-- go :: [[a]] -> [()] -> [()] -> [a]
-- go [] _ _ys = []
-- go (x:xs) _ [] = concat (x:xs)
-- go (x:xs) (y:ys) (z:zs) = z `par` y `pseq` (x ++ go xs ys zs)
--
-- chunkList :: Int -> [a] -> [[a]]
-- chunkList !n [] = []
-- chunkList !n xs = chunk : chunkList n rest
-- where (chunk,rest) = splitAt n xs
seqList (x:xs) = x `pseq` Mandel.seqList xs
\end{code}
\section{Initialisation of data and graphical rendering.}
......
-- -*- haskell -*-
-- Time-stamp: <2010-05-25 16:25:18 simonmar>
-- Time-stamp: <2010-07-16 12:10:03 simonmar>
--
-- ADT of a binary tree (values only in leaves).
-- Parallel functions use par and seq directly.
......@@ -30,11 +30,11 @@ par_tree_map f (Node left right) =
Node (par_tree_map f left) (par_tree_map f right) `using` partree
where
partree (Node l r) = do
l' <- (rpar `dot` rtree) l
l' <- rpar (l `using` rtree)
r' <- rtree r
return (Node l' r')
rtree t = force_tree t `pseq` Done t
rtree t = force_tree t `pseq` return t
-- force evaluation of tree (could use Strategies module instead!)
force_tree :: (Integral a) => Tree a -> ()
......
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BangPatterns,CPP #-}
module Rsa (encrypt, decrypt, makeKeys)
where
import Control.Parallel
import Control.Parallel.Strategies
encrypt, decrypt :: Integer -> Integer -> String -> String
encrypt n e = unlines . parBuffer 100 . map (show . power e n . code) . collect (size n)
decrypt n d = concat . parBuffer 100 . map (decode . power d n . read) . lines
encrypt n e = unlines . parallel . map (show . power e n . code) . collect (size n)
decrypt n d = concat . parallel . map (decode . power d n . read) . lines
-------- Parallelism -----------
#ifdef STRATEGIES_2
parallel = parBuffer 100 rwhnf
#else
parallel = withStrategy (parBuffer 100 rseq)
#endif
parBuffer :: Int -> [a] -> [a]
parBuffer n xs = return xs (start n xs)
where
return (x:xs) (y:ys) = y `par` (x : return xs ys)
return xs [] = xs
start !n [] = []
start 0 ys = ys
start !n (y:ys) = y `par` start (n-1) ys
parmap :: (String -> String) -> [String] -> [String]
parmap f [] = []
......
The Ray tracer algorithm taken from Paul Kelly's book, adapted by Greg
Michaelson for SML, converted to (parallel) Haskell by Kevin Hammond!
> {-# LANGUAGE BangPatterns #-}
> {-# LANGUAGE BangPatterns,CPP #-}
> import Control.Parallel
> import Control.Parallel.Strategies (Strategy, sparking, rwhnf, parBuffer)
> import Control.Parallel.Strategies (Strategy, withStrategy, rwhnf, parBuffer)
> import System.Environment
> main = do
......@@ -138,71 +138,15 @@ in_poly_test (p,q,r) (A,B,C) Vs
> where earliest = insert earlier NoImpact
> findImpacts :: [Ray] -> [Object] -> [Impact]
> findImpacts rays objects = parBuffer 200 rwhnf $ map (firstImpact objects) rays
> using :: a -> (a->()) -> a
> using a s = s a `seq` a
> chunk n [] = []
> chunk n xs = as : chunk n bs where (as,bs) = splitAt n xs
mymap f xs = go xs where go [] = []; go (x:xs) = f x : go xs
> mymap f [] = []
> mymap f (x:xs) = f x : map f xs
> parmap :: (a -> b) -> [a] -> [b]
> parmap f [] = []
> parmap f (x:xs) = fx `par` (pmxs `par` (fx:pmxs))
> where fx = f x
> pmxs = parmap f xs
myParBuffer :: Int -> [a] -> [a]
myParBuffer n xs = return xs (start n xs)
where
return (x:xs) (y:ys) = y `par` (x : return xs ys)
return xs [] = xs
start !n [] = []
start 0 ys = ys
start !n (y:ys) = y `par` start (n-1) ys
parBuffer' :: Int -> Strategy a -> [a] -> [a]
parBuffer' n s xs = return xs (start n xs)
where
return (x:xs) (y:ys) = (x : return xs ys)
`sparking` s y
return xs [] = xs
start !n [] = []
start 0 ys = ys
start !n (y:ys) = start (n-1) ys `sparking` s y
> parListN :: Int -> [a] -> [a]
> parListN 0 xs = xs
> parListN !n [] = []
> parListN !n (x:xs) = x `par` parListN (n-1) xs
>
> -- like parListN, but starts the sparks in reverse order
> parListN1 :: Int -> [a] -> [a] -> [a]
> parListN1 0 xs ys = parList ys `pseq` xs
> parListN1 !n [] ys = parList ys `pseq` []
> parListN1 !n (x:xs) ys = parListN1 (n-1) xs (x:ys)
>
> seqList :: [a] -> ()
> seqList [] = ()
> seqList (x:xs) = x `pseq` seqList xs
>
> parList :: [a] -> ()
> parList [] = ()
> parList (x:xs) = x `par` parList xs
>
> lazyParList :: Int -> [a] -> [a]
> lazyParList !n xs = go xs (parListN n xs)
> where
> go [] _ys = []
> go (x:xs) [] = x : xs
> go (x:xs) (y:ys) = y `par` (x : go xs ys)
> findImpacts rays objects = parallel $
> map (firstImpact objects) rays
> where
#ifdef STRATEGIES_2
> parallel = parBuffer 200 rwhnf
#else
> parallel = withStrategy (parBuffer 200 rwhnf)
#endif
(*** Functions to generate a list of rays ******
GenerateRays Detail X Y Z
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment