author Simon Marlow Mon, 23 Feb 2009 13:25:13 +0000 (13:25 +0000) committer Simon Marlow Mon, 23 Feb 2009 13:25:13 +0000 (13:25 +0000)

index 676fb7c..2ea7bd9 100644 (file)
@@ -1,7 +1,9 @@
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 #-}
> import Control.Parallel
+> import Control.Parallel.Strategies (Strategy, sparking, rwhnf)
> import System.Environment

> main = do
@@ -127,10 +129,6 @@ in_poly_test (p,q,r) (A,B,C) Vs
> earlier NoImpact         i2 =              i2
> earlier i1@(Impact d1 _) i2@(Impact d2 _) = if d1 <= d2 then i1 else i2

-> parList :: [a] -> ()
-> parList [] = ()
-> parList (x:xs) = x `par` parList xs
-
> insert :: (Impact -> Impact -> Impact) -> Impact -> [Impact] -> Impact
> insert f d [] = d
> insert f d (x:xs) = f x (insert f d xs)
@@ -140,9 +138,71 @@ in_poly_test (p,q,r) (A,B,C) Vs
>      where earliest = insert earlier NoImpact

> findImpacts :: [Ray] -> [Object] -> [Impact]
-> findImpacts rays objects = parList r `pseq` r
->     where r = map (firstImpact objects) rays
+> findImpacts rays objects  = parBuffer 200 \$ 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

+> 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
+
+ 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)

(*** Functions to generate a list of rays ******
GenerateRays Detail X Y Z