From ca583983716cf83554fc32dc1f4e70d938cfbf00 Mon Sep 17 00:00:00 2001
From: Simon Marlow
Date: Mon, 23 Feb 2009 13:25:13 +0000
Subject: [PATCH] use parBuffer

parallel/ray/Main.lhs  72 +++++++++++++++++++++++++++++++++++++++
1 file changed, 66 insertions(+), 6 deletions()
diff git a/parallel/ray/Main.lhs b/parallel/ray/Main.lhs
index 676fb7c..2ea7bd9 100644
 a/parallel/ray/Main.lhs
+++ b/parallel/ray/Main.lhs
@@ 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 (n1) 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 (n1) ys `sparking` s y
+
+> parListN :: Int > [a] > [a]
+> parListN 0 xs = xs
+> parListN !n [] = []
+> parListN !n (x:xs) = x `par` parListN (n1) 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 (n1) 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

GitLab