use parBuffer
authorSimon Marlow <marlowsd@gmail.com>
Mon, 23 Feb 2009 13:25:13 +0000 (13:25 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Mon, 23 Feb 2009 13:25:13 +0000 (13:25 +0000)
parallel/ray/Main.lhs

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