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 (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 -- GitLab