diff --git a/Control/Monad/Par.hs b/Control/Monad/Par.hs --- a/Control/Monad/Par.hs +++ b/Control/Monad/Par.hs @@ -1,303 +1,164 @@ -{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns, - ExistentialQuantification - #-} -{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fwarn-unused-imports #-} --- | This module provides a monad @Par@, for speeding up pure --- computations using parallel processors. It cannot be used for --- speeding up computations that use IO (for that, see --- @Control.Concurrent@). The result of a given @Par@ computation is --- always the same - ie. it is deterministic, but the computation may --- be performed more quickly if there are processors available to --- share the work. --- --- For example, the following program fragment computes the values of --- @(f x)@ and @(g x)@ in parallel, and returns a pair of their results: --- --- > runPar $ do --- > fx <- pval (f x) -- start evaluating (f x) --- > gx <- pval (g x) -- start evaluating (g x) --- > a <- get fx -- wait for fx --- > b <- get gx -- wait for gx --- > return (a,b) -- return results --- --- @Par@ can be used for specifying pure parallel computations in --- which the order of the computation is not known beforehand. --- The programmer specifies how information flows from one --- part of the computation to another, but not the order in which --- computations will be evaluated at runtime. Information flow is --- described using "variables" called @IVar@s, which support 'put' and --- 'get' operations. For example, suppose you have a problem that --- can be expressed as a network with four nodes, where @b@ and @c@ --- require the value of @a@, and @d@ requires the value of @b@ and @c@: --- --- > a --- > / \ --- > b c --- > \ / --- > d --- --- Then you could express this in the @Par@ monad like this: --- --- > runPar $ do --- > [a,b,c,d] <- sequence [new,new,new,new] --- > fork $ do x <- get a; put b (x+1) --- > fork $ do x <- get a; put c (x+2) --- > fork $ do x <- get b; y <- get c; put d (x+y) --- > fork $ do put a (3 :: Int) --- > get d --- --- The result of the above computation is always 9. The 'get' operation --- waits until its input is available; multiple 'put's to the same --- @IVar@ are not allowed, and result in a runtime error. Values --- stored in @IVar@s are usually fully evaluated (although there are --- ways provided to pass lazy values if necessary). --- --- In the above example, @b@ and @c@ will be evaluated in parallel. --- In practice the work involved at each node is too small here to see --- the benefits of parallelism though: typically each node should --- involve much more work. The granularity is completely under your --- control - too small and the overhead of the @Par@ monad will --- outweigh any parallelism benefits, whereas if the nodes are too --- large then there might not be enough parallelism to use all the --- available processors. --- --- Unlike @Control.Parallel@, in @Control.Monad.Par@ parallelism is --- not combined with laziness, so sharing and granulairty are --- completely under the control of the programmer. New units of --- parallel work are only created by @fork@, @par@, and a few other --- combinators. --- --- The implementation is based on a work-stealing scheduler that --- divides the work as evenly as possible betwen the available --- processors at runtime. --- - -module Control.Monad.Par ( - -- * The @Par@ monad - Par, - runPar, - fork, - - -- * Communication: @IVar@s - IVar, - new, newFull, newFull_, - get, - put, put_, - - -- * Operations - pval, - spawn, spawn_, - parMap, parMapM, - parMapReduceRangeThresh, parMapReduceRange, - InclusiveRange(..), - parFor, - - ) where - -import Control.Monad.Par.Internal -import Control.DeepSeq -import Data.Traversable -import Control.Monad as M hiding (mapM, sequence, join) -import Prelude hiding (mapM, sequence, head,tail) +{-| (NOTE: This module reexports a default Par scheduler. A generic + interface can be found in "Control.Monad.Par.Class" and other + schedulers, sometimes with different capabilities, can be found in + "Control.Monad.Par.Scheds".) -import GHC.Conc (numCapabilities) + The @monad-par@ package provides a family of @Par@ monads, for speeding up pure + computations using parallel processors. They cannot be used for + speeding up computations that use IO (for that, see + @Control.Concurrent@). The result of a given @Par@ computation is + always the same - ie. it is deterministic, but the computation may + be performed more quickly if there are processors available to + share the work. --- ----------------------------------------------------------------------------- + For example, the following program fragment computes the values of + @(f x)@ and @(g x)@ in parallel, and returns a pair of their results: --- | forks a computation to happen in parallel. The forked --- computation may exchange values with other computations using --- @IVar@s. -fork :: Par () -> Par () -fork p = Par $ \c -> Fork (runCont p (\_ -> Done)) (c ()) + > runPar $ do + > fx <- spawn (return (f x)) -- start evaluating (f x) + > gx <- spawn (return (g x)) -- start evaluating (g x) + > a <- get fx -- wait for fx + > b <- get gx -- wait for gx + > return (a,b) -- return results --- > both a b >> c == both (a >> c) (b >> c) --- is this useful for anything? --- both :: Par a -> Par a -> Par a --- both a b = Par $ \c -> Fork (runCont a c) (runCont b c) + @Par@ can be used for specifying pure parallel computations in + which the order of the computation is not known beforehand. + The programmer specifies how information flows from one + part of the computation to another, but not the order in which + computations will be evaluated at runtime. Information flow is + described using "variables" called @IVar@s, which support 'put' and + 'get' operations. For example, suppose you have a problem that + can be expressed as a network with four nodes, where @b@ and @c@ + require the value of @a@, and @d@ requires the value of @b@ and @c@: --- ----------------------------------------------------------------------------- --- Derived functions + > a + > / \ + > b c + > \ / + > d --- | Like 'spawn', but the result is only head-strict, not fully-strict. -spawn_ :: Par a -> Par (IVar a) -spawn_ p = do - r <- new - fork (p >>= put_ r) - return r + Then you could express this in the @Par@ monad like this: --- | Like 'fork', but returns a @IVar@ that can be used to query the --- result of the forked computataion. --- --- > spawn p = do --- > r <- new --- > fork (p >>= put r) --- > return r --- -spawn :: NFData a => Par a -> Par (IVar a) -spawn p = do - r <- new - fork (p >>= put r) - return r + > runPar $ do + > [a,b,c,d] <- sequence [new,new,new,new] + > fork $ do x <- get a; put b (x+1) + > fork $ do x <- get a; put c (x+2) + > fork $ do x <- get b; y <- get c; put d (x+y) + > fork $ do put a (3 :: Int) + > get d --- | equivalent to @spawn . return@ -pval :: NFData a => a -> Par (IVar a) -pval a = spawn (return a) + The result of the above computation is always 9. The 'get' operation + waits until its input is available; multiple 'put's to the same + @IVar@ are not allowed, and result in a runtime error. Values + stored in @IVar@s are usually fully evaluated (although there are + ways provided to pass lazy values if necessary). --- ----------------------------------------------------------------------------- --- Parallel maps over Traversable data structures + In the above example, @b@ and @c@ will be evaluated in parallel. + In practice the work involved at each node is too small here to see + the benefits of parallelism though: typically each node should + involve much more work. The granularity is completely under your + control - too small and the overhead of the @Par@ monad will + outweigh any parallelism benefits, whereas if the nodes are too + large then there might not be enough parallelism to use all the + available processors. --- | Applies the given function to each element of a data structure --- in parallel (fully evaluating the results), and returns a new data --- structure containing the results. --- --- > parMap f xs = mapM (pval . f) xs >>= mapM get --- --- @parMap@ is commonly used for lists, where it has this specialised type: --- --- > parMap :: NFData b => (a -> b) -> [a] -> Par [b] --- -parMap :: (Traversable t, NFData b) => (a -> b) -> t a -> Par (t b) -parMap f xs = mapM (pval . f) xs >>= mapM get + Unlike @Control.Parallel@, in @Control.Monad.Par@ parallelism is + not combined with laziness, so sharing and granulairty are + completely under the control of the programmer. New units of + parallel work are only created by @fork@ and a few other + combinators. --- | Like 'parMap', but the function is a @Par@ monad operation. --- --- > parMapM f xs = mapM (spawn . f) xs >>= mapM get --- -parMapM :: (Traversable t, NFData b) => (a -> Par b) -> t a -> Par (t b) -parMapM f xs = mapM (spawn . f) xs >>= mapM get + The implementation is based on a work-stealing scheduler that + divides the work as evenly as possible between the available + processors at runtime. -{-# SPECIALISE parMap :: (NFData b) => (a -> b) -> [a] -> Par [b] #-} -{-# SPECIALISE parMapM :: (NFData b) => (a -> Par b) -> [a] -> Par [b] #-} + For more information on the programming model, please see these sources: + * The wiki/tutorial () + * The original paper () + * Tutorial slides () + * Other slides: , + --- TODO: Perhaps should introduce a class for the "splittable range" concept. -data InclusiveRange = InclusiveRange Int Int + -} --- | Computes a binary map\/reduce over a finite range. The range is --- recursively split into two, the result for each half is computed in --- parallel, and then the two results are combined. When the range --- reaches the threshold size, the remaining elements of the range are --- computed sequentially. --- --- For example, the following is a parallel implementation of --- --- > foldl (+) 0 (map (^2) [1..10^6]) --- --- > parMapReduceRangeThresh 100 (InclusiveRange 1 (10^6)) --- > (\x -> return (x^2)) --- > (\x y -> return (x+y)) --- > 0 --- -parMapReduceRangeThresh - :: NFData a - => Int -- ^ threshold - -> InclusiveRange -- ^ range over which to calculate - -> (Int -> Par a) -- ^ compute one result - -> (a -> a -> Par a) -- ^ combine two results (associative) - -> a -- ^ initial result - -> Par a +module Control.Monad.Par + ( + -- * The Par Monad + Par, + runPar, -parMapReduceRangeThresh threshold (InclusiveRange min max) fn binop init - = loop min max - where - loop min max - | max - min <= threshold = - let mapred a b = do x <- fn b; - result <- a `binop` x - return result - in foldM mapred init [min..max] + fork, + -- | forks a computation to happen in parallel. The forked + -- computation may exchange values with other computations using + -- @IVar@s. - | otherwise = do - let mid = min + ((max - min) `quot` 2) - rght <- spawn $ loop (mid+1) max - l <- loop min mid - r <- get rght - l `binop` r + -- * Communication: IVars + IVar, --- How many tasks per process should we aim for. Higher numbers --- improve load balance but put more pressure on the scheduler. -auto_partition_factor :: Int -auto_partition_factor = 4 + new, + -- | creates a new @IVar@ --- | \"Auto-partitioning\" version of 'parMapReduceRangeThresh' that chooses the threshold based on --- the size of the range and the number of processors.. -parMapReduceRange :: NFData a => InclusiveRange -> (Int -> Par a) -> (a -> a -> Par a) -> a -> Par a -parMapReduceRange (InclusiveRange start end) fn binop init = - loop (length segs) segs - where - segs = splitInclusiveRange (auto_partition_factor * numCapabilities) (start,end) - loop 1 [(st,en)] = - let mapred a b = do x <- fn b; - result <- a `binop` x - return result - in foldM mapred init [st..en] - loop n segs = - let half = n `quot` 2 - (left,right) = splitAt half segs in - do l <- spawn$ loop half left - r <- loop (n-half) right - l' <- get l - l' `binop` r + newFull, + -- | creates a new @IVar@ that contains a value + newFull_, + -- | creates a new @IVar@ that contains a value (head-strict only) --- TODO: A version that works for any splittable input domain. In this case --- the "threshold" is a predicate on inputs. --- parMapReduceRangeGeneric :: (inp -> Bool) -> (inp -> Maybe (inp,inp)) -> inp -> + get, + -- | read the value in an @IVar@. 'get' can only return when the + -- value has been written by a prior or parallel @put@ to the same + -- @IVar@. + put, + -- | put a value into a @IVar@. Multiple 'put's to the same @IVar@ + -- are not allowed, and result in a runtime error. + -- + -- 'put' fully evaluates its argument, which therefore must be an + -- instance of 'NFData'. The idea is that this forces the work to + -- happen when we expect it, rather than being passed to the consumer + -- of the @IVar@ and performed later, which often results in less + -- parallelism than expected. + -- + -- Sometimes partial strictness is more appropriate: see 'put_'. + -- --- Experimental: + put_, + -- | like 'put', but only head-strict rather than fully-strict. --- | Parallel for-loop over an inclusive range. Semantically equivalent --- to --- --- > parFor (InclusiveRange n m) f = forM_ [n..m] f --- --- except that the implementation will split the work into an --- unspecified number of subtasks in an attempt to gain parallelism. --- The exact number of subtasks is chosen at runtime, and is probably --- a small multiple of the available number of processors. --- --- Strictly speaking the semantics of 'parFor' depends on the --- number of processors, and its behaviour is therefore not --- deterministic. However, a good rule of thumb is to not have any --- interdependencies between the elements; if this rule is followed --- then @parFor@ has deterministic semantics. One easy way to follow --- this rule is to only use 'put' or 'put_' in @f@, never 'get'. + -- * Operations + spawn, + -- | Like 'fork', but returns a @IVar@ that can be used to query the + -- result of the forked computataion. Therefore @spawn@ provides /futures/ or /promises/. + -- + -- > spawn p = do + -- > r <- new + -- > fork (p >>= put r) + -- > return r + -- -parFor :: InclusiveRange -> (Int -> Par ()) -> Par () -parFor (InclusiveRange start end) body = - do - let run (x,y) = for_ x (y+1) body - range_segments = splitInclusiveRange (4*numCapabilities) (start,end) + spawn_, + -- | Like 'spawn', but the result is only head-strict, not fully-strict. - vars <- M.forM range_segments (\ pr -> spawn_ (run pr)) - M.mapM_ get vars - return () + spawnP, + -- | Spawn a pure (rather than monadic) computation. Fully-strict. + -- + -- > spawnP = spawn . return -splitInclusiveRange :: Int -> (Int, Int) -> [(Int, Int)] -splitInclusiveRange pieces (start,end) = - map largepiece [0..remain-1] ++ - map smallpiece [remain..pieces-1] - where - len = end - start + 1 -- inclusive [start,end] - (portion, remain) = len `quotRem` pieces - largepiece i = - let offset = start + (i * (portion + 1)) - in (offset, offset + portion) - smallpiece i = - let offset = start + (i * portion) + remain - in (offset, offset + portion - 1) + module Control.Monad.Par.Combinator, + -- | This module also reexports the Combinator library for backwards + -- compatibility with version 0.1. --- My own forM for numeric ranges (not requiring deforestation optimizations). --- Inclusive start, exclusive end. -{-# INLINE for_ #-} -for_ :: Monad m => Int -> Int -> (Int -> m ()) -> m () -for_ start end _fn | start > end = error "for_: start is greater than end" -for_ start end fn = loop start - where - loop !i | i == end = return () - | otherwise = do fn i; loop (i+1) + NFData() + -- | /(0.3)/ Reexport 'NFData' for fully-strict operators. + ) +where +-- (0.3) Export 'Par' operators via the generic interface. +import Control.Monad.Par.Class +import Control.Monad.Par.Scheds.Trace hiding (spawn_, spawn, spawnP, put, get, new, newFull, fork, put_, newFull_) +-- import Control.Monad.Par.Scheds.Direct +import Control.Monad.Par.Combinator diff --git a/Control/Monad/Par/AList.hs b/Control/Monad/Par/AList.hs deleted file mode 100644 --- a/Control/Monad/Par/AList.hs +++ /dev/null @@ -1,190 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fwarn-unused-imports #-} - --- | This module defines the 'AList' type, a list that supports --- constant-time append, and is therefore ideal for building the --- result of tree-shaped parallel computations. - -module Control.Monad.Par.AList - ( - -- * The 'AList' type and operations - AList(..), - empty, singleton, cons, head, tail, length, null, append, - toList, fromList, - -- * Operations to build 'AList's in the 'Par' monad - parBuildThresh, parBuildThreshM, - parBuild, parBuildM, - ) -where - - -import Control.DeepSeq -import Prelude hiding (length,head,tail,null) -import qualified Prelude as P -import Control.Monad.Par - --- | List that support constant-time append (sometimes called --- join-lists). -data AList a = ANil | ASing a | Append (AList a) (AList a) | AList [a] - -instance NFData a => NFData (AList a) where - rnf ANil = () - rnf (ASing a) = rnf a - rnf (Append l r) = rnf l `seq` rnf r - rnf (AList l) = rnf l - -#if 0 - data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) - instance Traversable Tree - traverse f Empty = pure Empty - traverse f (Leaf x) = Leaf <$> f x - traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r -#endif - - --- TODO: Finish me: --- instance F.Foldable AList where --- foldr fn init al = --- case al of --- ANil -> - --- instance Functor AList where --- fmap = undefined - --- -- Walk the data structure without introducing any additional data-parallelism. --- instance Traversable AList where --- traverse f al = --- case al of --- ANil -> pure ANil --- ASing x -> ASing <$> f x - -instance Show a => Show (AList a) where - show al = "fromList "++ show (toList al) - --- | /O(1)/ Append two 'AList's -append :: AList a -> AList a -> AList a -append ANil r = r -append l ANil = l -append l r = Append l r - -{-# INLINE empty #-} -{-# INLINE singleton #-} -{-# INLINE fromList #-} - --- | /O(1)/ an empty 'AList' -empty :: AList a -empty = ANil - --- | /O(1)/ a singleton 'AList' -singleton :: a -> AList a -singleton = ASing - --- | /O(1)/ convert an ordinary list to an 'AList' -fromList :: [a] -> AList a -fromList = AList - --- | /O(1)/ prepend an element -cons :: a -> AList a -> AList a -cons x ANil = ASing x -cons x al = Append (ASing x) al --- If we tracked length perhaps this could make an effort at balance. - --- | /O(n)/ take the head element of an 'AList' --- --- NB. linear-time, because the list might look like this: --- --- > (((... `append` a) `append` b) `append` c) --- -head :: AList a -> a -head al = - case loop al of - Just x -> x - Nothing -> error "cannot take head of an empty AList" - where - -- Alas there are an infinite number of representations for null: - loop al = - case al of - Append l r -> case loop l of - x@(Just _) -> x - Nothing -> loop r - ASing x -> Just x - AList (h:_) -> Just h - AList [] -> Nothing - ANil -> Nothing - --- | /O(n)/ take the tail element of an 'AList' -tail :: AList a -> AList a -tail al = - case loop al of - Just x -> x - Nothing -> error "cannot take tail of an empty AList" - where - loop al = - case al of - Append l r -> case loop l of - (Just x) -> Just (Append x r) - Nothing -> loop r - - ASing _ -> Just ANil - AList (_:t) -> Just (AList t) - AList [] -> Nothing - ANil -> Nothing - --- | /O(n)/ find the length of an 'AList' -length :: AList a -> Int -length ANil = 0 -length (ASing _) = 1 -length (Append l r) = length l + length r -length (AList l) = P.length l - - --- | /O(n)/ returns 'True' if the 'AList' is empty -null :: AList a -> Bool -null = (==0) . length - --- | /O(n)/ converts an 'AList' to an ordinary list -toList :: AList a -> [a] -toList a = go a [] - where go ANil rest = rest - go (ASing a) rest = a : rest - go (Append l r) rest = go l $! go r rest - go (AList xs) rest = xs ++ rest - --- TODO: Provide a strategy for @par@-based maps: - - -appendM :: AList a -> AList a -> Par (AList a) -appendM x y = return (append x y) - --- | Build a balanced 'AList' in parallel, constructing each element as a --- function of its index. The threshold argument provides control --- over the degree of parallelism. It indicates under what number --- of elements the build process should switch from parallel to --- serial. -parBuildThresh :: NFData a => Int -> InclusiveRange -> (Int -> a) -> Par (AList a) -parBuildThresh threshold range fn = - parMapReduceRangeThresh threshold range - (return . singleton . fn) appendM empty - --- | Variant of 'parBuildThresh' in which the element-construction function is itself a 'Par' computation. -parBuildThreshM :: NFData a => Int -> InclusiveRange -> (Int -> Par a) -> Par (AList a) -parBuildThreshM threshold range fn = - parMapReduceRangeThresh threshold range - ((fmap singleton) . fn) appendM empty - --- | \"Auto-partitioning\" version of 'parBuildThresh' that chooses the threshold based on --- the size of the range and the number of processors.. -parBuild :: NFData a => InclusiveRange -> (Int -> a) -> Par (AList a) -parBuild range fn = - parMapReduceRange range (return . singleton . fn) appendM empty - --- | like 'parBuild', but the construction function is monadic -parBuildM :: NFData a => InclusiveRange -> (Int -> Par a) -> Par (AList a) -parBuildM range fn = - parMapReduceRange range ((fmap singleton) . fn) appendM empty - - --- | A parMap over an AList can result in more balanced parallelism than --- the default parMap over Traversable data types. --- parMap :: NFData b => (a -> b) -> AList a -> Par (AList b) - diff --git a/Control/Monad/Par/IList.hs b/Control/Monad/Par/IList.hs deleted file mode 100644 --- a/Control/Monad/Par/IList.hs +++ /dev/null @@ -1,28 +0,0 @@ - --- ILists: lists whose cdr fields are IVars, filled in asynchronously --- via Par computation. - --- This module mostly exists as a datatype to use in building other, --- higher-level abstractions. (See OpenList and Stream.) - -module Control.Monad.Par.IList - ( - IList(..) - ) -where - -import Control.Monad.Par -import Control.DeepSeq - --- | An 'IList' is the equivalent of a lazy list in the 'Par' monad. --- The tail of the list is an 'IVar', which allows the list to be --- produced and consumed in parallel. -data IList a = Null | Cons { hd :: a, tl :: IVar (IList a) } - --- | To fully evaluate an 'IList' means to evaluate both the head --- and tail. This does not evaluate the entire spine of the list --- of course, because the tail is an 'IVar'. -instance NFData a => NFData (IList a) where --- rnf Null = r0 - rnf Null = () - rnf (Cons a b) = rnf a `seq` rnf b diff --git a/Control/Monad/Par/Internal.hs b/Control/Monad/Par/Internal.hs deleted file mode 100644 --- a/Control/Monad/Par/Internal.hs +++ /dev/null @@ -1,292 +0,0 @@ -{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns, - ExistentialQuantification, CPP - #-} -{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} - --- | This module exposes the internals of the @Par@ monad so that you --- can build your own scheduler or other extensions. Do not use this --- module for purposes other than extending the @Par@ monad with new --- functionality. - -module Control.Monad.Par.Internal ( - Trace(..), Sched(..), Par(..), - IVar(..), IVarContents(..), - sched, - runPar, runParAsync, runParAsyncHelper, - new, newFull, newFull_, get, put_, put, - pollIVar, yield, - ) where - - -import Control.Monad as M hiding (mapM, sequence, join) -import Prelude hiding (mapM, sequence, head,tail) -import Data.IORef -import System.IO.Unsafe -import Control.Concurrent hiding (yield) -import GHC.Conc hiding (yield) -import Control.DeepSeq -import Control.Applicative --- import Text.Printf - --- --------------------------------------------------------------------------- - -data Trace = forall a . Get (IVar a) (a -> Trace) - | forall a . Put (IVar a) a Trace - | forall a . New (IVarContents a) (IVar a -> Trace) - | Fork Trace Trace - | Done - | Yield Trace - --- | The main scheduler loop. -sched :: Bool -> Sched -> Trace -> IO () -sched _doSync queue t = loop t - where - loop t = case t of - New a f -> do - r <- newIORef a - loop (f (IVar r)) - Get (IVar v) c -> do - e <- readIORef v - case e of - Full a -> loop (c a) - _other -> do - r <- atomicModifyIORef v $ \e -> case e of - Empty -> (Blocked [c], reschedule queue) - Full a -> (Full a, loop (c a)) - Blocked cs -> (Blocked (c:cs), reschedule queue) - r - Put (IVar v) a t -> do - cs <- atomicModifyIORef v $ \e -> case e of - Empty -> (Full a, []) - Full _ -> error "multiple put" - Blocked cs -> (Full a, cs) - mapM_ (pushWork queue. ($a)) cs - loop t - Fork child parent -> do - pushWork queue child - loop parent - Done -> - if _doSync - then reschedule queue --- We could fork an extra thread here to keep numCapabilities workers --- even when the main thread returns to the runPar caller... - else do putStrLn " [par] Forking replacement thread..\n" - forkIO (reschedule queue); return () --- But even if we don't we are not orphaning any work in this --- threads work-queue because it can be stolen by other threads. --- else return () - - Yield parent -> do - -- Go to the end of the worklist: - let Sched { workpool } = queue - -- TODO: Perhaps consider Data.Seq here. - -- This would also be a chance to steal and work from opposite ends of the queue. - atomicModifyIORef workpool $ \ts -> (ts++[parent], ()) - reschedule queue - --- | Process the next item on the work queue or, failing that, go into --- work-stealing mode. -reschedule :: Sched -> IO () -reschedule queue@Sched{ workpool } = do - e <- atomicModifyIORef workpool $ \ts -> - case ts of - [] -> ([], Nothing) - (t:ts') -> (ts', Just t) - case e of - Nothing -> steal queue - Just t -> sched True queue t - - --- RRN: Note -- NOT doing random work stealing breaks the traditional --- Cilk time/space bounds if one is running strictly nested (series --- parallel) programs. - --- | Attempt to steal work or, failing that, give up and go idle. -steal :: Sched -> IO () -steal q@Sched{ idle, scheds, no=my_no } = do - -- printf "cpu %d stealing\n" my_no - go scheds - where - go [] = do m <- newEmptyMVar - r <- atomicModifyIORef idle $ \is -> (m:is, is) - if length r == numCapabilities - 1 - then do - -- printf "cpu %d initiating shutdown\n" my_no - mapM_ (\m -> putMVar m True) r - else do - done <- takeMVar m - if done - then do - -- printf "cpu %d shutting down\n" my_no - return () - else do - -- printf "cpu %d woken up\n" my_no - go scheds - go (x:xs) - | no x == my_no = go xs - | otherwise = do - r <- atomicModifyIORef (workpool x) $ \ ts -> - case ts of - [] -> ([], Nothing) - (x:xs) -> (xs, Just x) - case r of - Just t -> do - -- printf "cpu %d got work from cpu %d\n" my_no (no x) - sched True q t - Nothing -> go xs - --- | If any worker is idle, wake one up and give it work to do. -pushWork :: Sched -> Trace -> IO () -pushWork Sched { workpool, idle } t = do - atomicModifyIORef workpool $ \ts -> (t:ts, ()) - idles <- readIORef idle - when (not (null idles)) $ do - r <- atomicModifyIORef idle (\is -> case is of - [] -> ([], return ()) - (i:is) -> (is, putMVar i False)) - r -- wake one up - -data Sched = Sched - { no :: {-# UNPACK #-} !Int, - workpool :: IORef [Trace], - idle :: IORef [MVar Bool], - scheds :: [Sched] -- Global list of all per-thread workers. - } --- deriving Show - -newtype Par a = Par { - runCont :: (a -> Trace) -> Trace -} - -instance Functor Par where - fmap f m = Par $ \c -> runCont m (c . f) - -instance Monad Par where - return a = Par ($ a) - m >>= k = Par $ \c -> runCont m $ \a -> runCont (k a) c - -instance Applicative Par where - (<*>) = ap - pure = return - -newtype IVar a = IVar (IORef (IVarContents a)) --- data IVar a = IVar (IORef (IVarContents a)) - --- Forcing evaluation of a IVar is fruitless. -instance NFData (IVar a) where - rnf _ = () - - --- From outside the Par computation we can peek. But this is nondeterministic. -pollIVar :: IVar a -> IO (Maybe a) -pollIVar (IVar ref) = - do contents <- readIORef ref - case contents of - Full x -> return (Just x) - _ -> return (Nothing) - - -data IVarContents a = Full a | Empty | Blocked [a -> Trace] - - -{-# INLINE runPar_internal #-} -runPar_internal :: Bool -> Par a -> a -runPar_internal _doSync x = unsafePerformIO $ do - workpools <- replicateM numCapabilities $ newIORef [] - idle <- newIORef [] - let states = [ Sched { no=x, workpool=wp, idle, scheds=states } - | (x,wp) <- zip [0..] workpools ] - -#if __GLASGOW_HASKELL__ >= 701 /* 20110301 */ - -- - -- We create a thread on each CPU with forkOnIO. The CPU on which - -- the current thread is running will host the main thread; the - -- other CPUs will host worker threads. - -- - -- Note: GHC 7.1.20110301 is required for this to work, because that - -- is when threadCapability was added. - -- - (main_cpu, _) <- threadCapability =<< myThreadId -#else - -- - -- Lacking threadCapability, we always pick CPU #0 to run the main - -- thread. If the current thread is not running on CPU #0, this - -- will require some data to be shipped over the memory bus, and - -- hence will be slightly slower than the version above. - -- - let main_cpu = 0 -#endif - - m <- newEmptyMVar - forM_ (zip [0..] states) $ \(cpu,state) -> - forkOnIO cpu $ - if (cpu /= main_cpu) - then reschedule state - else do - rref <- newIORef Empty - sched _doSync state $ runCont (x >>= put_ (IVar rref)) (const Done) - readIORef rref >>= putMVar m - - r <- takeMVar m - case r of - Full a -> return a - _ -> error "no result" - - -runPar :: Par a -> a -runPar = runPar_internal True - --- | An asynchronous version in which the main thread of control in a --- Par computation can return while forked computations still run in --- the background. -runParAsync :: Par a -> a -runParAsync = runPar_internal False - --- | An alternative version in which the consumer of the result has --- | the option to "help" run the Par computation if results it is --- | interested in are not ready yet. -runParAsyncHelper :: Par a -> (a, IO ()) -runParAsyncHelper = undefined -- TODO: Finish Me. - --- ----------------------------------------------------------------------------- - --- | creates a new @IVar@ -new :: Par (IVar a) -new = Par $ New Empty - --- | creates a new @IVar@ that contains a value -newFull :: NFData a => a -> Par (IVar a) -newFull x = deepseq x (Par $ New (Full x)) - --- | creates a new @IVar@ that contains a value (head-strict only) -newFull_ :: a -> Par (IVar a) -newFull_ !x = Par $ New (Full x) - --- | read the value in a @IVar@. The 'get' can only return when the --- value has been written by a prior or parallel @put@ to the same --- @IVar@. -get :: IVar a -> Par a -get v = Par $ \c -> Get v c - --- | like 'put', but only head-strict rather than fully-strict. -put_ :: IVar a -> a -> Par () -put_ v !a = Par $ \c -> Put v a (c ()) - --- | put a value into a @IVar@. Multiple 'put's to the same @IVar@ --- are not allowed, and result in a runtime error. --- --- 'put' fully evaluates its argument, which therefore must be an --- instance of 'NFData'. The idea is that this forces the work to --- happen when we expect it, rather than being passed to the consumer --- of the @IVar@ and performed later, which often results in less --- parallelism than expected. --- --- Sometimes partial strictness is more appropriate: see 'put_'. --- -put :: NFData a => IVar a -> a -> Par () -put v a = deepseq a (Par $ \c -> Put v a (c ())) - --- | Allows other parallel computations to progress. (should not be --- necessary in most cases). -yield :: Par () -yield = Par $ \c -> Yield (c ()) diff --git a/Control/Monad/Par/OpenList.hs b/Control/Monad/Par/OpenList.hs deleted file mode 100644 --- a/Control/Monad/Par/OpenList.hs +++ /dev/null @@ -1,454 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns #-} -{-# OPTIONS_GHC -fwarn-unused-imports #-} --- -Wall -fno-warn-name-shadowing - --- | Some experimental support for 'OpenList's, which are streams in --- the 'Par' monad that support constant-time append. - -module Control.Monad.Par.OpenList ---module Main - ( - OpenList(), - empty, singleton, cons, head, tail, length, - close, join, - toList, fromList, toLazyList, - parMapM, parBuild, parBuildM, - openlist_tests, - chaintest, - async_test, lazy_chaintest --- , main - - , IList(..), newCell - ) -where - -import Control.Monad hiding (join) -import Control.DeepSeq -import Control.Concurrent.MVar -import Control.Monad.Par hiding (parMapM) -import Control.Monad.Par.IList -import Control.Monad.Par.Internal - -import Prelude hiding (length,head,tail,drop,take,null) -import qualified Prelude as P --- import System.IO.Unsafe -import GHC.IO (unsafePerformIO, unsafeDupablePerformIO) -import Test.HUnit -import Debug.Trace - --- ----------------------------------------------------------------------------- --- Open Lists -- IVars at the tail. --- --- These have some of the advantages of imperative lists, such as --- constant time appending, while retaining determinism and having --- O(1) access to the head of the list unlike tree-shaped lists --- (e.g. append-based rather than cons-based). - - --- An OpenList must be handled functionally. Extending the list as --- an effect will not change its tail pointer. -data OpenList a = OpenList (IList a) (IList a) - --- This is likewise a pretty meaningless NFData instance: -instance NFData a => NFData (OpenList a) where - rnf (OpenList hp tp) = rnf hp `seq` rnf tp - - --- | An empty open list. Supports further extension. -empty :: OpenList a -empty = OpenList Null Null - -null :: OpenList a -> Bool -null (OpenList Null Null) = True -null _ = False - --- | A single element open list. -singleton :: a -> Par (OpenList a) -singleton x = - do pv <- new - let cell = Cons x pv - return (OpenList cell cell) - --- TODO/FIXME: Need to decide whether there should be closed and open empty lists!! - --- | Terminate a non-empty open list so that it cannot be extended further. -close :: NFData a => OpenList a -> Par (OpenList a) -close orig@(OpenList Null _) = return orig -close orig@(OpenList _ tp) = do put (tl tp) Null; return orig - - --- This version ignores the tail pointer and seeks out the end of the --- list (at the present time). --- unsafeClose :: NFData a => OpenList a -> Par (OpenList a) --- unsafeClose orig@(OpenList Null _) = return orig - - - --- | Destructive append operation. -join :: NFData a => OpenList a -> OpenList a -> Par (OpenList a) -join (OpenList Null _) right = return right -join left (OpenList Null _) = return left -join (OpenList hp1 tp1) (OpenList hp2 tp2) = - do put (tl tp1) hp2 - return (OpenList hp1 tp2) - --- | Head of an OpenList. -head :: OpenList a -> a -head (OpenList Null _) = error "cannot take head of null OpenList" -head (OpenList hp _) = hd hp - -headCell (OpenList hp _) = OpenList hp hp -lastCell (OpenList _ tp) = OpenList tp tp - --- | Tail of an OpenList. Beware, if the list contains only one --- element (e.g. the result of tail will be null), it must be CLOSED --- for tail to work. -tail :: OpenList a -> Par (OpenList a) --- NOTE: We could fix this limitation by adding a length field to the OpenList. -tail (OpenList Null _) = error "cannot take tail of null OpenList" -tail (OpenList hp tp) = - do nxt <- get (tl hp) - case nxt of - Null -> return empty - _ -> return (OpenList nxt tp) - - -drop :: NFData a => Int -> OpenList a -> Par (OpenList a) -drop 0 ls = return ls -drop n ls = do tl <- tail ls - drop (n-1) tl - --- This copies a prefix and makes it open once again irrespective of --- whether the input list is open or closed. -take :: NFData a => Int -> OpenList a -> Par (OpenList a) -take 0 ls = return empty -take n ls = do tl <- tail ls - rest <- take (n-1) tl - cons (head ls) rest - --- Take the length of a closed OpenList. --- length :: OpenList a -> Par Int -length (OpenList Null _) = return 0 --- length (OpenList (Cons a _) (Cons b _)) | a == b = return 1 -length ls = do t <- tail ls - len <- length t - return (len+1) - --- | Add an element to the front of an OpenList. Works irrespective --- | of whether the input is closed. -cons :: NFData a => a -> OpenList a -> Par (OpenList a) --- Careful, consing should not close the openlist: -cons car (OpenList Null _) = singleton car -cons car (OpenList hp tp) = - do cdr <- newFull_ hp - return (OpenList (Cons car cdr) tp) - -newCell x = do pv <-new; return (Cons x pv) - --- | Convert a list to an OpenList, open to extension at the tail. -fromList :: NFData a => [a] -> Par (OpenList a) -fromList [] = return empty -fromList (h:t) = - -- This function is inefficient and could be replaced with an additional IList data constructor. - do head <- newCell h - rest <- loop head t - return (OpenList head rest) - where - loop last [] = return last - loop last (h:t) = - do cell <- newCell h - put (tl last) cell - loop cell t - --- | Convert a CLOSED OpenList to a list. -toList :: NFData a => (OpenList a) -> Par [a] --- Note: presently not tail-recursive: -toList (OpenList hp _) = loop hp - where - loop Null = return [] - loop (Cons head pv) = - do - rest <- get pv - converted <- loop rest - return (head : converted) - --- Strict map over closed lists. --- --- parMap for OpenLists does not support a nice divide-and-conquer. --- (Well, it would support the appending if we were willing to scan ahead to find the length.) --- OpenLists are not Traversable... so we can't just use Par.parMap. --- --- TODO: Perhaps this should use a strategy for each element: --- parMapM :: NFData b => (a -> Par b) -> OpenList a -> Par (OpenList b) -parMapM _ (OpenList Null _) = return empty --- parMapM fn (OpenList (Cons a _) (Cons b _)) | a == b = fn a >>= singleton -parMapM fn ls = - do h <- spawn (fn (head ls)) - t <- tail ls - h' <- get h - t2 <- parMapM fn t - cons h' t2 - --- maybe the following too? --- parMapM_ :: (a -> Par ()) -> OpenList a -> Par () - --- | Build an OpenList with a divide-and-conquer parallel strategy. -parBuild :: NFData a => InclusiveRange -> (Int -> a) -> Par (OpenList a) -parBuild range fn = - parMapReduceRange range (singleton . fn) join empty - --- | Build an OpenList with a divide-and-conquer parallel strategy, --- allowing nested parallelism in the per-element computation. -parBuildM :: NFData a => InclusiveRange -> (Int -> Par a) -> Par (OpenList a) -parBuildM range fn = - parMapReduceRange range ((>>= singleton) . fn) join empty - - --- | OpenLists can only be printed properly in the Par monad. @show@ --- on an open list will only give a hint -- what the first and last --- elements of the openlist are. -instance Show a => Show (OpenList a) where - show (OpenList Null _) = "OpenList []" - show (OpenList (Cons fst _) (Cons lst _)) = - "OpenList ["++show fst++".."++ show lst ++"]" - - - -debugshow (OpenList (Cons h1 _) (Cons h2 _)) = "Cons|Cons|eq/"++show(h1==h2) -debugshow (OpenList Null Null) = "Null|Null" -debugshow (OpenList Null (Cons _ _)) = error$ "invalid Null|Cons openlist" -debugshow (OpenList (Cons _ _) Null) = error$ "invalid Cons|Null openlist" - --- Check the length of an openlist from head pointer to tail pointer --- (not including anything present beyond the tail pointer). --- WARNING: ASSUMES UNIQUE ELEMENTS: -debuglength :: Eq a => OpenList a -> Par Int -debuglength (OpenList Null Null) = return 0 -debuglength orig@(OpenList (Cons hp1 tp1) (Cons hp2 tp2)) - | hp1 == hp2 = return 1 - | otherwise = do rest <- tail orig - sum <- debuglength rest - return (1 + sum) - --- ----------------------------------------------------------------------------- --- Synchronization using native Haskell IVars (e.g. MVars). - --- The MList datatype is internal to the module. --- These MVars are only written once: -data MList a = MNull | MCons (a, MVar (MList a)) - -_unsafe_io :: IO a -> Par a -_unsafe_io io = let x = unsafePerformIO io in - x `seq` return x - -_unsafe_dupable :: IO a -> Par a -_unsafe_dupable io = - let x = unsafeDupablePerformIO io in - x `seq` return x - --- Return a lazy list: -mListToList :: MList a -> [a] -mListToList MNull = [] -mListToList (MCons(hd,tl)) = - let rest = unsafeDupablePerformIO$ - do tl' <- readMVar tl - return (mListToList tl') - in (hd : rest) - -iListToMList :: IList a -> Par (MList a) -iListToMList Null = return MNull -iListToMList il = - do mv <- _unsafe_dupable newEmptyMVar - fork $ do t <- get (tl il) - r <- iListToMList t - _unsafe_io$ putMVar mv r - return (MCons (hd il, mv)) - --- | Asynchronously convert an OpenList to a lazy list. Returns immediately. -toLazyList :: OpenList a -> Par [a] -toLazyList (OpenList head _) = iListToMList head >>= return . mListToList --- toLazyList ol = toMList ol >>= return . mListToList - - - - - - --- ----------------------------------------------------------------------------- --- Testing - -test_ol0 = runPar (cons 'a' empty >>= cons 'b' >>= close >>= tail >>= tail >>= length) - -test_ol1 :: Int -test_ol1 = runPar$ do l :: OpenList Int <- join empty empty - length l - -test_ol2 :: String -test_ol2 = show$ runPar$ do - ls1 <- fromList [10,11,12] - ls2 <- singleton (5::Int) - join ls1 ls2 - -test_ol3 :: [Int] -test_ol3 = runPar$ do ol :: OpenList Int <- fromList [1..10] - close ol - toList ol - -test_ol4 :: Int -test_ol4 = runPar$ do ol <- fromList [1..10] - t1 <- tail ol - t2 <- tail t1 - return (head t2) - -test_ol5 :: Int -test_ol5 = runPar$ fromList ([1..10] :: [Int]) >>= close >>= length - -test_ol6 :: [Int] -test_ol6 = runPar$ do - l1 <- fromList [1..10] - close l1 - l2 <- parMapM (return . (+ 1)) l1 - close l2 - toList l2 - - -test_ol7 :: [Int] -test_ol7 = runPar$ do - a <- singleton 1 - b <- singleton 2 - join a b - close b - toLazyList a - -test_ol8 :: [Int] -test_ol8 = runPar$ do - a <- singleton 1 - b <- singleton 2 - c <- singleton 3 - d <- singleton 4 - join c d - join a b - join b c - close d - toLazyList a - -test_ll :: [Int] -test_ll = runPar$ - do l <- fromList [1..1000] - close l - toLazyList l - -chaintest :: Int -> Par (IList Int) -chaintest 0 = error "must have chain length >= 1" -chaintest len = loop 0 len - where - loop i 1 = do tl <- if i == len-1 - then newFull_ Null - else new - when (i == len-1) (print_$ " == GOT END: "++show i) - return (Cons i tl) - loop i n = - do let half = n `quot` 2 - ifst <- spawn_$ loop i half - fork $ do - snd <- loop (i+half) half - fst <- get ifst - lastfst <- dropIList (half-1) fst - put (tl lastfst) snd - return () - get ifst - -dropIList :: NFData a => Int -> IList a -> Par (IList a) -dropIList 0 ls = return ls -dropIList n ls = do rest <- get (tl ls) - dropIList (n-1) rest - --- lazy_chaintest i = chaintest i >>= toLazyList -lazy_chaintest :: Int -> Par [Int] -lazy_chaintest i = do il <- chaintest i - ml <- iListToMList il - return (mListToList ml) - --- If we create a large, lazy chain, taking just the head should be quick. -async_test = - do putStrLn "BeginTest" --- let lazy = runParAsync$ lazy_chaintest 1048576 --- let lazy = runParAsync$ lazy_chaintest 32768 - let lazy = runParAsync$ lazy_chaintest 1024 --- let lazy = runPar$ lazy_chaintest 1024 - putStrLn$ "Resulting list "++ show lazy - putStrLn$ "Got head: "++ show (P.take 3 lazy) - putStrLn "EndTest" - --------------------------------------------------------------------------------- - -print_ msg = trace msg $ return () - -dbg0 = debugshow$ runPar$ singleton 'a' >>= close - --- This one is an error: -err1 = debugshow$ runPar$ singleton 'a' >>= tail >>= close --- But this will work: -dbg1 = debugshow$ runPar$ fromList "ab" >>= tail >>= close - -dbg2 = debugshow$ runPar$ singleton 'a' >>= close >>= tail - --- This is invalid: -err2 = debugshow$ runPar$ singleton 'a' >>= tail - --- TODO: HUnit These. -openlist_tests :: Test -openlist_tests = - TestList - [ - -- First a few small, unnamed tests: - 0 ~=? runPar (length (empty :: OpenList Int)), - "a" ~=? runPar (singleton 'a' >>= close >>= toList), - 1 ~=? runPar (singleton 'a' >>= close >>= length), - 1 ~=? runPar (cons 'b' empty >>= close >>= length), - - TestLabel "singleton, close" $ "Cons|Cons|eq/True" ~=? dbg0, - TestLabel "tail then close - SKETCHY" $ "Cons|Cons|eq/True" ~=? dbg1, - TestLabel "close then tail" $ "Null|Null" ~=? dbg2, --- TestLabel "tail no close" $ "" ~=? dbg3, - - TestLabel "tail of singleton" $ - 0 ~=? runPar (singleton 'a' >>= close >>= tail >>= length), - TestLabel "tail tail of cons cons" $ - 0 ~=? test_ol0, - - TestLabel "join of two empty's still length zero" $ - 0 ~=? test_ol1, - TestLabel "test show instance" $ - "OpenList [10..5]" ~=? test_ol2, - - TestLabel "toList" $ - [1..10] ~=? test_ol3, - - TestLabel "head . tail . tail" $ - 3 ~=? test_ol4, - - TestLabel "length . fromList" $ - 10 ~=? test_ol5, - - TestLabel "test parMap" $ - [2..11] ~=? test_ol6, - - TestLabel "test 7" $ - [1,2] ~=? test_ol7, - - TestLabel "test 8" $ - [1..4] ~=? test_ol8, - - TestLabel "test lazy list conversion" $ - [1..1000] ~=? test_ll, - - TestLabel "chaintest" $ - [0..511] ~=? runPar (lazy_chaintest 512), - - TestLabel "asynchronous chaintest" $ - [0..511] ~=? runParAsync (lazy_chaintest 512) - - ] - -main = async_test diff --git a/Control/Monad/Par/Scheds/Direct.hs b/Control/Monad/Par/Scheds/Direct.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Par/Scheds/Direct.hs @@ -0,0 +1,626 @@ +{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns, + ExistentialQuantification, CPP, ScopedTypeVariables, + TypeSynonymInstances, MultiParamTypeClasses, + GeneralizedNewtypeDeriving, PackageImports + #-} + +{- OPTIONS_GHC -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind -} + +-- {- LANGUAGE Trustworthy -} +-- TODO: Before declaring this module TRUSTWORTHY/SAFE, we need to +-- make the IVar type abstract. + +-- | A scheduler for the Par monad based on directly performing IO +-- actions when Par methods are called (i.e. without using a lazy +-- trace data structure). + +module Control.Monad.Par.Scheds.Direct ( + Sched(..), Par, + IVar(..), IVarContents(..), +-- sched, + runPar, + new, get, put_, fork, + newFull, newFull_, put, + spawn, spawn_, spawnP, + spawn1_ +-- runParAsync, runParAsyncHelper, +-- yield, + ) where + +import Control.Applicative +import Control.Concurrent hiding (yield) +import Debug.Trace +import Data.IORef +import Text.Printf +import GHC.Conc +import "mtl" Control.Monad.Cont as C +import qualified "mtl" Control.Monad.Reader as RD +-- import qualified Data.Array as A +-- import qualified Data.Vector as A +import qualified Data.Sequence as Seq +import System.Random.MWC as Random +import System.IO.Unsafe (unsafePerformIO) +import System.Mem.StableName +import qualified Control.Monad.Par.Class as PC +import qualified Control.Monad.Par.Unsafe as UN +import Control.DeepSeq + +-- import Data.Concurrent.Deque.Class as DQ +#ifdef REACTOR_DEQUE +-- These performed ABYSMALLY: +import Data.Concurrent.Deque.ChaseLev +import Data.Concurrent.Deque.ChaseLev.DequeInstance +import qualified Data.Concurrent.Deque.ReactorDeque as R +import Data.Array.IO +#else +import Data.Concurrent.Deque.Class (WSDeque) +import Data.Concurrent.Deque.Reference.DequeInstance +import Data.Concurrent.Deque.Reference as R +#endif + +import Prelude hiding (null) +import qualified Prelude + +-------------------------------------------------------------------------------- +-- Configuration Toggles +-------------------------------------------------------------------------------- + +-- define DEBUG +#ifdef DEBUG +dbg = True +#else +dbg = False +#endif + +#define FORKPARENT +#define WAKEIDLE + +-------------------------------------------------------------------------------- +-- Core type definitions +-------------------------------------------------------------------------------- + +-- Our monad stack looks like this: +-- --------- +-- ContT +-- ReaderT +-- IO +-- --------- +-- The ReaderT monad is there for retrieving the scheduler given the +-- fact that the API calls do not get it as an argument. +-- +-- Note that the result type for continuations is unit. Forked +-- computations return nothing. +-- +newtype Par a = Par { unPar :: C.ContT () ROnly a } + deriving (Monad, MonadCont, RD.MonadReader Sched) +type ROnly = RD.ReaderT Sched IO + +data Sched = Sched + { + ---- Per worker ---- + no :: {-# UNPACK #-} !Int, +#ifdef REACTOR_DEQUE + workpool :: R.Deque IOArray (Par ()), +#else + workpool :: WSDeque (Par ()), +#endif + rng :: HotVar GenIO, -- Random number gen for work stealing. + isMain :: Bool, -- Are we the main/master thread? + + ---- Global data: ---- + killflag :: HotVar Bool, + idle :: HotVar [MVar Bool], + scheds :: [Sched] -- A global list of schedulers. + } + +newtype IVar a = IVar (IORef (IVarContents a)) + +data IVarContents a = Full a | Empty | Blocked [a -> IO ()] + +unsafeParIO :: IO a -> Par a +unsafeParIO io = Par (lift$ lift io) +io = unsafeParIO -- shorthand used below + +-------------------------------------------------------------------------------- +-- Helpers #1: Atomic Variables +-------------------------------------------------------------------------------- +-- TEMP: Experimental + +#ifndef HOTVAR +#define HOTVAR 1 +#endif +newHotVar :: a -> IO (HotVar a) +modifyHotVar :: HotVar a -> (a -> (a,b)) -> IO b +modifyHotVar_ :: HotVar a -> (a -> a) -> IO () +writeHotVar :: HotVar a -> a -> IO () +readHotVar :: HotVar a -> IO a +-- readHotVarRaw :: HotVar a -> m a +-- writeHotVarRaw :: HotVar a -> m a + +{-# INLINE newHotVar #-} +{-# INLINE modifyHotVar #-} +{-# INLINE modifyHotVar_ #-} +{-# INLINE readHotVar #-} +{-# INLINE writeHotVar #-} + + +#if HOTVAR == 1 +type HotVar a = IORef a +newHotVar = newIORef +modifyHotVar = atomicModifyIORef +modifyHotVar_ v fn = atomicModifyIORef v (\a -> (fn a, ())) +readHotVar = readIORef +writeHotVar = writeIORef +instance Show (IORef a) where + show ref = "" + +-- hotVarTransaction = id +hotVarTransaction = error "Transactions not currently possible for IO refs" +readHotVarRaw = readHotVar +writeHotVarRaw = writeHotVar + + +#elif HOTVAR == 2 +#warning "Using MVars for hot atomic variables." +-- This uses MVars that are always full with *something* +type HotVar a = MVar a +newHotVar x = do v <- newMVar; putMVar v x; return v +modifyHotVar v fn = modifyMVar v (return . fn) +modifyHotVar_ v fn = modifyMVar_ v (return . fn) +readHotVar = readMVar +writeHotVar v x = do swapMVar v x; return () +instance Show (MVar a) where + show ref = "" + +-- hotVarTransaction = id +-- We could in theory do this by taking the mvar to grab the lock. +-- But we'd need some temporary storage.... +hotVarTransaction = error "Transactions not currently possible for MVars" +readHotVarRaw = readHotVar +writeHotVarRaw = writeHotVar + + +#elif HOTVAR == 3 +#warning "Using TVars for hot atomic variables." +-- Simon Marlow said he saw better scaling with TVars (surprise to me): +type HotVar a = TVar a +newHotVar = newTVarIO +modifyHotVar tv fn = atomically (do x <- readTVar tv + let (x2,b) = fn x + writeTVar tv x2 + return b) +modifyHotVar_ tv fn = atomically (do x <- readTVar tv; writeTVar tv (fn x)) +readHotVar x = atomically $ readTVar x +writeHotVar v x = atomically $ writeTVar v x +instance Show (TVar a) where + show ref = "" + +hotVarTransaction = atomically +readHotVarRaw = readTVar +writeHotVarRaw = writeTVar + +#endif + + +----------------------------------------------------------------------------- +-- Helpers #2: Pushing and popping work. +----------------------------------------------------------------------------- + +{-# INLINE popWork #-} +popWork :: Sched -> IO (Maybe (Par ())) +popWork Sched{ workpool, no } = do + mb <- R.tryPopL workpool + if dbg + then case mb of + Nothing -> return Nothing + Just x -> do sn <- makeStableName mb + printf " [%d] -> POP work unit %d\n" no (hashStableName sn) + return mb + else return mb + +{-# INLINE pushWork #-} +pushWork :: Sched -> Par () -> IO () +pushWork Sched { workpool, idle, no, isMain } task = do +-- modifyHotVar_ workpool (`pushL` task) + R.pushL workpool task + when dbg $ do sn <- makeStableName task + printf " [%d] -> PUSH work unit %d\n" no (hashStableName sn) +#ifdef WAKEIDLE + --when isMain$ -- Experimenting with reducing contention by doing this only from a single thread. + -- TODO: We need to have a proper binary wakeup-tree. + tryWakeIdle idle +#endif + + +tryWakeIdle idle = do +-- NOTE: I worry about having the idle var hammmered by all threads on their spawn-path: + -- If any worker is idle, wake one up and give it work to do. + idles <- readHotVar idle -- Optimistically do a normal read first. + when (not (Prelude.null idles)) $ do + when dbg$ printf "Waking %d idle thread(s).\n" (length idles) + r <- modifyHotVar idle (\is -> case is of + [] -> ([], return ()) + (i:is) -> (is, putMVar i False)) + r -- wake an idle worker up by putting an MVar. + +rand :: HotVar GenIO -> IO Int +rand ref = Random.uniformR (0, numCapabilities-1) =<< readHotVar ref + +-------------------------------------------------------------------------------- +-- Running computations in the Par monad +-------------------------------------------------------------------------------- + +instance NFData (IVar a) where + rnf _ = () + +runPar userComp = unsafePerformIO $ do + +#if __GLASGOW_HASKELL__ >= 701 /* 20110301 */ + -- + -- We create a thread on each CPU with forkOnIO. The CPU on which + -- the current thread is running will host the main thread; the + -- other CPUs will host worker threads. + -- + -- Note: GHC 7.1.20110301 is required for this to work, because that + -- is when threadCapability was added. + -- + (main_cpu, _) <- threadCapability =<< myThreadId +#else + -- + -- Lacking threadCapability, we always pick CPU #0 to run the main + -- thread. If the current thread is not running on CPU #0, this + -- will require some data to be shipped over the memory bus, and + -- hence will be slightly slower than the version above. + -- + let main_cpu = 0 +#endif + allscheds <- makeScheds main_cpu + + m <- newEmptyMVar + forM_ (zip [0..] allscheds) $ \(cpu,sched) -> + forkOnIO cpu $ + if (cpu /= main_cpu) + then do when dbg$ printf " [%d] Entering scheduling loop.\n" cpu + runReaderWith sched $ rescheduleR errK + when dbg$ printf " [%d] Exited scheduling loop. FINISHED.\n" cpu + else do + let userComp' = do when dbg$ io$ printf " [%d] Starting Par computation on main thread.\n" main_cpu + res <- userComp + finalSched <- RD.ask + when dbg$ io$ printf " [%d] Out of Par computation on main thread. Writing MVar...\n" (no finalSched) + + -- Sanity check our work queues: + when dbg $ io$ sanityCheck allscheds + io$ putMVar m res + + RD.runReaderT (C.runContT (unPar userComp') trivialCont) sched + when dbg$ do putStrLn " *** Out of entire runContT user computation on main thread." + sanityCheck allscheds + -- Not currently requiring that other scheduler threads have exited before we + -- (the main thread) exit. But we do signal here that they should terminate: + writeIORef (killflag sched) True + + when dbg$ do putStrLn " *** Reading final MVar on main thread." + takeMVar m -- Final value. + + +-- Make sure there is no work left in any deque after exiting. +sanityCheck :: [Sched] -> IO () +sanityCheck allscheds = do + forM_ allscheds $ \ Sched{no, workpool} -> do + b <- R.nullQ workpool + when (not b) $ do + printf "WARNING: After main thread exited non-empty queue remains for worker %d\n" no + putStrLn "Sanity check complete." + + +-- Create the default scheduler(s) state: +makeScheds main = do + workpools <- replicateM numCapabilities $ R.newQ + rngs <- replicateM numCapabilities $ Random.create >>= newHotVar + idle <- newHotVar [] + killflag <- newHotVar False + let allscheds = [ Sched { no=x, idle, killflag, isMain= (x==main), + workpool=wp, scheds=allscheds, rng=rng + } + | (x,wp,rng) <- zip3 [0..] workpools rngs] + return allscheds + + + +-------------------------------------------------------------------------------- +-- IVar operations +-------------------------------------------------------------------------------- + +{-# INLINE new #-} +-- | creates a new @IVar@ +new :: Par (IVar a) +new = io$ do r <- newIORef Empty + return (IVar r) + +{-# INLINE get #-} +-- | read the value in a @IVar@. The 'get' can only return when the +-- value has been written by a prior or parallel @put@ to the same +-- @IVar@. +get iv@(IVar v) = do + callCC $ \cont -> + do + e <- io$ readIORef v + case e of + Full a -> return a + _ -> do + sch <- RD.ask +# ifdef DEBUG + sn <- io$ makeStableName iv + let resched = trace (" ["++ show (no sch) ++ "] - Rescheduling on unavailable ivar "++show (hashStableName sn)++"!") +#else + let resched = +# endif + reschedule + -- Because we continue on the same processor the Sched stays the same: + -- TODO: Try NOT using monads as first class values here. Check for performance effect: + r <- io$ atomicModifyIORef v $ \e -> case e of + Empty -> (Blocked [pushWork sch . cont], resched) + Full a -> (Full a, return a) + Blocked ks -> (Blocked (pushWork sch . cont:ks), resched) + r + +-- | NOTE unsafePeek is NOT exposed directly through this module. (So +-- this module remains SAFE in the Safe Haskell sense.) It can only +-- be accessed by importing Control.Monad.Par.Unsafe. +{-# INLINE unsafePeek #-} +unsafePeek iv@(IVar v) = do + e <- io$ readIORef v + case e of + Full a -> return (Just a) + _ -> return Nothing + +{-# INLINE put_ #-} +-- | @put_@ is a version of @put@ that is head-strict rather than fully-strict. +put_ iv@(IVar v) !content = do + sched <- RD.ask + io$ do + ks <- atomicModifyIORef v $ \e -> case e of + Empty -> (Full content, []) + Full _ -> error "multiple put" + Blocked ks -> (Full content, ks) + +#ifdef DEBUG + sn <- makeStableName iv + printf " [%d] Put value %s into IVar %d. Waking up %d continuations.\n" + (no sched) (show content) (hashStableName sn) (length ks) +#endif + mapM_ ($content) ks + return () + + +-- | NOTE unsafeTryPut is NOT exposed directly through this module. (So +-- this module remains SAFE in the Safe Haskell sense.) It can only +-- be accessed by importing Control.Monad.Par.Unsafe. +{-# INLINE unsafeTryPut #-} +unsafeTryPut iv@(IVar v) !content = do + -- Head strict rather than fully strict. + sched <- RD.ask + io$ do + (ks,res) <- atomicModifyIORef v $ \e -> case e of + Empty -> (Full content, ([], content)) + Full x -> (Full x, ([], x)) + Blocked ks -> (Full content, (ks, content)) +#ifdef DEBUG + sn <- makeStableName iv + printf " [%d] unsafeTryPut: value %s in IVar %d. Waking up %d continuations.\n" + (no sched) (show content) (hashStableName sn) (length ks) +#endif + mapM_ ($content) ks + return res + + +-- TODO: Continuation (parent) stealing version. +{-# INLINE fork #-} +fork :: Par () -> Par () +#ifdef FORKPARENT +#warning "FORK PARENT POLICY USED" +fork task = do + sched <- RD.ask + callCC$ \parent -> do + let wrapped = parent () + -- Is it possible to slip in a new Sched here? + -- let wrapped = lift$ RD.runReaderT (parent ()) undefined + io$ pushWork sched wrapped + -- Then execute the child task and return to the scheduler when it is complete: + task + -- If we get to this point we have finished the child task: + reschedule -- We reschedule to pop the cont we pushed. + io$ putStrLn " !!! ERROR: Should not reach this point #1" + + when dbg$ do + sched2 <- RD.ask + io$ printf " called parent continuation... was on cpu %d now on cpu %d\n" (no sched) (no sched2) + +#else +fork task = do + sch <- RD.ask + io$ when dbg$ printf " [%d] forking task...\n" (no sch) + io$ pushWork sch task +#endif + +-- This routine "longjmp"s to the scheduler, throwing out its own continuation. +reschedule :: Par a +reschedule = Par $ C.ContT rescheduleR + +-- Reschedule ignores its continuation. +-- It runs the scheduler loop indefinitely, until it observers killflag==True +rescheduleR :: ignoredCont -> ROnly () +rescheduleR k = do + mysched <- RD.ask + when dbg$ liftIO$ printf " [%d] - Reschedule...\n" (no mysched) + mtask <- liftIO$ popWork mysched + case mtask of + Nothing -> do k <- liftIO$ readIORef (killflag mysched) + unless k $ do + liftIO$ steal mysched +#ifdef WAKEIDLE +-- io$ tryWakeIdle (idle mysched) +#endif + rescheduleR errK + Just task -> do + -- When popping work from our own queue the Sched (Reader value) stays the same: + when dbg $ do sn <- liftIO$ makeStableName task + liftIO$ printf " [%d] popped work %d from own queue\n" (no mysched) (hashStableName sn) + let C.ContT fn = unPar task + -- Run the stolen task with a continuation that returns to the scheduler if the task exits normally: + fn (\ () -> do + sch <- RD.ask + when dbg$ liftIO$ printf " + task finished successfully on cpu %d, calling reschedule continuation..\n" (no sch) + rescheduleR errK) + +{-# INLINE runReaderWith #-} +runReaderWith state m = RD.runReaderT m state + + +-- | Attempt to steal work or, failing that, give up and go idle. +steal :: Sched -> IO () +steal mysched@Sched{ idle, scheds, rng, no=my_no } = do + when dbg$ printf " [%d] + stealing\n" my_no + i <- getnext (-1 :: Int) + go maxtries i + where +-- maxtries = numCapabilities -- How many times should we attempt theft before going idle? + maxtries = 20 * numCapabilities -- How many times should we attempt theft before going idle? + + getnext _ = rand rng + + ---------------------------------------- + -- IDLING behavior: + go 0 _ = + do m <- newEmptyMVar + r <- modifyHotVar idle $ \is -> (m:is, is) + if length r == numCapabilities - 1 + then do + when dbg$ printf " [%d] | initiating shutdown\n" my_no + mapM_ (\m -> putMVar m True) r + else do + done <- takeMVar m + if done + then do + when dbg$ printf " [%d] | shutting down\n" my_no + return () + else do + when dbg$ printf " [%d] | woken up\n" my_no + i <- getnext (-1::Int) + go maxtries i + ---------------------------------------- + go tries i + | i == my_no = do i' <- getnext i + go (tries-1) i' + + | otherwise = do + let schd = scheds!!i + when dbg$ printf " [%d] | trying steal from %d\n" my_no (no schd) + +-- let dq = workpool schd :: WSDeque (Par ()) + let dq = workpool schd + r <- R.tryPopR dq + + case r of + Just task -> do + when dbg$ do sn <- makeStableName task + printf " [%d] | stole work (unit %d) from cpu %d\n" my_no (hashStableName sn) (no schd) + runReaderWith mysched $ + C.runContT (unPar task) + (\_ -> do + when dbg$ do sn <- liftIO$ makeStableName task + liftIO$ printf " [%d] | DONE running stolen work (unit %d) from %d\n" my_no (hashStableName sn) (no schd) + return ()) + + Nothing -> do i' <- getnext i + go (tries-1) i' + +errK = error "this closure shouldn't be used" +trivialCont _ = +#ifdef DEBUG + trace "trivialCont evaluated!" +#endif + return () + +---------------------------------------------------------------------------------------------------- + + +-------------------------------------------------------------------------------- +-- + +-- TEMP: TODO: Factor out this boilerplate somehow. + +{-# INLINE spawn1_ #-} +-- Spawn a one argument function instead of a thunk. This is good for debugging if the value supports "Show". +spawn1_ f x = +#ifdef DEBUG + do sn <- io$ makeStableName f + sch <- RD.ask; when dbg$ io$ printf " [%d] spawning fn %d with arg %s\n" (no sch) (hashStableName sn) (show x) +#endif + spawn_ (f x) + +-- The following is usually inefficient! +newFull_ a = do v <- new + put_ v a + return v + +newFull a = deepseq a (newFull_ a) + +{-# INLINE put #-} +put v a = deepseq a (put_ v a) + +spawn p = do r <- new; fork (p >>= put r); return r +spawn_ p = do r <- new; fork (p >>= put_ r); return r +spawnP a = spawn (return a) + +-- In Debug mode we require that IVar contents be Show-able: +#ifdef DEBUG +put :: (Show a, NFData a) => IVar a -> a -> Par () +spawn :: (Show a, NFData a) => Par a -> Par (IVar a) +spawn_ :: Show a => Par a -> Par (IVar a) +spawn1_ :: (Show a, Show b) => (a -> Par b) -> a -> Par (IVar b) +put_ :: Show a => IVar a -> a -> Par () +get :: Show a => IVar a -> Par a +runPar :: Show a => Par a -> a +newFull :: (Show a, NFData a) => a -> Par (IVar a) +newFull_ :: Show a => a -> Par (IVar a) +#else +spawn :: NFData a => Par a -> Par (IVar a) +spawn_ :: Par a -> Par (IVar a) +spawn1_ :: (a -> Par b) -> a -> Par (IVar b) +put_ :: IVar a -> a -> Par () +put :: NFData a => IVar a -> a -> Par () +get :: IVar a -> Par a +runPar :: Par a -> a +newFull :: NFData a => a -> Par (IVar a) +newFull_ :: a -> Par (IVar a) + + +instance PC.ParFuture IVar Par where + get = get + spawn = spawn + spawn_ = spawn_ + spawnP = spawnP + +instance PC.ParIVar IVar Par where + fork = fork + new = new + put_ = put_ + newFull = newFull + newFull_ = newFull_ + +instance UN.ParUnsafe IVar Par where + unsafePeek = unsafePeek + unsafeTryPut = unsafeTryPut + unsafeParIO = unsafeParIO +#endif + +instance Functor Par where + fmap f xs = xs >>= return . f + +instance Applicative Par where + (<*>) = ap + pure = return +-- +-------------------------------------------------------------------------------- diff --git a/Control/Monad/Par/Scheds/Sparks.hs b/Control/Monad/Par/Scheds/Sparks.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Par/Scheds/Sparks.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +-- | This scheduler uses sparks (par/pseq) directly, but only supplies +-- the @Monad.Par.Class.ParFuture@ interface. + +module Control.Monad.Par.Scheds.Sparks + ( + Par(..), Future(..), + runPar, + get, spawn, spawn_, spawnP + ) +where + +import Control.Applicative +import Control.Monad +import Control.DeepSeq +import Control.Parallel +import qualified Control.Monad.Par.Class as PC +-- import Control.Parallel.Strategies (rpar) + +{-# INLINE runPar #-} +{-# INLINE spawn #-} +{-# INLINE spawn_ #-} +{-# INLINE spawnP #-} +{-# INLINE get #-} + +data Par a = Done a +data Future a = Future a + +runPar :: Par a -> a +runPar (Done x) = x + +spawn_ :: Par a -> Par (Future a) +-- spawn_ a = do a' <- rpar (runPar a); return (Future a') +spawn_ a = let a' = runPar a in a' `par` return (Future a') + +spawn :: NFData a => Par a -> Par (Future a) +spawn a = let a' = runPar a in a' `par` return (Future (rnf a' `pseq` a')) + +spawnP :: NFData a => a -> Par (Future a) +spawnP a = a `par` return (Future (rnf a `pseq` a)) + +get :: Future a -> Par a +get (Future a) = a `pseq` return a + +-------------------------------------------------------------------------------- +-- + +instance Monad Par where + return x = Done x + Done x >>= k = k x + +instance PC.ParFuture Future Par where + get = get + spawn = spawn + spawn_ = spawn_ + spawnP = spawnP + +instance Functor Par where + fmap f xs = xs >>= return . f + +instance Applicative Par where + (<*>) = ap + pure = return + +-- +-------------------------------------------------------------------------------- diff --git a/Control/Monad/Par/Scheds/Trace.hs b/Control/Monad/Par/Scheds/Trace.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Par/Scheds/Trace.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns, + ExistentialQuantification, MultiParamTypeClasses, CPP + #-} +{- OPTIONS_GHC -Wall -fno-warn-name-shadowing -fwarn-unused-imports -} + +{- | This is the scheduler described in the paper "A Monad for + Deterministic Parallelism". It is based on a lazy @Trace@ data + structure that separates the scheduler from the @Par@ monad + method implementations. + + -} + +module Control.Monad.Par.Scheds.Trace ( + Par, runPar, fork, + IVar, new, newFull, newFull_, get, put, put_, + spawn, spawn_, spawnP + ) where + +import qualified Control.Monad.Par.Class as PC +import Control.Monad.Par.Scheds.TraceInternal +import Control.DeepSeq +import Control.Monad as M hiding (mapM, sequence, join) +import Prelude hiding (mapM, sequence, head,tail) + +-- ----------------------------------------------------------------------------- + +-- Not in 6.12: {- INLINABLE fork -} +{-# INLINE fork #-} +fork :: Par () -> Par () +fork p = Par $ \c -> Fork (runCont p (\_ -> Done)) (c ()) + +-- -------------------------------------------------------------------------------- +-- -- Standard instances: + +-- +spawn p = do r <- new; fork (p >>= put r); return r +spawn_ p = do r <- new; fork (p >>= put_ r); return r +-- > + +spawnP :: NFData a => a -> Par (IVar a) +spawnP a = spawn (return a) + +instance PC.ParFuture IVar Par where + get = get + spawn = spawn + spawn_ = spawn_ + spawnP = spawnP + +instance PC.ParIVar IVar Par where + fork = fork + new = new + put = put + put_ = put_ + newFull = newFull + newFull_ = newFull_ +-- yield = yield diff --git a/Control/Monad/Par/Scheds/TraceInternal.hs b/Control/Monad/Par/Scheds/TraceInternal.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Par/Scheds/TraceInternal.hs @@ -0,0 +1,595 @@ +{-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns, + ExistentialQuantification, CPP, ParallelListComp + #-} +{- OPTIONS_GHC -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind -} + +-- | This module exposes the internals of the @Par@ monad so that you +-- can build your own scheduler or other extensions. Do not use this +-- module for purposes other than extending the @Par@ monad with new +-- functionality. + +module Control.Monad.Par.Scheds.TraceInternal ( + Trace(..), Sched(..), Par(..), + IVar(..), IVarContents(..), + sched, + runPar, runParAsync, runParAsyncHelper, + new, newFull, newFull_, get, put_, put, + pollIVar, yield, + ) where + + +import Control.Monad as M hiding (sequence, join) +import Prelude hiding (mapM, sequence) +import Data.IORef +import System.IO.Unsafe +import Control.Concurrent hiding (yield) +import GHC.Conc hiding (yield) +import Control.DeepSeq +import Control.Applicative +import Data.Array +import Data.List (partition, find) +--import Text.Printf + + +-- --------------------------------------------------------------------------- +-- MAIN SCHEDULING AND RUNNING +-- --------------------------------------------------------------------------- + +data Trace = forall a . Get (IVar a) (a -> Trace) + | forall a . Put (IVar a) a Trace + | forall a . New (IVarContents a) (IVar a -> Trace) + | Fork Trace Trace + | Done + | Yield Trace + +data Sched = Sched + { no :: {-# UNPACK #-} !ThreadNumber, + -- ^ The threadnumber of this worker + workpool :: IORef WorkPool, + -- ^ The workpool for this worker + status :: IORef AllStatus, + -- ^ The Schedulers' status + scheds :: Array ThreadNumber Sched, + -- ^ The list of all workers by thread + tId :: IORef ThreadId + -- ^ The ThreadId of this worker + } + +type ThreadNumber = Int +type UId = Int +type CountRef = IORef Int +type WorkLimit = (UId, CountRef) +-- ^ The UId and the count of tasks left or Nothing if there's no limit +-- When the UId is -1, it means that the worker will remain alive until +-- purposely killed (by globalThreadShutdown). +-- +-- The reason for a work limit is to make sure that nested threads properly exit. +-- Imagine a scenario where thread A, a worker thread, encounters a runPar. It +-- recursively enters worker status, but it needs ot leave worker status at some +-- point to finish the task that caused it to call runPar. Suppose now that it +-- encounters another call to runPar. If it has the ability to finish and return, +-- we must make sure it returns first for the nested runPar or else it will return +-- to the wrong place! The work limit helps achieve this. +-- +-- TODO: Perhaps the work limit need not restrict what a thread can work on, but +-- instead it simply provides the singular point that a thread is allowed to return +-- from. The only concern is some potential for bad blocking - is that a legit +-- concern? + +isWLUId :: WorkLimit -> (UId -> Bool) -> Bool +--isWLUId Nothing _ = False +isWLUId (uid, _) op = op uid + +shouldEndWorkSet :: WorkLimit -> IO Bool +shouldEndWorkSet (u,_) | u == -1 = return False +shouldEndWorkSet (_, cr) = do + c <- readIORef cr + return (c == 0) + +idleAtWL :: WorkLimit -> MVar Bool -> Idle +--idleAtWL Nothing m = Idle Nothing m +idleAtWL (uid, _) m = Idle uid m + +-- | The main scheduler loop. +-- This takes the synchrony flag, our Sched, the particular work queue we're +-- currently working on, the uid of the work queue (for pushing work), our +-- work limit, and the already-popped, first trace in the work queue. +-- +-- INVARIANT: This should only be called by threads who ARE currently marked +-- as working. +sched :: Bool -> WorkLimit -> Sched -> (IORef [Trace]) -> UId -> Trace -> IO () +sched _doSync wl q@Sched{status, workpool} queueref uid t = loop t + where + loop t = case t of + New a f -> do + r <- newIORef a + loop (f (IVar r)) + Get (IVar v) c -> do + e <- readIORef v + case e of + Full a -> loop (c a) + _other -> do + r <- atomicModifyIORef v $ \e -> case e of + Empty -> (Blocked [c], go) + Full a -> (Full a, loop (c a)) + Blocked cs -> (Blocked (c:cs), go) + r + Put (IVar v) a t -> do + cs <- atomicModifyIORef v $ \e -> case e of + Empty -> (Full a, []) + Full _ -> error "multiple put" + Blocked cs -> (Full a, cs) + mapM_ (pushWork status uid queueref . ($a)) cs + loop t + Fork child parent -> do + pushWork status uid queueref child + loop parent + Done -> + if _doSync + then go + -- We could fork an extra thread here to keep numCapabilities workers + -- even when the main thread returns to the runPar caller... + else do -- putStrLn " [par] Forking replacement thread..\n" + forkIO go; return () + -- But even if we don't we are not orphaning any work in this + -- thread's work-queue because it can be stolen by other threads. + -- else return () + + Yield parent -> do + -- Go to the end of the worklist: + -- TODO: Perhaps consider Data.Seq here. + -- This would also be a chance to steal and work from opposite ends of the queue. + atomicModifyIORef queueref $ \ts -> (ts++[parent],()) + go + go = do + mt <- atomicPopIORef queueref + case mt of + Just t -> loop t + Nothing -> do + -- SCARY: we better be working on the top queue in the pool! + cr <- wpRemoveWork uid workpool + workDone <- decWorkerCount uid cr status + -- If this uid is our workLimit id AND worker count == 0, then + -- we should just return () rather than calling reschedule q + unless (isWLUId wl (== uid) && workDone) $ + reschedule wl q + + +-- | Process the next work queue on the work pool, or failing that, go into +-- work stealing mode. +-- +-- INVARIANT: This should only be called by threads who are NOT currently +-- marked as working (or if they are, the task they were working +-- on executed a runPar). +reschedule :: WorkLimit -> Sched -> IO () +reschedule wl q@Sched{ workpool, status } = do + wp <- readIORef workpool + case wp of + Work uid cr wqref _ | isWLUId wl (uid >=) -> do + incWorkerCount cr + nextTrace <- atomicPopIORef wqref + case nextTrace of + Just t -> sched True wl q wqref uid t + Nothing -> do + wpRemoveWork uid workpool + workDone <- decWorkerCount uid cr status + -- If this uid is our workLimit id AND worker count == 0, then + -- we should just return () rather than calling reschedule q + unless (isWLUId wl (== uid) && workDone) $ + reschedule wl q + _ -> steal wl q + + +-- RRN: Note -- NOT doing random work stealing breaks the traditional +-- Cilk time/space bounds if one is running strictly nested (series +-- parallel) programs. + +-- | Attempt to steal work or, failing that, give up and go idle. +steal :: WorkLimit -> Sched -> IO () +steal wl q@Sched{ status, scheds, no=my_no } = + -- printf "cpu %d stealing\n" my_no >> + go l + where + (l,u) = bounds scheds + go n + | n > u = do + -- Prepare to go idle + m <- newEmptyMVar + atomicModifyIORef status $ addIdler (idleAtWL wl m) + -- Check to see if this workset is ready to close + s <- shouldEndWorkSet wl + if s + then do + -- Time to close this workset + --printf "cpu %d shutting down workset %d\n" my_no myPriLimit + endWorkSet status (fst wl) + return () + else do + -- There's more work being done here, so I'll go idle + finished <- takeMVar m + unless finished $ go l + | n == my_no = go (n+1) + | otherwise = readIORef (workpool (scheds!n)) >>= tryToSteal + where + tryToSteal (Work uid cr wqref wp) | isWLUId wl (uid >=) = do + incWorkerCount cr + stolenTrace <- atomicPopIORef wqref + case stolenTrace of + Nothing -> decWorkerCount uid cr status >> tryToSteal wp + Just t -> do + sublst <- newIORef [] + atomicModifyIORef (workpool q) $ \wp' -> (Work uid cr sublst wp', ()) + sched True wl q sublst uid t + tryToSteal _ = go (n+1) + + +-- --------------------------------------------------------------------------- +-- UTILITY FUNCTIONS +-- --------------------------------------------------------------------------- + +-- | Push work. Then, find an idle worker with uid less than the pushed work. +-- If one is found, wake it up. +pushWork :: IORef AllStatus -> UId -> (IORef [Trace]) -> Trace -> IO () +pushWork status uid wqref t = do + atomicModifyIORef wqref $ (\ts -> (t:ts, ())) + allstatus <- readIORef status + when (hasIdleWorker uid allstatus) $ do + r <- atomicModifyIORef status $ getIdleWorker uid + case r of + Just b -> putMVar b False + Nothing -> return () + +-- | A utility function for decreasing the task count of a work set. +-- If the count becomes 0, endWorkSet is called on the work set. +decWorkerCount :: UId -> CountRef -> IORef AllStatus -> IO Bool +decWorkerCount uid countref status = do + done <- atomicModifyIORef countref $ + (\n -> if n == 0 then error "Impossible value in decWorkerCount" else (n-1, n == 1)) + when done $ (endWorkSet status uid >> globalWorkComplete uid) + return done + +-- | A utility function for increasing the task count of a work set. +incWorkerCount :: CountRef -> IO () +incWorkerCount countref = do + atomicModifyIORef countref $ (\n -> (n+1, ())) + +-- | A utility for popping an element off of an IORef list. +-- The return value is Just a where a is the head of the list +-- or Nothing if the list is null. +atomicPopIORef :: IORef [a] -> IO (Maybe a) +atomicPopIORef ref = atomicModifyIORef ref $ \lst -> + case lst of + [] -> ([], Nothing) + (e:es) -> (es, Just e) + +-- --------------------------------------------------------------------------- +-- IDLING STATUS +-- --------------------------------------------------------------------------- + +data Idle = Idle {-# UNPACK #-} !UId (MVar Bool) +data ExtIdle = ExtIdle {-# UNPACK #-} !UId (MVar ()) +type AllStatus = ([Idle], [ExtIdle]) + +-- | A new empty PQueue of Statuses +newStatus :: AllStatus +newStatus = ([], []) + +-- | Adds a new Idler to the AllStatus. +addIdler :: Idle -> AllStatus -> (AllStatus, ()) +addIdler i@(Idle u _) (is, es) = ((insert is, es), ()) + where insert [] = [i] + insert xs@(i'@(Idle u' _):xs') = if u <= u' + then i : xs + else i' : insert xs' + +-- | Adds a new External idler to the AllStatus. +addExtIdler :: ExtIdle -> AllStatus -> (AllStatus, ()) +addExtIdler e (is, es) = ((is, e:es), ()) + +-- | Returns an idle worker with uid less than or equal to the given one +-- (if it exists) and removes it from the AllStatus +getIdleWorker :: UId -> AllStatus -> (AllStatus, Maybe (MVar Bool)) +getIdleWorker u q = case q of + ([],_) -> (q, Nothing) + ((Idle u' m'):rst, es) -> if u' <= u then ((rst,es), Just m') else (q, Nothing) + +-- | Returns true if there is an idle worker with uid less than the given one +hasIdleWorker :: UId -> AllStatus -> Bool +hasIdleWorker uid q = case getIdleWorker uid q of + (_, Nothing) -> False + (_, Just _) -> True + +-- | Wakes up all idle workers at the given uid with the True signal +endWorkSet :: IORef AllStatus -> UId -> IO () +endWorkSet status uid = do + (is, es) <- atomicModifyIORef status $ getAllAtID + mapM_ (\(ExtIdle _ mb) -> putMVar mb ()) es + mapM_ (\(Idle _ mb) -> putMVar mb True) is + where + getAllAtID (is, es) = ((is', es'), (elems1, elems2)) + where + (elems1, is') = partition (\(Idle u _) -> u == uid) is + (elems2, es') = partition (\(ExtIdle u _) -> u == uid) es + + +-- --------------------------------------------------------------------------- +-- WorkPool +-- --------------------------------------------------------------------------- + +-- | The WorkPool keeps a queue where each element has a UId, a list of +-- traces, and the countRef of how many workers are working on Traces +-- of this UId. +-- +-- It should be that by the natural pushing done in sched, this pool +-- should always be in order. We take advantage of this by making +-- guarantees but not actually checking at runtime whether they're true. +data WorkPool = Work {-# UNPACK #-} !UId CountRef (IORef [Trace]) WorkPool | NoWork + +-- | Pop the next work queue from the work pool. This should only be called +-- if both the work pool contains a pool, and the queue in that pool is +-- empty. Thus, it should only be called by the pool's owner. +wpRemoveWork :: UId -> IORef WorkPool -> IO CountRef +wpRemoveWork uid pRef = atomicModifyIORef pRef f + where f :: WorkPool -> (WorkPool, CountRef) + f (Work uid' cr' _ p') | uid == uid' = (p', cr') + f (Work uid' cr' wq' p') = + let (p'', cr'') = f p' + in (Work uid' cr' wq' p'', cr'') + f NoWork = error "Impossible state in wpRemoveWork" + + +-- --------------------------------------------------------------------------- +-- PAR AND IVAR +-- --------------------------------------------------------------------------- + +newtype Par a = Par { + runCont :: (a -> Trace) -> Trace +} + +instance Functor Par where + fmap f m = Par $ \c -> runCont m (c . f) + +instance Monad Par where + return a = Par ($ a) + m >>= k = Par $ \c -> runCont m $ \a -> runCont (k a) c + +instance Applicative Par where + (<*>) = ap + pure = return + +newtype IVar a = IVar (IORef (IVarContents a)) +-- data IVar a = IVar (IORef (IVarContents a)) + +data IVarContents a = Full a | Empty | Blocked [a -> Trace] + +-- Forcing evaluation of a IVar is fruitless. +instance NFData (IVar a) where + rnf _ = () + +-- From outside the Par computation we can peek. But this is +-- nondeterministic; it should perhaps have "unsafe" in the name. +pollIVar :: IVar a -> IO (Maybe a) +pollIVar (IVar ref) = + do contents <- readIORef ref + case contents of + Full x -> return (Just x) + _ -> return (Nothing) + + +-- --------------------------------------------------------------------------- +-- GLOBAL THREAD IDENTIFICATION +-- --------------------------------------------------------------------------- + +-- Global thread identification is handled byt the globalThreadState object. +-- The main way to interact with this object is to attempt to establish global +-- Scheds, shut down the threads and clear the Scheds, or to mark a work set +-- as complete. + +data GlobalThreadState = GTS (Array ThreadNumber Sched) !UId !Int + +-- | This is the global thread state variable +globalThreadState :: IORef (Maybe GlobalThreadState) +globalThreadState = unsafePerformIO $ newIORef $ Nothing + +-- | This is called when a work set completes (see decWorkerCount). +-- We do this so that we can know if it's okay to do a +-- globalThreadShutdown. +globalWorkComplete :: UId -> IO () +globalWorkComplete _ = + atomicModifyIORef globalThreadState f + where f Nothing = error "Impossible state in globalWorkComplete." + f (Just (GTS retA n c)) = (Just (GTS retA n (c+1)), ()) + +-- | Attempts to set the global Scheds. If they are already extablished, +-- this returns a Failure with a new UId (to interact with the global +-- threads) and the current global Scheds. Otherwise, it establishes +-- the given array as the global Scheds, and returns a Success containing +-- the UId to use. +data GTSResult = Success UId | Failure UId (Array ThreadNumber Sched) +globalEstablishScheds :: Array ThreadNumber Sched -> IO GTSResult +globalEstablishScheds a = + atomicModifyIORef globalThreadState f + where f Nothing = (Just (GTS a 1 0), Success 0) + f (Just (GTS retA n c)) = (Just (GTS retA (n+1) c), Failure n retA) + +-- | Attempts to shutdown the global threads. If there are unfinished tasks, +-- this shuts down nothing and returns False. Otherwise, this shuts down +-- all threads, un-establishes the global Scheds, and returns True. +-- If the Scheds are currently unestablished, this does nothing and returns +-- False. +-- +-- TODO: This can sometimes leave threads hanging who are not doing any work +-- but have not yet marked themselves as idle. Things won't exactly +-- break, but there may be MVar errors that are thrown. +globalThreadShutdown :: IO Bool +globalThreadShutdown = do + ma <- atomicModifyIORef globalThreadState f + case ma of + Nothing -> return False + Just a -> do + let s = status $ a ! (fst $ bounds a) + (is, es) <- atomicModifyIORef s $ \x -> (newStatus, x) + mapM_ (\(ExtIdle _ m) -> putMVar m ()) es + mapM_ (\(Idle _ mb) -> putMVar mb True) is + return True + where f (Just (GTS a n c)) | n == c = (Nothing, Just a) + f gts = (gts, Nothing) + + +-- --------------------------------------------------------------------------- +-- RUNPAR +-- --------------------------------------------------------------------------- + +-- [Notes on threadCapability] +-- +-- We create a thread on each CPU with forkOnIO. Ideally, the CPU on +-- which the current thread is running will host the main thread; the +-- other CPUs will host worker threads. +-- +-- This is possible using threadCapability, but this requires +-- GHC 7.1.20110301, because that is when threadCapability was added. +-- +-- Lacking threadCapability, we always pick CPU #0 to run the main +-- thread. If the current thread is not running on CPU #0, this +-- will require some data to be shipped over the memory bus, and +-- hence will be slightly slower than the version using threadCapability. +-- +-- If this is a nested runPar call, then we can do slightly better. We +-- can look at the current workers' ThreadIds and see if we are one of +-- them. If so, we do the work on that core. If not, we are once again +-- forced to choose arbitrarily, so we send the work to CPU #0. +-- + + +{-# INLINE runPar_internal #-} +runPar_internal :: Bool -> Par a -> a +runPar_internal _doSync x = unsafePerformIO $ do + -- Set up the schedulers + myTId <- myThreadId + tIds <- replicateM numCapabilities $ newIORef myTId + workpools <- replicateM numCapabilities $ newIORef NoWork + statusRef <- newIORef newStatus + let states = listArray (0, numCapabilities-1) + [ Sched { no=n, workpool=wp, status=statusRef, scheds=states, tId=t } + | n <- [0..] | wp <- workpools | t <- tIds ] + res <- globalEstablishScheds states + case res of + Success uid -> do +#if __GLASGOW_HASKELL__ >= 701 /* 20110301 */ + -- See [Notes on threadCapability] for more details + (main_cpu, _) <- threadCapability =<< myThreadId +#else + let main_cpu = 0 +#endif + currentWorkers <- newIORef 1 + let workLimit' = (-1, undefined) + let workLimit = (0, currentWorkers) + + m <- newEmptyMVar + rref <- newIORef Empty + atomicModifyIORef statusRef $ addExtIdler (ExtIdle uid m) + forM_ (elems states) $ \(state@Sched{no=cpu}) -> do + forkOnIO cpu $ do + myTId <- myThreadId + --printf "cpu %d setting threadId=%s\n" cpu (show myTId) + writeIORef (tId state) myTId + if (cpu /= main_cpu) + then reschedule workLimit' state + else do + sublst <- newIORef [] + atomicModifyIORef (workpool state) $ \wp -> (Work uid currentWorkers sublst wp, ()) + sched _doSync workLimit state sublst uid $ runCont (x >>= put_ (IVar rref)) (const Done) + takeMVar m + --printf "done\n" + r <- readIORef rref + + -- TODO: If we're doing this nested strategy, we should probably just keep the + -- threads alive indefinitely. After all, we can get some weird conditions + -- doing it this way. At the least, we should put this in steal where the + -- shutdown occurs. + b <- globalThreadShutdown +-- putStrLn $ "Global thread shutdown: " ++ show b + case r of + Full a -> return a + _ -> error "no result" + + Failure uid cScheds -> do +#if __GLASGOW_HASKELL__ >= 701 /* 20110301 */ + -- See [Notes on threadCapability] for more details + (main_cpu, _) <- threadCapability myTId + cTId <- readIORef $ tId $ cScheds ! main_cpu + let doWork = cTId == myTId +#else + cTIds <- mapM (\s -> (readIORef $ tId $ s) >>= (\t -> return (s,t))) (elems cScheds) + let (main_cpu, doWork) = case find ((== myTId) . snd) cTIds of + Nothing -> (0, False) + Just (s,_) -> (no s, True) +#endif + + rref <- newIORef Empty + let task = runCont (x >>= put_ (IVar rref)) (const Done) + state = cScheds ! main_cpu + if doWork + then do + --printf "cpu %d using old threads, of which I am one\n" main_cpu + currentWorkers <- newIORef 1 + sublst <- newIORef [] + let workLimit = (uid, currentWorkers) + atomicModifyIORef (workpool state) $ \wp -> (Work uid currentWorkers sublst wp, ()) + sched _doSync workLimit state sublst uid $ task + else do + --printf "cpu %d using old threads, of which I am not one\n" main_cpu + currentWorkers <- newIORef 0 + sublst <- newIORef [task] + m <- newEmptyMVar + atomicModifyIORef (status state) $ addExtIdler (ExtIdle uid m) + atomicModifyIORef (workpool state) $ \wp -> (Work uid currentWorkers sublst wp, ()) + takeMVar m + --printf "cpu %d finished in child\n" main_cpu + r <- readIORef rref +-- globalThreadShutdown + case r of + Full a -> return a + _ -> error "no result" + +-- | The main way to run a Par computation +runPar :: Par a -> a +runPar = runPar_internal True + +-- | An asynchronous version in which the main thread of control in a +-- Par computation can return while forked computations still run in +-- the background. +runParAsync :: Par a -> a +runParAsync = runPar_internal False + +-- | An alternative version in which the consumer of the result has +-- the option to "help" run the Par computation if results it is +-- interested in are not ready yet. +runParAsyncHelper :: Par a -> (a, IO ()) +runParAsyncHelper = undefined -- TODO: Finish Me. + + +-- --------------------------------------------------------------------------- +-- PAR FUNCTIONS +-- --------------------------------------------------------------------------- + +new :: Par (IVar a) +new = Par $ New Empty + +newFull :: NFData a => a -> Par (IVar a) +newFull x = deepseq x (Par $ New (Full x)) + +newFull_ :: a -> Par (IVar a) +newFull_ !x = Par $ New (Full x) + +get :: IVar a -> Par a +get v = Par $ \c -> Get v c + +put_ :: IVar a -> a -> Par () +put_ v !a = Par $ \c -> Put v a (c ()) + +put :: NFData a => IVar a -> a -> Par () +put v a = deepseq a (Par $ \c -> Put v a (c ())) + +yield :: Par () +yield = Par $ \c -> Yield (c ()) diff --git a/Control/Monad/Par/Stream.hs b/Control/Monad/Par/Stream.hs deleted file mode 100644 --- a/Control/Monad/Par/Stream.hs +++ /dev/null @@ -1,367 +0,0 @@ -{-# LANGUAGE BangPatterns, CPP #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing -fwarn-unused-imports #-} --- -Wall - --- A module for stream processing built on top of Control.Monad.Par - --- (In the future may want to look into the stream interface used by --- the stream fusion framework.) - -#define DEBUGSTREAMS - -module Control.Monad.Par.Stream - ( - streamMap, streamScan, streamFold - , countupWin, generate - , runParList, toListSpin - , measureRate, measureRateList - , browseStream - , Stream, Window, WStream - - -- TEMP: - , one_second, commaint - ) -where -import Control.Monad -import Control.Monad.Par as P -import Control.Monad.Par.IList -import Control.DeepSeq - ---import qualified Data.Array.Unboxed as U -import Data.Array.Unboxed as U -import Data.Array.CArray as C -import Data.Int -import Data.Word -import Data.List (intersperse) -import Data.List.Split (chunk) - -import Foreign.Storable - -import System.CPUTime -import System.CPUTime.Rdtsc -import GHC.Conc as Conc -import System.IO -import GHC.IO (unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO) - - -import Debug.Trace -import Control.Monad.Par.Logging - -debugflag = True - --------------------------------------------------------------------------------- --- Types - -type Stream a = IVar (IList a) - --- A windowed stream passes chunks of stream elements. -type WStream a = Stream (Window a) - -#define CARRAY -#ifdef CARRAY -type Window a = CArray Int a -#else -type Window a = U.UArray Int a -#endif - - --------------------------------------------------------------------------------- --- Stream Operators - --- | This version applies a function to every element in a stream, --- exposing data parallelism and pipeline parallelism. -streamMapDP :: NFData b => (a -> b) -> Stream a -> Par (Stream b) -streamMapDP fn instrm = - do outstrm <- new - fork$ loop instrm outstrm - return outstrm - where - loop instrm outstrm = - do - ilst <- get instrm - case ilst of - Null -> put outstrm Null -- End of stream. - Cons h t -> - do newtl <- new - h' <- pval (fn h) - --- WARNING: This only makes sense with continuation-stealing.. With child stealing this will go crazy. - fork$ loop t newtl - h'' <- get h' - put outstrm (Cons h'' newtl) - - --- This version exposes pipeline parallelism but no data parallelism. --- It shouldn't be necessary if fork is sufficiently efficient and if --- work stealing is done right. -streamMap :: NFData b => (a -> b) -> Stream a -> Par (Stream b) -streamMap fn instrm = - do outstrm <- new - fork$ loop instrm outstrm - return outstrm - where - loop instrm outstrm = - do - ilst <- get instrm - case ilst of - Null -> put outstrm Null -- End of stream. - Cons h t -> - do newtl <- new - put outstrm (Cons (fn h) newtl) - loop t newtl - - --- | Applies a stateful kernel to the stream. Output stream elements match input one-to-one. --- streamScan :: (NFData b, NFData c) => -streamScan :: (NFData a, NFData b, NFData c) => -- <- TEMP, don't need NFData a in general. - (a -> b -> (a,c)) -> a -> Stream b -> Par (Stream c) -streamScan fn initstate instrm = - do outstrm <- new - fork$ loop initstate instrm outstrm - return outstrm - where -#ifdef DEBUGSTREAMS - -- Create a task log for each unique input stream fed to this function: - tasklog = unsafeNewTaskSeries (nameFromValue instrm) -#endif - - loop state instrm outstrm = - do - ilst <- get instrm - case ilst of - Null -> put outstrm Null -- End of stream. - Cons h t -> - do newtl <- new - let (newstate, outp) = -#ifdef DEBUGSTREAMS - timePure tasklog$ fn state h -#else - fn state h -#endif - put outstrm (Cons outp newtl) - loop newstate t newtl - --- TODO: streamMapM -- monadic version. Define the non-monadic one in --- terms of it and watch for performance regression. - - --- TODO: More flexible version that passes an "emit" function to the --- kernel so that it may produce zero output elements or more than one. --- This also enables nested parallelism within the kernel. --- --- streamKernel :: ((c -> Par ()) -> a -> b -> Par ()) -> a -> Stream b -> Par (Stream c) --- --- ALSO: Can have a "concat" operator for streams of lists where --- streamScan . concat rewrites to streamKernel perhaps... - - - --- | Reduce a stream to a single value. This function will not return --- until it reaches the end-of-stream. -streamFold :: (a -> b -> a) -> a -> Stream b -> Par a -streamFold fn acc instrm = - do ilst <- get instrm - case ilst of - Null -> return acc - Cons h t -> streamFold fn (fn acc h) t - --- | Generate a stream of the given length by applying the function to each index (starting at zero). --- --- WARNING, this source calls yield, letting other par computations --- run, but there is no backpressure. Thus if the source runs at a --- higher rate than its consumer, buffered stream elements accumulate. -generate :: NFData a => Int -> (Int -> a) -> Par (Stream a) --- NOTE: I don't currently know of a good way to do backpressure --- directly in this system... but here are some other options: --- --- (1) we can use timers and look at maximum sustained rate. - --- (2) Also, we can use coarse grained global barriers. That is, we --- can produce some number of output elements, wait until quiescence --- of all Par computations, and then produce more. - --- (3) We can register computations that should only execute when a --- worker goes idle. This is a simple form of priority scheduling. -generate size fn = - do outstrm <- new - fork$ loop (0::Int) outstrm - return outstrm - where - loop n strm | n == size = - do when debugflag (print_$ " [generate] Done. Produced "++ show size++" elements.\n") - put strm Null - return () - loop n strm = - do - newtl <- new - put strm (Cons (fn n) newtl) - P.yield -- This is necessary to avoid starving others when there - -- aren't enough worker threads to go around. - loop (n+1) newtl - - --- | Create a [windowed] stream of consecutive integers. Generates at --- least the target number of elements windowed into segments of a --- specified size. -countupWin :: (Storable a, NFData a, Num a) => - Int -> Int -> Par (WStream a) -countupWin bufsize target = - generate num fn - where - num = case r of 0 -> q - _ -> q+1 - (q,r) = quotRem target bufsize - fn n = - let start = n * bufsize in - array (start,start + bufsize-1) - [(i, fromIntegral (n + fromIntegral i)) - | i <- [start .. start + bufsize-1]] - - - -measureRate :: Stream a -> IO () -measureRate strm = - do lazyls <- toListSpin strm - measureRateList lazyls - -measureRateList :: [a] -> IO () -measureRateList lazyls = - do - t0 <- getTime - print_$ " [measureRate] Counting stream rate starting at time: "++ show t0 - loop t0 t0 (0::Int64) (0::Int64) lazyls - - where - loop _ _ _ n [] = - do print_$ " [measureRate] Hit end of stream after "++show n++" elements." - return () - - loop start time lastN n (h:t) = - do - time2 <- getTime - if time2 - time > one_second then do - (print_$ " [measureRate] current rate: "++show (n+1-lastN) ++ - " Total elems&time "++ commaint (n+1)++ " " ++commaint (time2-start)) --- print_ (show (n+1)) - loop start time2 (n+1) (n+1) t - else do - loop start time lastN (n+1) t - - --- | Use the keyboard to interactively browse through stream elements. -browseStream :: Show a => Stream a -> IO () -browseStream strm = - do putStrLn$ "[browseStream] Beginning interactive stream browser, press enter for more elements:" - ls <- toListSpin strm - loop 0 ls - where - loop n ls = - do putStr$ show n ++ "# " - hFlush stdout - c <- getChar - if c == '\EOT' -- User presses ctrl D to exit. - then putStrLn$ "[browseStream] Ctrl-D pressed, exiting." - else case ls of - [] -> putStrLn$ "[browseStream] Reached end of stream after "++show n++" elements." - (h:t) -> do print h - loop (n+1) t - - --------------------------------------------------------------------------------- --- Conversion: - --- Convert a stream to a lazy list. Spin wait (with yield) until stream elements are available. -toListSpin :: Stream a -> IO [a] -toListSpin strm = - do x <- pollIVar strm - case x of - Nothing -> do Conc.yield -- run other GHC threads - toListSpin strm -- spin wait - Just (ils) -> - case ils of - Null -> return [] - Cons h t -> return (h : unsafePerformIO (unsafeInterleaveIO (toListSpin t))) - - --- TODO: If it is unavailable we should help run the computation and then try again. --- This version will do runParAsync itself: - --- Run a Par computation to produce a stream. Convert that stream to a lazy list. -runParList :: Par (Stream a) -> [a] -runParList = - undefined --- runForList parcomp = loop (runParAsync parcomp) --- where --- loop strm = --- do x <- pollIVar strm --- case x of --- Nothing -> --- -- For now we just spin: --- do yield -- run other GHC threads --- loop strm --- Just (ils) -> --- case ils of --- Null -> return [] --- Cons h t -> return (h : unsafePerformIO (unsafeInterleaveIO (loop t))) - - - - --------------------------------------------------------------------------------- --- Helpers and Scrap: - -print_ msg = trace msg $ return () - -_unsafe_io :: IO a -> Par a -_unsafe_io io = let x = unsafePerformIO io in - x `seq` return x - -_unsafe_dupable :: IO a -> Par a -_unsafe_dupable io = - let x = unsafeDupablePerformIO io in - x `seq` return x - --- This version simply busy-waits to stay on the same core: -measure_freq2 :: IO Word64 -measure_freq2 = do --- let second = 1000 * 1000 * 1000 * 1000 -- picoseconds are annoying - let tenth = 100 * 1000 * 1000 * 1000 -- picoseconds are annoying - coef = 10 - t1 <- rdtsc - start <- getCPUTime - let loop !n !last = - do t2 <- rdtsc - when (t2 < last) $ - putStrLn$ "WARNING, measure_freq2: COUNTERS WRAPPED "++ show (last,t2) - cput <- getCPUTime --- if (cput - start < second) - if (cput - start < tenth) - then loop (n+1) t2 - else return (n,t2) - (n,t2) <- loop 0 t1 - putStrLn$ " Approx getCPUTime calls per second: "++ commaint (coef * n) - when (t2 < t1) $ - putStrLn$ "WARNING: rdtsc not monotonically increasing, first "++show t1++" then "++show t2++" on the same OS thread" - - return$ coef * fromIntegral (t2 - t1) - -commaint :: Integral a => a -> String -commaint n = - reverse $ - concat $ - intersperse "," $ - chunk 3 $ - reverse (show n) - --- Having trouble with this: --- getTime = getCPUTime --- one_second = 1000000000000 -- picoseconds -getTime = rdtsc -one_second = unsafePerformIO$ measure_freq2 - - -instance NFData (U.UArray a b) where - rnf !arr = () - -instance NFData (C.CArray a b) where - rnf !arr = () diff --git a/examples/Makefile b/examples/Makefile deleted file mode 100644 --- a/examples/Makefile +++ /dev/null @@ -1,33 +0,0 @@ -include common.mk - -BENCHMARKS= queens.hs mandel.hs blackscholes.hs nbody.hs parfib.hs primes.hs \ - cholesky.hs parfib.hs coins.hs - -# binomial_lattice.hs -EXES= $(BENCHMARKS:.hs=.exe) - -OTHEREXES= matmult/matmult.exe minimax/minimax.exe sumeuler/sumeuler.exe \ - stream/simple1_measureSrc.exe - -ALLEXES= $(EXES) $(OTHEREXES) - -all: $(EXES) - (cd sumeuler; $(MAKE)) - (cd matmult; $(MAKE)) - (cd minimax; $(MAKE)) - (cd stream; $(MAKE)) - (cd partree; $(MAKE)) - -%.exe : %.hs $(ALLPARSRC) - $(GHC) -O2 --make -i.. $< -o $@ -threaded -rtsopts - -runtests: - ./run_tests.sh $(ALLEXES) - -clean: - rm -f $(ALLEXES) *.o *.hi - (cd sumeuler; $(MAKE) clean) - (cd matmult; $(MAKE) clean) - (cd minimax; $(MAKE) clean) - (cd stream; $(MAKE) clean) - (cd partree; $(MAKE) clean) diff --git a/examples/PortablePixmap.lhs b/examples/PortablePixmap.lhs deleted file mode 100644 --- a/examples/PortablePixmap.lhs +++ /dev/null @@ -1,127 +0,0 @@ - -\begin{verbatim} -ppm(5) FILE FORMATS ppm(5) - -NAME - ppm - portable pixmap file format - -DESCRIPTION - The portable pixmap format is a lowest common denominator - color image file format. The definition is as follows: - - - A "magic number" for identifying the file type. A ppm - file's magic number is the two characters "P3". - - - Whitespace (blanks, TABs, CRs, LFs). - - - A width, formatted as ASCII characters in decimal. - - - Whitespace. - - - A height, again in ASCII decimal. - - - Whitespace. - - - The maximum color-component value, again in ASCII decimal. - - - Whitespace. - - - Width * height pixels, each three ASCII decimal values - between 0 and the specified maximum value, starting at the - top-left corner of the pixmap, proceding in normal English - reading order. The three values for each pixel represent - red, green, and blue, respectively; a value of 0 means - that color is off, and the maximum value means that color - is maxxed out. - - - Characters from a "#" to the next end-of-line are ignored - (comments). - - - No line should be longer than 70 characters. - - Here is an example of a small pixmap in this format: - P3 - # feep.ppm - 4 4 - 15 - 0 0 0 0 0 0 0 0 0 15 0 15 - 0 0 0 0 15 7 0 0 0 0 0 0 - 0 0 0 0 0 0 0 15 7 0 0 0 - 15 0 15 0 0 0 0 0 0 0 0 0 - - Programs that read this format should be as lenient as pos- - sible, accepting anything that looks remotely like a pixmap. - - There is also a variant on the format, available by setting - the RAWBITS option at compile time. This variant is - -Sun Release 4.1 Last change: 15 September 1990 1 - -ppm(5) FILE FORMATS ppm(5) - - different in the following ways: - - - The "magic number" is "P6" instead of "P3". - - - The pixel values are stored as plain bytes, instead of - ASCII decimal. - - - Whitespace is not allowed in the pixels area, and only a - single character of whitespace (typically a newline) is - allowed after the maxval. - - - The files are smaller and many times faster to read and - write. - - Note that this raw format can only be used for maxvals less - than or equal to 255. If you use the ppm library and try to - write a file with a larger maxval, it will automatically - fall back on the slower but more general plain format. - -SEE ALSO - giftoppm(1), gouldtoppm(1), ilbmtoppm(1), imgtoppm(1), - mtvtoppm(1), pcxtoppm(1), pgmtoppm(1), pi1toppm(1), pict- - toppm(1), qrttoppm(1), rawtoppm(1), rgb3toppm(1), - spctoppm(1), sputoppm(1), tgatoppm(1), ximtoppm(1), - xpmtoppm(1), ppmtogif(1), ppmtoicr(1), ppmtoilbm(1), - ppmtopcx(1), ppmtopgm(1), ppmtopi1(1), ppmtopict(1), - ppmtops(1), ppmtopuzz(1), ppmtorgb3(1), ppmtouil(1), - ppmtoxpm(1), ppmhist(1), ppmmake(1), ppmpat(1), ppmquant(1), - ppmquantall(1), ppmrelief(1), pnm(5), pgm(5), pbm(5) - -AUTHOR - Copyright (C) 1989, 1991 by Jef Poskanzer. - -Sun Release 4.1 Last change: 15 September 1990 2 -\end{verbatim} -\begin{code} -module PortablePixmap where - -data PixMap = Pixmap Integer Integer Int [(Int,Int,Int)] - -createPixmap::Integer -> Integer -> Int -> [(Int,Int,Int)] -> PixMap -createPixmap width height max colours = Pixmap width height max colours - -instance Show PixMap where - showsPrec prec (Pixmap x y z rgbs) = showHeader x y z . showRGB rgbs - - -showHeader::Integer -> Integer -> Int -> ShowS -showHeader x y z = showString "P6\n" . showBanner . - shows x . showReturn . - shows y . showReturn . - shows z . showReturn - -showRGB::[(Int,Int,Int)] -> ShowS -showRGB [] = id -showRGB ((r,g,b):rest) = showChar (toEnum r) . - showChar (toEnum g) . - showChar (toEnum b) . - showRGB rest - -showSpace = showChar ' ' -showReturn = showChar '\n' - -showBanner = showString "# Portable pixmap created by Haskell Program :\n" . - showString "#\tPortablePixmap.lhs (Jon.Hill 28/5/92)\n" -\end{code} diff --git a/examples/benchlist.txt b/examples/benchlist.txt deleted file mode 100644 --- a/examples/benchlist.txt +++ /dev/null @@ -1,27 +0,0 @@ -# This is a default set of benchmarks reasonable for a powerful four core machine. - -parfib monad 36 -parfib sparks 36 - -blackscholes 10000 15000000 - -cholesky 1000 50 cholesky_matrix1000.dat - -nbody 13000 - -# mandel 300 300 4000 -mandel 2000 2000 3000000 - -coins 8 1250 - -stream/disjoint_working_sets_pipeline monad 4 256 10 10000 -stream/disjoint_working_sets_pipeline sparks 4 256 10 10000 - -partree/partree 600 20 - -# What should the arguments be here: -# minimax/minimax ? ? - -# These don't match the naming convention at the moment. -matmult/matmult 768 0 64 -sumeuler/sumeuler 38 8000 100 diff --git a/examples/benchmark.sh b/examples/benchmark.sh deleted file mode 100644 --- a/examples/benchmark.sh +++ /dev/null @@ -1,226 +0,0 @@ -#!/bin/bash - -# Runs benchmarks. Simon Marlow has his own setup. This is just temporary. - -# --------------------------------------------------------------------------- -# Usage: [set env vars] ./benchmark.sh - -# Call it with environment variable SHORTRUN=1 to get a shorter run for -# testing rather than benchmarking. - -# Call it with THREADSETTINGS="1 2 4" to run with # threads = 1, 2, or 4. - -# Call it with KEEPGOING=1 to keep going after the first error. - -# Call it with TRIALS=N to control the number of times each benchmark is run. -# --------------------------------------------------------------------------- - - -# Settings: -# ---------------------------------------- - -if [ "$THREADSETTINGS" == "" ] -then THREADSETTINGS="4" -#then THREADSETTINGS="0 1 2 3 4" -fi - -if [ "$GHC" == "" ]; then GHC=ghc; fi - -# HACK: with all the intermachine syncing and different version control systems I run into permissions problems sometimes. -chmod +x ./ntime* ./*.sh - - -# Where to put the timing results: -RESULTS=results.dat -if [ -e $RESULTS ]; -then BAK="$RESULTS".bak.`date +%s` - echo "Backing up old results to $BAK" - mv $RESULTS $BAK -fi - -# How many times to run a process before taking the best time: -if [ "$TRIALS" == "" ]; then - TRIALS=1 -fi - -# Determine number of hardware threads on the machine: - if [ -d /sys/devices/system/cpu/ ]; # linux - then - MAXTHREADS=`ls /sys/devices/system/cpu/ | grep "cpu[0123456789]*$" | wc -l` - echo "Detected the number of CPUs on the machine to be $MAXTHREADS" - elif [ `uname` == "Darwin" ]; - then MAXTHREADS=`sysctl -n hw.ncpu` - else MAXTHREADS=2 - fi - -GHC_FLAGS="$GHC_FLAGS -O2 -rtsopts" -GHC_RTS="$GHC_RTS -qa" - -# ================================================================================ -echo "# TestName Variant NumThreads MinTime MedianTime MaxTime" > $RESULTS -echo "# "`date` >> $RESULTS -echo "# "`uname -a` >> $RESULTS -echo "# "`$GHC -V` >> $RESULTS -echo "# " -echo "# Running each test for $TRIALS trials." >> $RESULTS -echo "# ... with default compiler options: $GHC_FLAGS" >> $RESULTS -echo "# ... with default runtime options: $GHC_RTS" >> $RESULTS - -cnt=0 - -function check_error() -{ - CODE=$1 - MSG=$2 - # Error code 143 was a timeout - if [ "$CODE" == "143" ] - then echo " # Return code $CODE Params: $GHC_FLAGS, RTS $GHC_RTS " | tee -a $RESULTS - echo " # Process TIMED OUT!!" | tee -a $RESULTS - elif [ "$CODE" != "0" ] - then echo " # $MSG" | tee -a $RESULTS - echo " # Error code $CODE Params: $GHC_FLAGS, RTS $GHC_RTS " | tee -a $RESULTS - echo "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" - if [ "$KEEPGOING" == "" ]; - then exit $CODE - fi - fi -} - - -function runit() -{ - cnt=$((cnt+1)) - echo - echo "--------------------------------------------------------------------------------" - echo " Running Config $cnt: $test variant threads $NUMTHREADS " - echo "--------------------------------------------------------------------------------" - echo - echo "(In directory `pwd`)" - if [ "$NUMTHREADS" != "0" ] && [ "$NUMTHREADS" != "" ] - then export RTS=" $GHC_RTS -s -N$NUMTHREADS " - export FLAGS=" $GHC_FLAGS -threaded " - else export RTS="" - export FLAGS=" $GHC_FLAGS " - fi - - CONTAININGDIR=`dirname $test` - - # We compile the test case using runcnc: - if [ -e "$test".hs ]; then - FINALARGS="-i../ -i`dirname $test` $FLAGS $test.hs -o $test.exe" - echo "Compiling with a single GHC command: " - echo " $GHC $FINALARGS" - $GHC $FINALARGS - check_error $? "ERROR: compilation failed." - - elif [ -d "$CONTAININGDIR" ] && - [ "$CONTAININGDIR" != "." ] && - [ -e "$CONTAININGDIR/Makefile" ]; then - echo " ** Benchmark appears in a subdirectory with Makefile. Using it." - echo " ** WARNING: Can't currently control compiler options for this benchmark!" - (cd "$CONTAININGDIR/"; make) - - else - echo "ERROR: File does not exist: $test.hs" - exit 1 - fi - - - echo "Executing $NTIMES $TRIALS $test.exe $ARGS +RTS $RTS -RTS " - if [ "$SHORTRUN" != "" ]; then export HIDEOUTPUT=1; fi - - # One option woud be dynamic feedback where if the first one - # takes a long time we don't bother doing more trials. - - times=`$NTIMES "$TRIALS" ./$test.exe $ARGS +RTS $RTS -RTS` - CODE=$? - - echo " >>> MIN/MEDIAN/MAX TIMES $times" - - check_error $CODE "ERROR: run_all_tests this test failed completely: $test.exe" - - set -- $ARGS - - if [ "$CODE" == "143" ]; - then echo "$test.exe" $1 "$NUMTHREADS" "TIMEOUT TIMEOUT TIMEOUT" >> $RESULTS - elif [ "$CODE" != "0" ] ; - then echo "$test.exe" $1 "$NUMTHREADS" "ERR ERR ERR" >> $RESULTS - else - echo "$test.exe" $1 "$NUMTHREADS" "$times" >> $RESULTS - fi -} - - -echo "Running all tests, for THREADSETTINGS in {$THREADSETTINGS}" -echo - -# Hygiene: -make clean -echo; echo; - -#==================================================================================================== - -function run_benchmark() -{ - set -- $line - test=$1; shift - - if [ "$SHORTRUN" == "" ]; - # If we're in SHORTRUN mode we run each executable with no - # arguments causing it to go to its default (small) problem size. - then ARGS=$* - else ARGS= - fi - - echo "================================================================================" - echo " Running Test: $test.exe $ARGS " - echo "================================================================================" - - echo "# *** Config [$cnt ..], testing with command/args: $test.exe $ARGS " >> $RESULTS - - - for NUMTHREADS in $THREADSETTINGS; do - runit - echo >> $RESULTS; - done # threads - - export NUMTHREADS=0 - - echo >> $RESULTS; - echo >> $RESULTS; -} - -# Read $line and do the benchmark with ntimes_binsearch.sh -function run_binsearch_benchmark() -{ - NTIMES=./ntimes_binsearch.sh - run_benchmark - NTIMES=UNSET -} - -# Read $line and do the benchmark with ntimes_minmedmax -function run_normal_benchmark() -{ - NTIMES=./ntimes_minmedmax - run_benchmark - NTIMES=UNSET -} - - -#==================================================================================================== - - -if [ "$BENCHLIST" == "" ]; -then BENCHLIST="./benchlist.txt" -fi - -echo "Reading benchmarks from $BENCHLIST ..." -cat $BENCHLIST | grep -v "\#" | -while read line -do - if [ "$line" == "" ]; then continue; fi - echo RUNNING BENCH: $line - run_normal_benchmark -done - -echo "Finished with all test configurations." diff --git a/examples/blackscholes.hs b/examples/blackscholes.hs deleted file mode 100644 --- a/examples/blackscholes.hs +++ /dev/null @@ -1,153 +0,0 @@ -{-# LANGUAGE RecordWildCards, CPP, ScopedTypeVariables, FlexibleInstances #-} - --- Ported from CnC/C++ program by Ryan Newton --- Then ported again from the Haskell-CnC interface to monad-par. [2011.02.16] - --- Description --- =========== - --- The Black-Scholes equation is a differential equation that describes how, --- under a certain set of assumptions, the value of an option changes as the --- price of the underlying asset changes. - --- The formula for a put option is similar. The cumulative normal distribution --- function, CND(x), gives the probability that normally distributed random --- variable will have a value less than x. There is no closed form expression for --- this function, and as such it must be evaluated numerically. The other --- parameters are as follows: S underlying asset's current price, --- X the strike price, T time to the expiration date, r risk-less rate of return, --- and v stock's volatility. - --- Usage --- ===== - --- The command line is: - --- blackscholes b n --- b : positive integer for the size of blocks --- n : positive integer for the number of options --- e.g. --- blackscholes 100000 100 4 - -import Control.Seq -import Control.Monad -import Control.DeepSeq -import Control.Exception - -import Control.Monad.Par -import Control.Monad.Par.AList - -import Data.Array -import Data.List -import qualified Data.Array.Unboxed as U -import System.Environment - --------------------------------------------------------------------------------- - -type FpType = Float - --- This tuple contains the inputs for one invocation of our kernel -data ParameterSet = ParameterSet { - sptprice :: FpType, - strike :: FpType, - rate :: FpType, - volatility :: FpType , - otime :: FpType, - otype :: Bool -} deriving Show - -data_init :: Array Int ParameterSet - --- This defines some hard coded data as a big constant array: -#include "blackscholes_data.hs" -size_init = let (s,e) = bounds data_init in e - s + 1 - -inv_sqrt_2xPI = 0.39894228040143270286 - --------------------------------------------------------------------------------- --- Scalar code follows: - -cndf :: FpType -> FpType -cndf inputX = if sign then 1.0 - xLocal else xLocal - where - sign = inputX < 0.0 - inputX' = if sign then -inputX else inputX - - -- Compute NPrimeX term common to both four & six decimal accuracy calcs - xNPrimeofX = inv_sqrt_2xPI * exp(-0.5 * inputX * inputX); - - xK2 = 1.0 / (0.2316419 * inputX + 1.0); - xK2_2 = xK2 * xK2; -- Need all powers of xK2 from ^1 to ^5: - xK2_3 = xK2_2 * xK2; - xK2_4 = xK2_3 * xK2; - xK2_5 = xK2_4 * xK2; - - xLocal = 1.0 - xLocal_1 * xNPrimeofX; - xLocal_1 = xK2 * 0.319381530 + xLocal_2; - xLocal_2 = xK2_2 * (-0.356563782) + xLocal_3 + xLocal_3' + xLocal_3''; - xLocal_3 = xK2_3 * 1.781477937; - xLocal_3' = xK2_4 * (-1.821255978); - xLocal_3'' = xK2_5 * 1.330274429; - - -blkSchlsEqEuroNoDiv :: FpType -> FpType -> FpType -> FpType -> FpType -> Bool -> Float -> FpType -blkSchlsEqEuroNoDiv sptprice strike rate volatility time otype timet = - if not otype - then (sptprice * nofXd1) - (futureValueX * nofXd2) - else let negNofXd1 = 1.0 - nofXd1 - negNofXd2 = 1.0 - nofXd2 - in (futureValueX * negNofXd2) - (sptprice * negNofXd1) - where - logValues = log( sptprice / strike ) - xPowerTerm = 0.5 * volatility * volatility - xDen = volatility * sqrt(time) - xD1 = (((rate + xPowerTerm) * time) + logValues) / xDen - xD2 = xD1 - xDen - - nofXd1 = cndf xD1 - nofXd2 = cndf xD1 - futureValueX = strike * exp ( -(rate) * (time) ) - --------------------------------------------------------------------------------- - - -computeSegment :: Int -> Int -> U.UArray Int FpType -computeSegment granularity t = arr - where - arr = U.listArray (0, granularity-1) $ - Prelude.map fn [0 .. granularity-1] - fn i = let ParameterSet { .. } = data_init U.! ((t+i) `mod` size_init) - in blkSchlsEqEuroNoDiv sptprice strike rate volatility otime otype 0 - --------------------------------------------------------------------------------- - --- No need to go deeper here because its unboxed, right? -instance NFData (U.UArray Int FpType) where - -main = do args <- getArgs - let (numOptions, granularity) = - case args of - [] -> (10000, 1000) - [b] -> (10, read b) - [b,n] -> (read n, read b) - - if granularity > numOptions - then error "Granularity must be bigger than numOptions!!" - else return () - - putStrLn$ "Running blackscholes, numOptions "++ show numOptions ++ " and block size " ++ show granularity - - let numChunks = numOptions `quot` granularity --- results = runPar$ parMap (computeSegment granularity . (* granularity)) [0..numChunks-1] - -#if 1 - results = runPar$ parMap (computeSegment granularity) [0, granularity .. numOptions-1] -#else --- Not working right yet [2011.02.18] - results = toList$ runPar$ - parBuild 1 0 (numChunks-1) - (computeSegment granularity . (* granularity)) -#endif - sum = foldl1' (+) $ map (U.! 0) results - - putStrLn$ "Final checksum: "++ show sum diff --git a/examples/blackscholes_data.hs b/examples/blackscholes_data.hs deleted file mode 100644 --- a/examples/blackscholes_data.hs +++ /dev/null @@ -1,1006 +0,0 @@ --- #include file of test data inpout params and DerivaGem control reference value --- --- S, K, r, q, vol, T, P/C, Divs, DG RefValue - -data_init = listArray (0,999) [ - ParameterSet { sptprice=42.00, strike=40.00, rate=0.1000, volatility=0.20, otime=0.50, otype=True}, - ParameterSet {sptprice=42.00, strike=40.00, rate=0.1000, volatility=0.20, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.15, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.15, otime=1.00, otype=True}, - ParameterSet {sptprice=60.00, strike=65.00, rate=0.0800, volatility=0.30, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, - ParameterSet{sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, - ParameterSet{sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.10, otype=False}, - ParameterSet{sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.1000, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0500, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0725, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.25, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.10, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=0.50, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0825, volatility=0.50, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.10, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.50, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=True}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=True}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=41.25, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=50.00, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.05, otime=0.05, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.15, otime=0.15, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.65, otime=0.75, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.25, otime=0.25, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.35, otime=0.35, otype=False}, - ParameterSet {sptprice=50.00, strike=60.75, rate=0.0275, volatility=0.45, otime=0.40, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.25, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.10, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=0.50, otype=True}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.50, otime=1.00, otype=True}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=90.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=100.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.10, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=0.50, otype=False}, - ParameterSet {sptprice=100.00, strike=110.00, rate=0.1000, volatility=0.10, otime=1.00, otype=False} - ] diff --git a/examples/cholesky.hs b/examples/cholesky.hs deleted file mode 100644 --- a/examples/cholesky.hs +++ /dev/null @@ -1,321 +0,0 @@ -{- - - Intel Concurrent Collections for Haskell - - Copyright (c) 2010, Intel Corporation. - - - - This program is free software; you can redistribute it and/or modify it - - under the terms and conditions of the GNU Lesser General Public License, - - version 2.1, as published by the Free Software Foundation. - - - - This program is distributed in the hope it will be useful, but WITHOUT - - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for - - more details. - - - - You should have received a copy of the GNU Lesser General Public License along with - - this program; if not, write to the Free Software Foundation, Inc., - - 51 Franklin St - Fifth Floor, Boston, MA 02110-1301 USA. - - - -} -{-# LANGUAGE ExistentialQuantification - , ScopedTypeVariables - , BangPatterns - , NamedFieldPuns - , RecordWildCards - , FlexibleInstances - , DeriveDataTypeable - , TypeSynonymInstances - , CPP - #-} - --- Author: Chih-Ping Chen --- Modified by Ryan Newton. - --- This program uses monad-par to do cholesky transformation. - --- Description --- ----------- --- Given a symmetric positive definite matrix A, the Cholesky decomposition is --- a lower triangular matrix L such that A=L.L^(T). - --- Usage --- ----- - --- The command line is: - --- cholesky n b filename --- n : input SPD matrix size --- b : block/tile size --- filename: input matrix file name - --- Several sample input files are provided. m6.in is a 6x6 matrix (n=6). --- Input_matrix.zip contains the files m50.in, m100.in, m500.in, and m1000.in with --- corresponding 'n' of 50, 100, 500, and 1000. - --- e.g. --- cholesky 1000 50 m1000.in 4 --- cholesky v 6 2 m6.in - --- The input SPD matrix is read from the file specified. The output will be a --- lower triangular matrix. - -import Data.Int -import qualified Data.List as List -import qualified Data.Array.Unboxed as Array -import Data.Array.IO -import Data.Array.MArray -import Debug.Trace -import System.Posix.Files -import System.Environment -import System.IO -import System.IO.Unsafe -import Data.Map -import Data.IORef -import qualified Data.ByteString.Char8 as B - -import Control.DeepSeq -import Control.Exception -import Data.Time.Clock -- Not in 6.10 - -import Control.Monad -import Control.Monad.Par - -timeit io = - do strt <- getCurrentTime - io - end <- getCurrentTime - return (diffUTCTime end strt) - --- The type of the input/output array. -type Matrix = Array.UArray (Int, Int) Float - -instance NFData Matrix - --- A matrix is divided into "Tile"s, and carries intermediate results --- of the computation. -type Tile = IOUArray (Int, Int) Float - --- Tile3D allows us to refer to a IVar associated with a tile. The first --- two dimensions of the index are the coordinates of the tile in the matrix. --- The last dimension is the "generation" dimension. I.e., a (IVar Tile) mapped --- by (i, j, k+1) is the next generation of the (IVar Tile) mapped by (i, j, k). -type Tiles3D = Map (Int, Int, Int) (IVar Tile) - -instance NFData Tile where --- SDM: use the default. All we require is that the IOUArray is evaluated, --- since all its contents are unboxed. --- rnf x = unsafePerformIO $ --- do bounds <- getBounds x --- elems <- getElems x --- _ <- return $ rnf (bounds, elems) --- return () - -parMap_ :: (a -> Par ()) -> [a] -> Par () -parMap_ f xs = mapM (spawn . f) xs >> return () - -getTileV :: (Int, Int, Int) -> Tiles3D -> IVar Tile -getTileV triplet tiles = - findWithDefault (error "This can't be happening...") triplet tiles - --- This kicks off cholesky factorization on the diagonal tiles. -s0Compute :: IVar Tiles3D -> Int -> Int -> Par () -s0Compute lkjiv p b = - do lkji <- get lkjiv - parMap_ (s1Compute lkji p b) [0..p-1] - --- This does the cholesky factorization on the a diagonal tile, and --- kicks off triangular system solve on the tiles that are below and --- on the same column as the diagonal tile. -s1Compute :: Tiles3D -> Int -> Int -> Int -> Par () -s1Compute lkji p b k = - do - -- Read the tile: - aBlock <- get $ getTileV (k, k, k) lkji - -- Write an output tile: - put (getTileV (k, k, k+1) lkji) (s1Core aBlock b) - -- Do triangular solves on the tiles with the same column number - parMap_ (s2Compute lkji b) [(k,j) | j <- [k+1..p-1]] - where s1Core aBlock b = unsafePerformIO $ - do lBlock <- newArray ((0,0), (b-1,b-1)) 0.0 - forM_ [0..b-1] (outer aBlock lBlock b) - return lBlock - outer aBlock lBlock b kb = do base <- readArray aBlock (kb,kb) - writeArray lBlock (kb,kb) (sqrt base) - forM_ [kb+1 .. b-1] (inner1 aBlock lBlock kb) - forM_ [kb+1 .. b-1] (inner2 aBlock lBlock kb b) - inner1 aBlock lBlock kb jb = do base1 <- readArray aBlock (jb,kb) - base2 <- readArray lBlock (kb,kb) - writeArray lBlock (jb,kb) (base1 /base2) - inner2 aBlock lBlock kb b jbb = do forM_ [kb+1 .. b-1] (inner3 aBlock lBlock jbb kb) - inner3 aBlock lBlock jbb kb ib = do base1 <- readArray aBlock (ib, jbb) - base2 <- readArray lBlock (ib, kb) - base3 <- readArray lBlock (jbb, kb) - writeArray aBlock (ib,jbb) (base1 - base2 * base3) - --- This does the triangular system solve on a tile T, and --- kicks off the symmetric rank-k update on the tiles that --- are to the right and on the same row as T. -s2Compute :: Tiles3D -> Int -> (Int, Int) -> Par () -s2Compute lkji b (k, j) = - do - aBlock <- get $ getTileV (j,k,k) lkji - liBlock <- get $ getTileV (k,k,k+1) lkji - put (getTileV (j,k,k+1) lkji) (s2Core aBlock liBlock b) - parMap_ (s3Compute lkji b) [(k, j, i) | i <- [k+1..j]] - where s2Core aBlock liBlock b = unsafePerformIO $ - do loBlock <- newArray ((0,0),(b-1,b-1)) 0.0 - forM_ [0..b-1] (outer aBlock liBlock loBlock b) - return loBlock - outer aBlock liBlock loBlock b kb = do forM_ [0..b-1] (inner1 aBlock liBlock loBlock kb) - forM_ [kb+1..b-1] (inner2 aBlock liBlock loBlock b kb) - inner1 aBlock liBlock loBlock kb ib = do base1 <- readArray aBlock (ib,kb) - base2 <- readArray liBlock (kb,kb) - writeArray loBlock (ib,kb) (base1 / base2) - inner2 aBlock liBlock loBlock b kb jb = do forM_ [0..b-1] (inner3 aBlock liBlock loBlock kb jb) - inner3 aBlock liBlock loBlock kb jb ib = do base1 <- readArray aBlock (ib,jb) - base2 <- readArray liBlock (jb,kb) - base3 <- readArray loBlock (ib,kb) - writeArray aBlock (ib,jb) (base1 - (base2 * base3)) - - --- This computes the symmetric rank-k update on a tile. -s3Compute :: Tiles3D -> Int -> (Int, Int, Int) -> Par () -s3Compute lkji b (k,j,i) | i == j = - do - aBlock <- get $ getTileV (j,i,k) lkji - l2Block <- get $ getTileV (j,k,k+1) lkji - put (getTileV (j,i,k+1) lkji) (s3Core aBlock l2Block b) --- pval lkji - return () - where s3Core aBlock l2Block b = unsafePerformIO $ - do forM_ [0..b-1] (outer aBlock l2Block b) - return aBlock - outer aBlock l2Block b jb = do forM_ [0..b-1] (inner1 aBlock l2Block b jb) - inner1 aBlock l2Block b jb kb = do base <- readArray l2Block (jb,kb) - forM_ [jb..b-1] (inner2 aBlock l2Block jb kb (-base)) - inner2 aBlock l2Block jb kb temp ib = do base1 <- readArray aBlock (ib,jb) - base2 <- readArray l2Block (ib,kb) - writeArray aBlock (ib,jb) (base1 + temp * base2) - -s3Compute lkji b (k,j,i) | otherwise = - do - aBlock <- get $ getTileV (j,i,k) lkji - l2Block <- get $ getTileV (i,k,k+1) lkji - l1Block <- get $ getTileV (j,k,k+1) lkji - put (getTileV (j,i,k+1) lkji) (s3Core aBlock l1Block l2Block b) - return () - where s3Core aBlock l1Block l2Block b = unsafePerformIO $ - do forM_ [0..b-1] (outer aBlock l1Block l2Block b) - return aBlock - outer aBlock l1Block l2Block b jb = do forM_ [0..b-1] (inner1 aBlock l1Block l2Block b jb) - inner1 aBlock l1Block l2Block b jb kb = do base <- readArray l2Block (jb,kb) - forM_ [0..b-1] (inner2 aBlock l1Block jb kb (-base)) - inner2 aBlock l1Block jb kb temp ib = do base1 <- readArray aBlock (ib,jb) - base2 <- readArray l1Block (ib,kb) - writeArray aBlock (ib,jb) (base1 + temp * base2) - --- initLkji initialize the (IVar Tile) map using the input array. -initLkji :: Matrix -> Int -> Int -> Int -> Par (IVar Tiles3D) -initLkji arrA n p b = - let tile i j = unsafePerformIO $ newListArray ((0,0),(b-1,b-1)) (tileList i j) - tileList i j = [ arrA Array.! (i * b + ii, j * b + jj) | ii <- [0..b-1], jj <-[0..b-1]] - fn c (i, j, k) | k == 0 = - do mv <- c - m <- get mv - tv <- pval $ tile i j - pval $ insert (i, j, k) tv m - fn c (i, j, k) | otherwise = - do mv <- c - m <- get mv - tv <- new - pval $ insert (i, j, k) tv m - in foldl fn (pval empty) [(i, j, k) | i <- [0..p-1], j <- [0..i], k <- [0..j+1]] - - --- composeResult collect the tiles with the final results back into one single matrix. -composeResult :: Tiles3D -> Int -> Int -> Int -> Par Matrix -composeResult lkji n p b = - do assocs <- sequence [ grab i ib j | i <- [0..p-1], ib <- [0..b-1], j <- [0..i]] - return $ Array.array ((0,0),(n-1,n-1)) (concat assocs) - where grab i ib j = if (i == j) then - do matOut <- get $ getTileV (i,j,j+1) lkji - compose1 matOut - else - do matOut <- get $ getTileV (i,j,j+1) lkji - compose2 matOut - where compose1 matOut = do forM [0..ib] (compose11 matOut) - compose11 matOut jb = let elem = unsafePerformIO $ - do readArray matOut (ib,jb) - in return ((i*b+ib,j*b+jb),elem) - compose2 matOut = do forM [0..b-1] (compose11 matOut) - -{-# INLINE for_ #-} -for_ start end fn | start > end = error "for_: start is greater than end" -for_ start end fn = loop start - where - loop !i | i == end = return () - | otherwise = do fn i; loop (i+1) - -run :: Int -> Int -> Matrix -> Matrix -run n b arrA = - let p = n `div` b - in - runPar $ - do - lkjiv <- initLkji arrA n p b - _ <- s0Compute lkjiv p b - lkji' <- get lkjiv - composeResult lkji' n p b - -main = - do ls <- getArgs - let (n, b, fname) = - case ls of - [] -> (6, 2, "cholesky_matrix6.dat") - - -- To get more data try this: - -- wget http://people.csail.mit.edu/newton/haskell-cnc/datasets/cholesky_matrix_data.tbz - - ["medium"] -> (500, 50, "cholesky_matrix500.dat") - ["big"] -> (1000, 50, "cholesky_matrix1000.dat") - [a,b,c] -> (read a, read b, c) - - bool <- fileExist fname - let fname' = if bool then fname else "examples/"++fname - - ref <- newIORef undefined - let meaningless_write !val = writeIORef ref val - - t1 <- getCurrentTime - putStrLn "Begin reading from disk..." - arrA <- initMatrix n fname' - evaluate arrA - t2 <- getCurrentTime - putStrLn $" ... ArrA read from disk: time " ++ show (diffUTCTime t2 t1) - hFlush stdout - - arrB <- return $ run n b arrA - --putStrLn $ show $ [((i,j),arrB Array.! (i,j)) | i <-[0..n-1], j<-[0..i]] - - putStrLn "Making sure evaluation of arrB is forced..." - evaluate arrB - --putStrLn $ show $ [((i,j),arrB Array.! (i,j)) | i <-[0..n-1], j<-[0..i]] - t3 <- getCurrentTime - --- FIXME: Using deepseq here seems to delay the evaluation to the reference of --- t3 <- case deepseq arrB () of _ -> getCurrentTime --- t3 <- arrB `deepseq` getCurrentTime - putStrLn$ "Finished: eval time "++ show (diffUTCTime t3 t2) - - putStrLn$ "SELFTIMED " ++ show ((fromRational $ toRational $ diffUTCTime t3 t2) :: Double) - t4 <- getCurrentTime - val <- readIORef ref - putStrLn$ "Last value: " ++ show (arrB Array.! (n-1, n-1)) - t5 <- getCurrentTime - putStrLn$ "SELFTIMED' " ++ show ((fromRational $ toRational $ diffUTCTime t5 t4) :: Double) - -initMatrix :: Int -> [Char] -> IO Matrix -initMatrix n fname = - do fs <- B.readFile fname - return $! Array.listArray ((0,0), (n-1, n-1)) - (List.cycle $ List.map (read . B.unpack) (B.words fs)) - diff --git a/examples/cholesky_matrix6.dat b/examples/cholesky_matrix6.dat deleted file mode 100644 --- a/examples/cholesky_matrix6.dat +++ /dev/null @@ -1,1 +0,0 @@ -4 -2 6 8 6 10 -2 10 3 -4 15 1 6 3 14 11 19 22 8 -4 11 33 2 21 6 15 19 2 62 28 10 1 22 21 28 73 diff --git a/examples/coins.hs b/examples/coins.hs deleted file mode 100644 --- a/examples/coins.hs +++ /dev/null @@ -1,240 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -import Data.List -import System.Environment -import Control.Parallel -import Control.Parallel.Strategies -import Control.Applicative -import Control.Monad.Par - --- Rough results, GHC 6.13: (val=777) --- V1 (SDM): 2.2s --- V2 (SDM): 2.7s --- V3 (SDM, parallel): 1.0s on 7 cores --- V4 (original): got bored waiting --- V5 (HWL assoc): 5.2s --- V6 (SDM, Int result): 0.9s --- V7 (SDM, parallel): 0.2s on 7 cores - ------------------------------------------------------------------------------ --- Version 1: returns results as a list of list of coins - -payL :: Int -> [(Int,Int)] -> [Int] -> [[Int]] -payL 0 coins acc = [acc] -payL _ [] acc = [] -payL val ((c,q):coins) acc - | c > val = payL val coins acc - | otherwise = left ++ right - where - left = payL (val - c) coins' (c:acc) - right = payL val coins acc - - coins' | q == 1 = coins - | otherwise = (c,q-1) : coins - ------------------------------------------------------------------------------ --- Version 2: uses a custom AList type to avoid repeated appends - --- The idea here is that by avoiding the append we might be able to --- parallelise this more easily by just forcing evaluation to WHNF at --- each level. I haven't parallelised this version yet, though (V5 --- below is much easier) --SDM - -data AList a = ANil | ASing a | Append (AList a) (AList a) - -lenA :: AList a -> Int -lenA ANil = 0 -lenA (ASing _) = 1 -lenA (Append l r) = lenA l + lenA r - -append ANil r = r -append l ANil = l -- ** -append l r = Append l r - - -- making append less strict (omit ** above) can make the algorithm - -- faster in sequential mode, because it runs in constant space. - -- However, ** helps parallelism. - -payA :: Int -> [(Int,Int)] -> [Int] -> AList [Int] -payA 0 coins acc = ASing acc -payA _ [] acc = ANil -payA val ((c,q):coins) acc - | c > val = payA val coins acc - | otherwise = append left right -- strict in l, maybe strict in r - where - left = payA (val - c) coins' (c:acc) - right = payA val coins acc - coins' | q == 1 = coins - | otherwise = (c,q-1) : coins - ------------------------------------------------------------------------------ --- Version 3: parallel version of V2 - -payA_par :: Int -> Int -> [(Int,Int)] -> [Int] -> AList [Int] -payA_par 0 val coins acc = payA val coins acc -payA_par _ 0 coins acc = ASing acc -payA_par _ _ [] acc = ANil -payA_par depth val ((c,q):coins) acc - | c > val = payA_par depth val coins acc - | otherwise = res - - where - 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 - - coins' | q == 1 = coins - | otherwise = (c,q-1) : coins - ------------------------------------------------------------------------------ --- Version 4: original list-of-list version (very slow) - -pay :: Int -> Int -> [Int] -> [Int] -> [[Int]] -pay _ 0 coins accum = [accum] -pay _ val [] _ = [] -pay pri val coins accum = - res - where -- - coins' = dropWhile (>val) coins - coin_vals = nub coins' - res = concat ( map - ( \ c -> let - new_coins = - ((dropWhile (>c) coins')\\[c]) - in - pay (pri-1) - (val-c) - new_coins - (c:accum) - ) - coin_vals ) - - ------------------------------------------------------------------------------ --- Version 5: assoc-list version (by HWL?) - --- assoc-list-based version; still multiple list traversals -pay1 :: Int -> Int -> [(Int,Int)] -> [(Int,Int)] -> [[(Int,Int)]] -pay1 _ 0 coins accum = [accum] -pay1 _ val [] _ = [] -pay1 pri val coins accum = res - where -- - coins' = dropWhile ((>val) . fst) coins - res = concat ( - map - ( \ (c,q) -> let - -- several traversals - new_coins = - filter (not . (==0) . snd) $ - map (\ x'@(c',q') -> if c==c' then (c',q'-1) else x') $ - dropWhile ((>c) . fst) $ - coins' - new_accum = - map (\ x'@(c',q') -> if c==c' then (c',q'+1) else x') accum - in - pay1 (pri-1) - (val-c) - new_coins - new_accum - ) - coins' ) - ------------------------------------------------------------------------------ --- Version 6: just return the number of results, not the results themselves - -payN :: Int -> [(Int,Int)] -> Int -payN 0 coins = 1 -payN _ [] = 0 -payN val ((c,q):coins) - | c > val = payN val coins - | otherwise = left + right - where - left = payN (val - c) coins' - right = payN val coins - - coins' | q == 1 = coins - | otherwise = (c,q-1) : coins - ------------------------------------------------------------------------------ --- Version 7: parallel version of payN - -payN_par :: Int -> Int -> [(Int,Int)] -> Int -payN_par 0 val coins = payN val coins -payN_par _ 0 coins = 1 -payN_par _ _ [] = 0 -payN_par depth val ((c,q):coins) - | c > val = payN_par depth val coins - | otherwise = res - - where - res = right `par` left `pseq` left + right - - left = payN_par (if q == 1 then (depth-1) else depth) (val - c) coins' - right = payN_par (depth-1) val coins - - coins' | q == 1 = coins - | otherwise = (c,q-1) : coins - ------------------------------------------------------------------------------ - ------------------------------------------------------------------------------ --- Version 8: monad-par version of payN --- Competitive with Version 7. - -payN_mp :: Int -> Int -> [(Int,Int)] -> Int -payN_mp depth val coins = - runPar $ - payN_mpM depth val coins - -payN_mpM :: Int -> Int -> [(Int,Int)] -> Par Int -payN_mpM 0 val coins = return $ payN val coins -payN_mpM _ 0 coins = return 1 -payN_mpM _ _ [] = return 0 -payN_mpM depth val ((c,q):coins) - | c > val = payN_mpM depth val coins - | otherwise = res - - where - res = - do lv <- spawn $ left - r <- right - l <- get lv - return (l + r) - - left = payN_mpM (if q == 1 then (depth-1) else depth) (val - c) coins' - right = payN_mpM (depth-1) val coins - - coins' | q == 1 = coins - | otherwise = (c,q-1) : coins - ------------------------------------------------------------------------------ - - --- driver - -main = do - let vals = [250, 100, 25, 10, 5, 1] - -- let quants = [1, 3, 2, 5, 7, 12] -- small setup - -- let quants = [5, 8, 8, 9, 12, 17] -- std setup - let quants = [55, 88, 88, 99, 122, 177] -- large setup - - let coins = concat (zipWith replicate quants vals) - coins1 = zip vals quants - - [n, arg] <- fmap (fmap read) getArgs - - case n of - -- sequential, list of results - 1 -> print $ length $ payL arg coins1 [] - -- sequential, append-list of results - 2 -> print $ lenA $ payA arg coins1 [] - -- parallel, append-list of results - 3 -> print $ lenA $ payA_par 4 arg coins1 [] - - 4 -> print $ length (pay 0 arg coins []) - 5 -> print $ length (pay1 0 arg coins1 (map (\(c,q) -> (c,0)) coins1)) - 6 -> print $ payN arg coins1 - 7 -> print $ payN_par 4 arg coins1 - 8 -> print $ payN_mp 4 arg coins1 - diff --git a/examples/common.mk b/examples/common.mk deleted file mode 100644 --- a/examples/common.mk +++ /dev/null @@ -1,10 +0,0 @@ - -# RRN: allow setting it via the command line. (I don't have a ghc-testing2 ;-). ) -ifeq (,$(GHC)) - GHC = ghc - # GHC = ghc-testing2 - # GHC = ghc-stable-nightly2 -endif - -ALLPARSRC= ../Control/Monad/Par.hs ../Control/Monad/Par/AList.hs ../Control/Monad/Par/OpenList.hs \ - ../Control/Monad/Par/IList.hs ../Control/Monad/Par/Stream.hs ../Control/Monad/Par/Logging.hs diff --git a/examples/get_cholesky_data.sh b/examples/get_cholesky_data.sh deleted file mode 100644 --- a/examples/get_cholesky_data.sh +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -wget http://people.csail.mit.edu/~newton/haskell-cnc/datasets/cholesky_matrix_data.tbz diff --git a/examples/mandel.hs b/examples/mandel.hs deleted file mode 100644 --- a/examples/mandel.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE BangPatterns, CPP #-} -import System.Environment -import Control.Monad -import Control.Seq -import Data.Complex -import System.IO -import Debug.Trace -import Control.DeepSeq -import Control.Monad.Par -import Control.Exception - -import PortablePixmap -import Control.Monad.Par.AList as A - -mandel :: Int -> Complex Double -> Int -mandel max_depth c = loop 0 0 - where - fn = magnitude - loop i !z - | i == max_depth = i - | fn(z) >= 2.0 = i - | otherwise = loop (i+1) (z*z + c) - - -threshold = 1 - -runMandel :: Double -> Double -> Double -> Double -> Int -> Int -> Int -> Par (AList [Int]) -runMandel minX minY maxX maxY winX winY max_depth = do - - parBuildThreshM threshold (InclusiveRange 0 (winY-1)) $ \y -> - do - let l = [ mandelStep y x | x <- [0.. winX-1] ] - deepseq l (return l) - - where - mandelStep i j = mandel max_depth z - where z = ((fromIntegral j * r_scale) / fromIntegral winY + minY) :+ - ((fromIntegral i * c_scale) / fromIntegral winX + minX) - - r_scale = maxY - minY :: Double - c_scale = maxX - minX :: Double - - -makeImage :: Integer -> Integer -> Int -> AList [Int] -> PixMap -makeImage x y depth ls = - createPixmap x y depth - (map prettyRGB (concat (toList ls))) - where - prettyRGB :: Int -> (Int,Int,Int) - prettyRGB s = let t = (depth - s) in (s,t,t) - -simple x y depth = - runMandel 0 0 x' y' x y depth - where - x' = fromIntegral x - y' = fromIntegral y - --------------------------------------------------------------------------------- - --- A meaningless checksum. -mandelCheck :: AList [Int] -> Int -> Int -> Int -mandelCheck als max_col max_depth = loop 0 als 0 - where - loop i als !sum | A.null als = sum - loop i als !sum = loop (i+1) (A.tail als) - (loop2 i 0 (A.head als) sum) - loop2 i j [] !sum = sum - loop2 i j (h:t) !sum | h == max_depth = loop2 i (j+1) t (sum + i*max_col + j) - | otherwise = loop2 i (j+1) t sum - -main = do args <- getArgs - - let (x,y,depth) = - case args of - [] -> - -- runPar $ simple 3 3 3 - (3,3,3) - - [x,y,depth] -> - -- simple (read x) (read y) (read depth) - (read x, read y, read depth) - - -- [minX,minY,maxX,maxY,winX,winY,depth] -> - -- runPar $ - -- runMandel (read minX) (read minY) - -- (read maxX) (read maxY) - -- (read winX) (read winY) (read depth) - - let ls = runPar$ simple x y depth - when (False) $ do - hnd <- openFile "mandel_image.ppm" WriteMode - hSetBinaryMode hnd True - hPrint hnd (makeImage (fromIntegral x) (fromIntegral y) depth ls) - hClose hnd - - putStrLn$ "Spot check: " ++ show (mandelCheck ls y depth) diff --git a/examples/matmult/ListAux.hs b/examples/matmult/ListAux.hs deleted file mode 100644 --- a/examples/matmult/ListAux.hs +++ /dev/null @@ -1,41 +0,0 @@ -module ListAux where - -import Data.List - - --- splitting into n parts, and its inverse: - -splitIntoN :: Int -> [a] -> [[a]] -splitIntoN n xs = takeIter parts xs - where l = length xs - parts = zipWith (+) ((replicate (l `mod` n) 1) ++ repeat 0) - (replicate n (l `div` n)) -takeIter :: [Int] -> [a] -> [[a]] -takeIter [] [] = [] -takeIter [] _ = error "elements left over" -takeIter (t:ts) xs = hs : takeIter ts rest - where (hs,rest) = splitAt t xs - -unSplit :: [[a]] -> [a] -unSplit = concat - --- splitting into parts of same size. Inverse is concat again. - -splitAtN :: Int -> [a] -> [[a]] -splitAtN n [] = [] -splitAtN n xs = ys : splitAtN n zs - where (ys,zs) = splitAt n xs - ----------------------------------------- - --- splitting round-robin until list runs empty, and its inverse: - -unshuffle :: Int -> [a] -> [[a]] -unshuffle n xs = [takeEach n (drop i xs) | i <- [0..n-1]] - where takeEach n [] = [] - takeEach n (x:xs) = x : takeEach n (drop (n-1) xs) - --- inverse to unshuffle -shuffle :: [[a]] -> [a] -shuffle = concat . transpose - diff --git a/examples/matmult/Makefile b/examples/matmult/Makefile deleted file mode 100644 --- a/examples/matmult/Makefile +++ /dev/null @@ -1,4 +0,0 @@ -include ../common.mk - -matmult.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs - $(GHC) -O2 -cpp --make -i../.. MatMult.hs -o $@ -threaded -rtsopts diff --git a/examples/matmult/MatMult.hs b/examples/matmult/MatMult.hs deleted file mode 100644 --- a/examples/matmult/MatMult.hs +++ /dev/null @@ -1,215 +0,0 @@ -{-# OPTIONS -cpp #-} -{-# LANGUAGE BangPatterns #-} - -{- Matrix multiplication using a torus (gentleman algorithm) -- FR10 -- -} - -{- -RL/JB ParCo2005: eliminate result communication (Maybe-Type) - -JB PhD2008: adapt for simple PhD skeleton tests - -JB MSR07/2008: modified to use all available toroid skeletons. - -JB MSR07/2008: derived a straight-forward GpH program using identical - helpers and strategies - -JB optimised prodEscalar - -JB for ghc-6.9: replaced Control.Parallel.Strategies by a workaround - (reexporting what should work) - --} - -module Main(main) where - -import System.Environment -import Data.List hiding (foldl', foldl1') - -import ListAux -import Control.DeepSeq - -import Control.Monad.Par - -------------------------------------- - -type Vector = [Int] -type Matrix = [Vector] - --- main computation, different versions: -mult :: Int -> Matrix -> Matrix -> Int -> [[Maybe Matrix]] -mult 0 m1 m2 _ = -#ifdef OUTPUT - [[Just $ multMatricesTr m1 (transpose m2)]] -#else - rnf (multMatricesTr m1 (transpose m2)) `seq` [[Nothing]] -#endif -mult v m1 m2 c = results - where results :: [[Maybe Matrix]] -#ifdef OUTPUT - results = [[Just computed]] -#else - results = (rnf computed `seq` [[Nothing]]) -#endif - computed = multMatricesTr m1 m2Tr --- strats' = strats ++ repeat undef - m2Tr = transpose m2 - -prMM' :: (Matrix,Matrix) -> Matrix -prMM' (c,mt) = [[prVV f c | c <- mt]|f <-c] -prVV :: Vector -> Vector -> Int -prVV f c = sum (zipWith (*) f c) - -shiftRight c [] = [] -shiftRight c (xs:xss) = (xs2++xs1):shiftRight (c-1) xss - where (xs1,xs2) = splitAt c xs - -shiftDown c xss = transpose (shiftRight c (transpose xss)) - -join2 :: Matrix -> Matrix -> Matrix -join2 xs ys = zipWith (++) xs ys -join :: [Matrix] -> Matrix -join xss = foldr join2 (repeat []) xss - -splitIntoClusters :: Int -> Matrix -> [[Matrix]] -splitIntoClusters c m | c < 1 = splitIntoClusters 1 m -splitIntoClusters c m1 = mss - where bh = kPartition (length m1) c - bhsplit [] [] = [] - bhsplit [] _ = error "some elements left over" - bhsplit (t:ts) xs = hs : (bhsplit ts rest) - where (hs,rest) = splitAt t xs - ms = bhsplit bh m1 -- blocks of rows - mss = map (colsplit bh) ms - colsplit [] _ = [] - colsplit (t:ts) rs - | head rs == [] = [] - | otherwise = (cab:colsplit ts resto) - where (cab,resto) = unzip (map (splitAt t) rs) - --- mss = map (repartir (length m1 `div` c)) ms --- repartir c xs --- | head xs == [] = [] --- | otherwise = (cab:repartir c resto) --- where (cab,resto) = unzip (map (splitAt c) xs) - --- helper for splitIntoClusters (formerly bresenham) -kPartition :: Int -> Int -> [Int] -kPartition n k = zipWith (+) ((replicate (n `mod` k) 1) ++ repeat 0) - (replicate k (n `div` k)) - - -mult' :: Int -> Int -> ((Matrix,Matrix),[Matrix],[Matrix]) -> (Maybe Matrix,[Matrix],[Matrix]) -mult' nc nr ((sm1,sm2),sm1s,sm2s) -#ifdef OUTPUT - = (Just result,toRight,toDown) -#else - = (rnf result `seq` Nothing ,toRight,toDown) -#endif - where toRight = take (nc-1) (sm1:sm1s) - toDown = take (nr-1) (sm2':sm2s) - sm2' = transpose sm2 - sms = zipWith multMatricesTr (sm1:sm1s) (sm2':sm2s) - result = foldl1' addMatrices sms -- foldr1: not enough demand?? - - -addMatrices :: Matrix -> Matrix -> Matrix -addMatrices m1 m2 = zipWith addVectors m1 m2 - where addVectors :: Vector -> Vector -> Vector - addVectors v1 v2 = zipWith (+) v1 v2 - --- Assumes the second matrix has already been transposed -multMatricesTr :: Matrix -> Matrix -> Matrix -multMatricesTr m1 m2 = - runPar $ parMap (\row -> [prodEscalar2 row col | col <- m2]) m1 - --- JB 2008: a lot faster, directly consuming lists, and tail-recursive (optimised with -O2) -prodEscalar2JB :: Vector -> Vector -> Int -prodEscalar2JB v1 v2 = addProd v1 v2 0 - where addProd :: Vector -> Vector -> Int -> Int - addProd (v:vs) (w:ws) acc = addProd vs ws (acc + v*w) - addProd [] [] n = n - addProd _ _ _ = error "addProd: length does not match" - --- JB 2008: identical when using ghc-6.8.3, avoids bug in ghc-HEAD. Version suggested by SM -prodEscalar2 :: Vector -> Vector -> Int -prodEscalar2 v1 v2 = addProd v1 v2 0 -addProd :: Vector -> Vector -> Int -> Int -addProd (v:vs) (w:ws) !acc = addProd vs ws (acc + v*w) -addProd _ _ !n = n - - -prodEscalar :: Vector -> Vector -> Int -prodEscalar v1 v2 = sum (zipWith (*) v1 v2) - - -------- foldl, strict in head element -foldl1' :: NFData a => (a->a->a) -> [a] -> a -foldl1' f (x:xs) = foldl' f x xs - -foldl' :: NFData a => (a -> b -> a) -> a -> [b] -> a -foldl' f a [] = a -foldl' f a (x:xs) = -- whnf, not enough( (foldl' f) $! (f a x)) xs - let first = f a x - in rnf first `seq` foldl' f first xs - - -usage :: String -> String -usage name = "Cannon's algorithm: Usage:\n\t "++ - name ++ " \n" ++ - "Version selects from " -- ++ show (zip [0..] names) - -main = do - args <- getArgs - let l = length args - if l == 0 then do n <- getProgName - putStrLn (usage n) - putStrLn "\n *** defaults: size 100, seq. computation ***" - else return () --putStrLn "Cannon's algorithm" - - let size = if null args then 100 else read (head args) - opt = if length args < 2 then 0 else read (args!!1) - chunk = if length args < 3 then 1 - else read (args!!2) - a = "Matrices of size " ++ show size ++ --- " with skeleton " ++ ((names++repeat "UNDEF")!!opt) ++ - " using chunk parameter " ++ show chunk ++ "\n" - res = mult opt (mA size) (mB size) chunk - b = multMatricesTr (mA size) (transpose (mB size)) - -- putStrLn a -#ifdef OUTPUT - putStrLn "Output wanted, checking result for correctness..." - let computed = map (map fromJust) res - computed' = concat (map join computed) - printMat computed' - if (b == computed') - then putStrLn "Correct!" - else do putStrLn "WRONG RESULT! Should be" - printMat b -#else - -- putStrLn "No Output, matrix stays distributed." - putStrLn (show res) -#endif - - - -m1 size = replicate size [1..size] -m2 size = listToListList size [1..size*size] -mA size = if size <= 4000 then m1 size else listToListList size (concat (take 20 (repeat [1..(size*size `div` 20)]))) -mB size = if size <= 4000 then m1 size else listToListList size (concat (take 20 (repeat [0,2.. ((size*size) `div` 20)-2]))) -listToListList c m - | length m <= c = [m] - | otherwise = c1 : listToListList c resto - where (c1,resto) = splitAt c m - - -printMat :: Matrix -> IO () -printMat m = putStrLn ("Matrix: " ++ (show (length (head m))) - ++ " x " ++ (show $ length m) ++ "\n" - ++ (showMat m)) - --- instance Show a => Show (Matrix a) where -showMat m_ = "<<" ++ unlines (map (concatMap (\ x -> show x ++ " ")) m_) ++ ">>" - -fromJust :: Maybe a -> a -fromJust (Just x) = x -fromJust Nothing = error "fromJust" diff --git a/examples/matmult/matmult.stdout b/examples/matmult/matmult.stdout deleted file mode 100644 --- a/examples/matmult/matmult.stdout +++ /dev/null @@ -1,1 +0,0 @@ -[[Nothing]] diff --git a/examples/minimax/Board.hs b/examples/minimax/Board.hs deleted file mode 100644 --- a/examples/minimax/Board.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -module Board where - -import Wins - -import Data.List -import Control.Parallel -import Control.Parallel.Strategies -import Control.DeepSeq - -boardDim = 4 - -type Board = [Row] -type Row = [Piece] -data Piece = X | O | Empty deriving (Eq,Show) - -isEmpty Empty = True -isEmpty _ = False - -showBoard :: Board -> String -showBoard board = intercalate "\n--------\n" (map showRow board) ++ "\n" - where showRow r = intercalate "|" (map showPiece r) - -showPiece :: Piece -> String -showPiece X = "X" -showPiece O = "O" -showPiece Empty = " " - -placePiece :: Piece -> Board -> (Int,Int) -> Board -placePiece new board pos - = [[ if (x,y) == pos then new else old - | (x,old) <- zip [1..] row ] - | (y,row) <- zip [1..] board ] - -empty :: (Int,Int) -> Board -> Bool -empty (x,y) board = isEmpty ((board !! (y-1)) !! (x-1)) - -fullBoard b = all (not.isEmpty) (concat b) - -newPositions :: Piece -> Board -> [Board] -newPositions piece board = --- [ placePiece piece board (x,y) | (x,y) <- empties board ] - goRows piece id board - -goRows p rowsL [] = [] -goRows p rowsL (row:rowsR) - = goRow p rowsL id row rowsR ++ goRows p (rowsL . (row:)) rowsR - -goRow p rowsL psL [] rowsR = [] -goRow p rowsL psL (Empty:psR) rowsR - = (rowsL $ (psL $ (p:psR)) : rowsR) : goRow p rowsL (psL . (Empty:)) psR rowsR -goRow p rowsL psL (p':psR) rowsR = goRow p rowsL (psL . (p':)) psR rowsR - -empties board = [ (x,y) | (y,row) <- zip [1..] board, - (x,Empty) <- zip [1..] row ] - - -initialBoard :: Board -initialBoard = replicate boardDim (replicate boardDim Empty) - -data Evaluation = OWin | Score {-# UNPACK #-}!Int | XWin - -- higher scores denote a board in X's favour - deriving (Show,Eq) - -instance NFData Evaluation where - rnf x = x `seq` () - -maxE :: Evaluation -> Evaluation -> Evaluation -maxE XWin _ = XWin -maxE _ XWin = XWin -maxE b OWin = b -maxE OWin b = b -maxE a@(Score x) b@(Score y) | x>y = a - | otherwise = b - -minE :: Evaluation -> Evaluation -> Evaluation -minE OWin _ = OWin -minE _ OWin = OWin -minE b XWin = b -minE XWin b = b -minE a@(Score x) b@(Score y) | x Evaluation -static board = interpret 0 (score board) - -interpret :: Int -> [Evaluation] -> Evaluation -interpret x [] = (Score x) -interpret x (Score y:l) = interpret (x+y) l -interpret x (XWin:l) = XWin -interpret x (OWin:l) = OWin - -scorePiece X = 1 -scorePiece O = -1 -scorePiece Empty = 0 - -scoreString !n [] = n -scoreString !n (X:ps) = scoreString (n+1) ps -scoreString !n (O:ps) = scoreString (n-1) ps -scoreString !n (Empty:ps) = scoreString n ps - -score :: Board -> [Evaluation] -score board = - [ eval (scoreString 0 row) | row <- board ] ++ - [ eval (scoreString 0 col) | col <- transpose board ] ++ - [ eval (scoreString 0 (zipWith (!!) board [0..])), - eval (scoreString 0 (zipWith (!!) board [boardDim-1,boardDim-2 ..])) ] - -{- -#if 0 --- This looks very much like a zipWith f to me -map2 :: (a -> b -> c) -> [a] -> [b] -> [c] -map2 f [] x = [] -map2 f x [] = [] -map2 f (x:xs) (y:ys) = f x y:map2 f xs ys -#endif --} diff --git a/examples/minimax/Game.hs b/examples/minimax/Game.hs deleted file mode 100644 --- a/examples/minimax/Game.hs +++ /dev/null @@ -1,67 +0,0 @@ --- Time-stamp: <2011-02-12 21:11:31 simonmar> ------------------------------------------------------------------------------ - -module Game where - -import Board -import Tree - -import Control.Parallel -import Control.Parallel.Strategies hiding (parMap) -import Debug.Trace - -import Control.Monad.Par - -type Player = Evaluation -> Evaluation -> Evaluation -type Move = (Board,Evaluation) - -alternate :: Int -> Piece -> Player -> Player -> Board -> [Move] -alternate _ _ _ _ b | fullBoard b = [] -alternate _ _ _ _ b | static b == XWin = [] -alternate _ _ _ _ b | static b == OWin = [] -alternate depth player f g board = move : alternate depth opponent g f board' - where - move@(board',eval) = best f possibles scores - scores = runPar $ parMapM (bestMove depth opponent g f) possibles - possibles = newPositions player board - opponent = opposite player - -opposite :: Piece -> Piece -opposite X = O -opposite O = X - - -best :: Player -> [Board] -> [Evaluation] -> Move -best f (b:bs) (s:ss) = best' b s bs ss - where - best' b s [] [] = (b,s) - best' b s (b':bs) (s':ss) | s==(f s s') = best' b s bs ss - | otherwise = best' b' s' bs ss - -showMove :: Move -> String -showMove (b,e) = show e ++ "\n" ++ showBoard b - -bestMove :: Int -> Piece -> Player -> Player -> Board -> Par Evaluation -bestMove depth p f g board - = do - let tree = cropTree $ mapTree static $ prune depth $ searchTree p $ board - parMise 2 f g tree - -cropTree :: (Tree Evaluation) -> (Tree Evaluation) -cropTree (Branch a []) = (Branch a []) -cropTree (Branch (Score x) l) = Branch (Score x) (map cropTree l) -cropTree (Branch x l) = Branch x [] - -searchTree :: Piece -> Board -> (Tree Board) -searchTree p board = repTree (newPositions p) (newPositions (opposite p)) board - -mise :: Player -> Player -> (Tree Evaluation) -> Evaluation -mise f g (Branch a []) = a -mise f g (Branch _ l) = foldr f (g OWin XWin) (map (mise g f) l) - -parMise :: Int -> Player -> Player -> (Tree Evaluation) -> Par Evaluation -parMise 0 f g t = return (mise f g t) -parMise n f g (Branch a []) = return a -parMise n f g (Branch _ l) = do - es <- parMapM (parMise (n-1) g f) l - return (foldr f (g OWin XWin) es) diff --git a/examples/minimax/Main.hs b/examples/minimax/Main.hs deleted file mode 100644 --- a/examples/minimax/Main.hs +++ /dev/null @@ -1,20 +0,0 @@ --- Time-stamp: <2009-05-06 13:54:34 simonmar> ------------------------------------------------------------------------------ - -module Main where - -import System.Environment -import Prog -import Board -import System.Random - -main = do - args <- getArgs - let [n, depth] = case args of - [n, depth] -> [read n, read depth] - _ -> [10,10] - - setStdGen (mkStdGen 99999) - b <- randomBoard n - putStrLn $ showBoard b - putStrLn $ solve depth b diff --git a/examples/minimax/Makefile b/examples/minimax/Makefile deleted file mode 100644 --- a/examples/minimax/Makefile +++ /dev/null @@ -1,4 +0,0 @@ -include ../common.mk - -minimax.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs - $(GHC) -O2 -cpp --make -i../.. Main.hs -o $@ -threaded -rtsopts diff --git a/examples/minimax/Prog.hs b/examples/minimax/Prog.hs deleted file mode 100644 --- a/examples/minimax/Prog.hs +++ /dev/null @@ -1,47 +0,0 @@ --- Time-stamp: <2009-05-06 13:55:20 simonmar> ------------------------------------------------------------------------------ - -module Prog(prog,randomBoard,solve) where - -import Board -import Wins -import Game -import Tree -import System.Random -import Data.List - --- First arg decaffinates game -prog :: Int -> String -prog decaf = showMove (head game) - --"OXO\n" ++ - --concat (map showMove game) - where - game = if decaf == 0 - then error "Decaffination error\n" - else alternate decaf X maxE minE testBoard - --- X to play: find the best move -solve :: Int -> Board -> String -solve depth board - = unlines - . map showMove - . take 1 - . alternate depth X maxE minE $ board - -testBoard = [[Empty,O,Empty,Empty],[Empty,X,Empty,Empty],[Empty,Empty,Empty,Empty],[Empty,Empty,Empty,Empty]] - -randomBoard :: Int -> IO Board -randomBoard moves = do - g <- newStdGen - let (g1,g2) = split g - xs = randomRs (1,boardDim) g1 - ys = randomRs (1,boardDim) g2 - - let - play 0 _ _ board = board - play n (pos:poss) (p:ps) board - | not (empty pos board) = play n poss (p:ps) board - | otherwise = play (n-1) poss ps (placePiece p board pos) - - return $ play moves (zip xs ys) (cycle [X,O]) initialBoard - diff --git a/examples/minimax/Tree.hs b/examples/minimax/Tree.hs deleted file mode 100644 --- a/examples/minimax/Tree.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE CPP #-} -module Tree where - -import Control.Parallel -import Control.Parallel.Strategies - -data Tree a = Branch a [Tree a] deriving Show - -repTree :: (a->[a]) -> (a->[a])-> a -> (Tree a) -repTree f g a = Branch a (map (repTree g f) (f a)) - -#define SEQ - -#ifndef SEQ - -mapTree :: (a -> b) -> Tree a -> Tree b -mapTree f (Branch a l) - = fa `par` Branch fa (map (mapTree f) l `using` myParList) - where fa = f a - -#else {- SEQ -} - -mapTree :: (a -> b) -> (Tree a) -> (Tree b) -mapTree f (Branch a l) = Branch (f a) (map (mapTree f) l) - -#endif - -myParList [] = () -myParList (x:xs) = x `par` myParList xs - -mySeqList [] = () -mySeqList (x:xs) = x `seq` mySeqList xs - -parTree :: Int -> Tree a -> () -parTree 0 (Branch a xs) = () -parTree n (Branch a xs) = a `par` mySeqList (map (parTree (n-1)) xs) - -prune :: Int -> (Tree a) -> (Tree a) -prune 0 (Branch a l) = Branch a [] -prune n (Branch a l) = Branch a (map (prune (n-1)) l) - diff --git a/examples/minimax/Wins.hs b/examples/minimax/Wins.hs deleted file mode 100644 --- a/examples/minimax/Wins.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Wins where - -type Win = [[Int]] - -wins :: [Win] -wins = [win1,win2,win3,win4,win5,win6,win7,win8] - -win1,win2,win3,win4,win5,win6,win7,win8 :: Win -win1 = [[1,1,1], - [0,0,0], - [0,0,0]] - -win2 = [[0,0,0], - [1,1,1], - [0,0,0]] - -win3 = [[0,0,0], - [0,0,0], - [1,1,1]] - -win4 = [[1,0,0], - [1,0,0], - [1,0,0]] - -win5 = [[0,1,0], - [0,1,0], - [0,1,0]] - -win6 = [[0,0,1], - [0,0,1], - [0,0,1]] - -win7 = [[1,0,0], - [0,1,0], - [0,0,1]] - -win8 = [[0,0,1], - [0,1,0], - [1,0,0]] diff --git a/examples/minimax/minimax.stdout b/examples/minimax/minimax.stdout deleted file mode 100644 --- a/examples/minimax/minimax.stdout +++ /dev/null @@ -1,18 +0,0 @@ - |X| | --------- - | | | --------- - |O| | --------- -O| | |X - -Score 2 -X|X| | --------- - | | | --------- - |O| | --------- -O| | |X - - diff --git a/examples/nbody.hs b/examples/nbody.hs deleted file mode 100644 --- a/examples/nbody.hs +++ /dev/null @@ -1,123 +0,0 @@ -{- - - Modified from code released with: - - Intel Concurrent Collections for Haskell - - Copyright (c) 2010, Intel Corporation. - -} -{-# OPTIONS -fglasgow-exts #-} -{-# LANGUAGE ExistentialQuantification - , ScopedTypeVariables - , BangPatterns - , NamedFieldPuns - , RecordWildCards - , FlexibleInstances - , DeriveDataTypeable - , MagicHash - , CPP - #-} --- This is INCOMPATIBLE with CncPure.. - --- Author: Chih-Ping Chen --- Ported to Monad-par by Ryan Newton. - --- This program uses CnC to calculate the accelerations of the bodies in a 3D system. - -import Control.Monad.Par -import Control.Monad -import Data.Int -import qualified Data.List as List -import qualified Data.Array as A -import GHC.Exts -import System.Environment - -type Float3D = (Float, Float, Float) -type UFloat3D = (# Float#, Float#, Float# #) - - --- This step generates the bodies in the system. -genVector tag = (tag' * 1.0, tag' * 0.2, tag' * 30.0) - where tag' = fromIntegral tag - --- We are keeping the idiomatic Haskell version around as well for comparison: --- #define IDIOMATIC_VER - --- Only doing the O(N^2) part in parallel: --- This step computes the accelerations of the bodies. -compute :: A.Array Int Float3D -> A.Array Int (IVar Float3D) -> Int -> Par () -compute vecList accels tag = - do - let myvector = vecList A.! (tag-1) - put (accels A.! tag) (accel myvector vecList) - where - g = 9.8 - - multTriple :: Float -> Float3D -> Float3D - multTriple c ( x,y,z ) = ( c*x,c*y,c*z ) - - pairWiseAccel :: Float3D -> Float3D -> Float3D - pairWiseAccel (x,y,z) (x',y',z') = let dx = x'-x - dy = y'-y - dz = z'-z - eps = 0.005 - -- Performance degredation here: - distanceSq = dx*dx + dy*dy + dz*dz + eps - factor = 1/sqrt(distanceSq * distanceSq * distanceSq) - --- in multTriple factor (dx,dy,dz) - in multTriple factor (dx,dy,dz) -#ifdef IDIOMATIC_VER - sumTriples = foldr (\(x,y,z) (x',y',z') -> (x+x',y+y',z+z')) (0,0,0) - accel vector vecList = multTriple g $ sumTriples $ List.map (pairWiseAccel vector) vecList -#else --- Making this much less idiomatic to avoid allocation: - (strt,end) = A.bounds vecList - - accel :: Float3D -> (A.Array Int Float3D) -> Float3D - accel vector vecList = - - -- Manually inlining to see if the tuples unbox: - let (# sx,sy,sz #) = loop strt 0 0 0 - loop !i !ax !ay !az - | i == end = (# ax,ay,az #) - | otherwise = - let ( x,y,z ) = vector - ( x',y',z' ) = vecList A.! i - - (# dx,dy,dz #) = (# x'-x, y'-y, z'-z #) - eps = 0.005 - distanceSq = dx*dx + dy*dy + dz*dz + eps - factor = 1/sqrt(distanceSq * distanceSq * distanceSq) - - (# px,py,pz #) = (# factor * dx, factor * dy, factor *dz #) - - in loop (i+1) (ax+px) (ay+py) (az+pz) - in ( g*sx, g*sy, g*sz ) -#endif - - -run :: Int -> [Float3D] -run n = runPar $ - do - vars <- sequence$ take n $ repeat new --- accels <- A.array (0,n-1) [ (i,) | i <- [0..n-1]] - -- Is there a better way to make an array of pvars? - let accels = A.array (1,n) (zip [1..n] vars) - -#ifdef IDIOMATIC_VER - let initVecs = List.map genVector [1..n] -#else - let initVecs = A.array (0,n-1) [ (i, genVector i) | i <- [0..n-1] ] -#endif - - forM_ [1..n] $ \ t -> fork (compute initVecs accels t) - - sequence (List.map (\i -> get (accels A.! i)) [1..n]) - - -main = - do args <- getArgs - let accList = case args of - [] -> run (3::Int) - [s] -> run (read s) - putStrLn $ show (foldl (\sum (x,y,z) -> if x>0 then sum+1 else sum) 0 accList) - - diff --git a/examples/ntimes b/examples/ntimes deleted file mode 100644 --- a/examples/ntimes +++ /dev/null @@ -1,153 +0,0 @@ -#!/bin/bash -# --------------------------------------------------------------------------- -# Intel Concurrent Collections for Haskell -# Copyright (c) 2010, Intel Corporation. -# -# This program is free software; you can redistribute it and/or modify it -# under the terms and conditions of the GNU Lesser General Public License, -# version 2.1, as published by the Free Software Foundation. -# -# This program is distributed in the hope it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for -# more details. -# -# You should have received a copy of the GNU Lesser General Public License along with -# this program; if not, write to the Free Software Foundation, Inc., -# 51 Franklin St - Fifth Floor, Boston, MA 02110-1301 USA. -# --------------------------------------------------------------------------- - - -# Usage: ntimes cmd args ... - -# Takes the best time out of N. -# Returns that best time in seconds to stdout. - -# This script writes a bunch of stuff to stderr, but only one thing to -# stdout. The one thing, the "return value" of this process is the -# best time in seconds. - -# Responds to the environment variable HIDEOUTPUT, which, if non-empty -# suppresses echoing of the child command's output. - -# Also responds to NOTIME which turns off the timing. - - -# Time out processes after three minutes. -TIMEOUT=1000 - -# Unfortunately 'tempfile' is not a standard command: -function mytempfile { - date=`date +"%Y.%m.%d"` - secs=`date +"%s"` - #index=$(($index+1)) - index=$1 - file=./runs/"$date"_"$base"_"$CNC_VARIANT"_"$CNC_SCHEDULER"_"$NUMTHREADS"_"$secs"_"$index".log - touch $file - echo $file -} - -N=$1 -shift -CMD=$* - -if [ "$CMD" == "" ]; -then echo Usage: "ntimes ..." - exit 1 -fi -base=`basename $1` - -if [ ! -d "./runs" ]; then mkdir ./runs; fi - -CAT=/bin/cat - - # This serves as the log - TMP1=`mytempfile 1` - echo "Execution log file: " >> /dev/stderr - echo " $TMP1" >> /dev/stderr - - #echo "=================== ASYNCHRONOUS TEST OUTPUT TO FOLLOW ======================" > $TMP1 - - # if [ "$HIDEOUTPUT" == "" ]; - # then (tail -f $TMP1 >> /dev/stderr) & - # fi - -EXITCODE=0 - - for ((i=1; i <= $N; i++)); do - # Stores just this one executable's output: - TMP2=`mytempfile 2` - -# [2009.12.17] I need to get a good cross-platform process time-out system: - # HACK: Sometimes I run this on systems WITHOUT a working GHC: - if [ -e ./timeout.sh ]; - then TIMEOUTRUN="./timeout.sh -t $TIMEOUT" - elif [ -e ./timeout ]; - # [2010.06.03] --RTS is a hack for working around a problem with +RTS flags: - then TIMEOUTRUN="./timeout $TIMEOUT --RTS " - else TIMEOUTRUN= - fi - - if [ "$HIDEOUTPUT" == "" ]; - then MYOUT=/dev/stderr - else MYOUT=/dev/null - fi - - echo | tee -a $TMP2 >> $MYOUT - echo "Running trial $i of $N:" | tee -a $TMP2 >> $MYOUT - echo "------------------------------------------------------------" | tee -a $TMP2 >> $MYOUT - - # This is hackish, it depends on the program output not containing - # the string "real". (Aside from the timing results.) - - if [ "$NOTIME" != "" ]; - then ($TIMEOUTRUN $CMD) &> /dev/stdout | tee -a $TMP2 >> $MYOUT; CODE=${PIPESTATUS[0]} - elif [ `uname` == "Linux" ]; - then (/usr/bin/time --format="%e real" $TIMEOUTRUN $CMD) &> /dev/stdout | tee -a $TMP2 >> $MYOUT; CODE=${PIPESTATUS[0]} - else (/usr/bin/time $TIMEOUTRUN $CMD) &> /dev/stdout | tee -a $TMP2 >> $MYOUT; CODE=${PIPESTATUS[0]} - fi - - # If there was an error, we don't commit the output to $TMP1: - if [ "$CODE" == "0" ]; - then echo " Run $i of command succeeded" >> /dev/stderr - - # SUPERHACK terrain... Here's a special symbol that the script can - # use to override the external timing and use internal timing - # mechinasms. - selftime=`grep SELFTIME $TMP2` - if [ "$selftime" != "" ]; then - echo " +++ Executable appears self-timed!!:" >> $MYOUT - echo "$selftime" >> $MYOUT - cat $TMP2 | grep -v "real" | sed 's/SELFTIMED/real/' >> $TMP1 - else - cat $TMP2 >> $TMP1 - fi - - - # [2010.05.11] I used to just give warnings when not ALL of the trials failed: - # This was for timing the nondeterministic hashtable hack: - #else echo "Warning: run $i of command failed with code $CODE: $CMD" >> /dev/stderr - else echo "ERROR run $i of command failed with code $CODE: $CMD" >> /dev/stderr - #exit $CODE - EXITCODE=$CODE - fi - - rm -f $TMP2 -done; - - # Stores the times: - TMP3=`mytempfile 3` - - # HACK HACK: this assumes the string "real" doesn't occur in the test output. - grep real $TMP1 | awk '{ print $1" "$2 }' | sort -n > $TMP3 - - # Echo the final output to stdout: - - echo "Final Timings: " > /dev/stderr - - cat $TMP3 | sed 's/real //' | sed 's/ real//' - - # Leave behind only $TMP1 - rm -f $TMP3 - -exit $EXITCODE diff --git a/examples/ntimes_minmedmax b/examples/ntimes_minmedmax deleted file mode 100644 --- a/examples/ntimes_minmedmax +++ /dev/null @@ -1,38 +0,0 @@ -#!/bin/bash -# --------------------------------------------------------------------------- -# Intel Concurrent Collections for Haskell -# Copyright (c) 2010, Intel Corporation. -# -# This program is free software; you can redistribute it and/or modify it -# under the terms and conditions of the GNU Lesser General Public License, -# version 2.1, as published by the Free Software Foundation. -# -# This program is distributed in the hope it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for -# more details. -# -# You should have received a copy of the GNU Lesser General Public License along with -# this program; if not, write to the Free Software Foundation, Inc., -# 51 Franklin St - Fifth Floor, Boston, MA 02110-1301 USA. -# --------------------------------------------------------------------------- - -ntimes=`dirname $0`/ntimes - -times=`$ntimes $*` -CODE=$? -if [ "$CODE" != "0" ]; -then exit $CODE -fi - -lines=`echo $times | xargs -n1 echo | wc -l` -half=$((($lines+1)/2)) - -echo "Median time (of $lines): " >> /dev/stderr -#echo "Median time of: $times" >> /dev/stderr - -MIN=`echo $times | xargs -n1 echo | sort -n | head -n1` -MED=`echo $times | xargs -n1 echo | sort -n | head -n$half | tail -n1` -MAX=`echo $times | xargs -n1 echo | sort -n | tail -n1` - -echo $MIN $MED $MAX diff --git a/examples/parfib.hs b/examples/parfib.hs deleted file mode 100644 --- a/examples/parfib.hs +++ /dev/null @@ -1,74 +0,0 @@ - -import Data.Int -import System.Environment --- import Control.Monad.Par -import Control.Monad.ParElision -import GHC.Conc - -type FibType = Int64 - --- sequential version of the code -fib :: FibType -> FibType -fib 0 = 1 -fib 1 = 1 -fib x = fib (x-2) + fib (x-1) + 1 - - --- Basic, non-monadic parallel-fib: -parfib0 :: FibType -> FibType -parfib0 n | n < 2 = 1 -parfib0 n = x `par` y `pseq` (x+y) - where - x = parfib0 (n-1) - y = parfib0 (n-2) - - - -parfib1 :: FibType -> Par FibType -parfib1 n | n < 2 = return 1 -parfib1 n = - do - xf <- spawn_$ parfib1 (n-1) - y <- parfib1 (n-2) - x <- get xf - return (x+y) - -main = do args <- getArgs - let (version,size) = - case args of - [] -> ("monad",10) - [v,n] -> (v,read n) - - case version of - "monad" -> do - putStrLn "Monad-par based version:" - print$ runPar$ parfib1 size - "sparks" -> do - putStrLn "Sparks-based, Non-monadic version:" - print$ parfib0 size - _ -> error$ "unknown version: "++version - - -{- On 4-core nehalem, 3.33ghz: - - Non-monadic version, real/user time: - fib(40) 4 threads: 1.1s 4.4s - fib(42) 4 threads: 2.9s 11.6s 17GB allocated - - SPARKS: 433784785 (290 converted, 280395620 pruned) - - Monad-par version: - fib(38) non-threaded: 23.3s 23.1s - fib(38) 1 thread : 24.7s 24.5s - fib(38) 4 threads: 8.2s 31.3s - - fib(40) 4 threads: 20.6s 78.6s 240GB allocated - - -For comparison, Cilkarts Cilk++: - fib(42) 4 threads: 3.029s 23.610s - -Intel Cilk Plus: - fib(42) 4 threads: 4.212s 16.770s - --} diff --git a/examples/partree/Makefile b/examples/partree/Makefile deleted file mode 100644 --- a/examples/partree/Makefile +++ /dev/null @@ -1,4 +0,0 @@ -include ../common.mk - -partree.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs - $(GHC) -O2 -cpp --make -i../.. partree.hs -o $@ -threaded -rtsopts diff --git a/examples/partree/Tree.hs b/examples/partree/Tree.hs deleted file mode 100644 --- a/examples/partree/Tree.hs +++ /dev/null @@ -1,146 +0,0 @@ --- -*- haskell -*- --- --- ADT of a binary tree (values only in leaves). --- Parallel functions use par and seq directly. --- --------------------------------------------------------------------------- - -module Tree(Tree, - list2tree, tree2list, (^:), - tree_map, tree_fold, - depth, create_forest, - force_tree, par_tree_map) where - -import Control.Parallel -import Control.Parallel.Strategies -import Control.Monad.Par - -infixl 2 ^: - -data Tree a = Leaf a - | Node (Tree a) (Tree a) - deriving (Eq, Read, Show) - - -tree_map :: (Integral a, Integral b) => (a -> b) -> Tree a -> Tree b -tree_map f (Leaf x) = Leaf (f x) -tree_map f (Node left right) = Node (tree_map f left) (tree_map f right) - - -par_tree_map :: (Integral a, Integral b) => (a -> b) -> Tree a -> Tree b -par_tree_map f t = - runPar $ par_tree_map' f t - -par_tree_map' :: (Integral a, Integral b) => (a -> b) -> Tree a -> Par (Tree b) -par_tree_map' f (Leaf x) = return $ Leaf (f x) -par_tree_map' f (Node left right) = - do l' <- spawn_ $ par_tree_map' f left - r <- par_tree_map' f right - l <- get l' - return (Node l r) - --- force evaluation of tree (could use Strategies module instead!) -force_tree :: (Integral a) => Tree a -> () -force_tree t@(Leaf x) = x `seq` () -force_tree t@(Node left right) = (force_tree left) `seq` - (force_tree right) `seq` - () --- just would you'd expect -tree_fold :: (Integral a) => (a -> a -> a) -> a -> Tree a -> a -tree_fold o z (Leaf x) = z `o` x -tree_fold o z (Node left right) = tree_fold o z' right - where z' = tree_fold o z left - -list2tree :: (Integral a) => [a] -> Tree a -list2tree [] = error "list2tree: empty list" -list2tree [x] = Leaf x -list2tree l = Node (list2tree left) (list2tree right) - where (left,right) = splitAt ((length l) `div` 2 ) l - -tree2list :: (Integral a) => Tree a -> [a] -tree2list (Leaf x) = [x] -tree2list (Node left right) = tree2list left ++ tree2list right - --- combine 2 trees -(^:) :: (Integral a) => Tree a -> Tree a -> Tree a -t1 ^: t2 = Node t1 t2 - -depth :: Tree a -> Int -depth (Leaf _) = 0 -depth (Node left right) = max (depth left) (depth right) + 1 - --- The following functions are useful for heavily heap allocating test fcts -create_forest :: (Integral a) => Tree a -> [Tree a] -create_forest (Leaf x) = [ (Leaf y) | y <- [2..x], gcd x y == 1 ] -create_forest (Node left right) = [ (Node left' right') - | left' <- create_forest left, - right' <- create_forest right] - -{- -On a Harpertown Windows machine with 4 cores (8 threads), using -Haskell Platform 2011.2.0.0. -Note the CPU utilization rates (elapsed time * num_of_threads/CPU time) -range between 70% and 77% when -N > 1. - -Compare that with Strategies, which has a higher CPU utilization rate -(> 95%) and a smaller user time for -N > 1. - -E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N1 -partree 1000 10 = 23712 - -Fri Mar 18 13:56:45 2011 -Cmd: partree.exe 1000 10 +RTS -N1 -Elapsed: 4.898 sec -User 4.867 sec -System 0.016 sec -Total CPU 4.883 sec -Peak WorkingSet Size: 7229440 -Peak Pagefile Usage: 5836800 -Page Fault Count: 1806 -Peak Paged Pool usage: 85688 -Peak NonPaged Pool usage: 5568 - -E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N2 -partree 1000 10 = 23712 - -Fri Mar 18 13:56:54 2011 -Cmd: partree.exe 1000 10 +RTS -N2 -Elapsed: 9.313 sec -User 12.605 sec -System 1.841 sec -Total CPU 14.446 sec -Peak WorkingSet Size: 12619776 -Peak Pagefile Usage: 10133504 -Page Fault Count: 3122 -Peak Paged Pool usage: 85688 -Peak NonPaged Pool usage: 6048 - -E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N4 -partree 1000 10 = 23712 - -Fri Mar 18 13:57:07 2011 -Cmd: partree.exe 1000 10 +RTS -N4 -Elapsed: 9.968 sec -User 22.761 sec -System 5.756 sec -Total CPU 28.517 sec -Peak WorkingSet Size: 13414400 -Peak Pagefile Usage: 11677696 -Page Fault Count: 3317 -Peak Paged Pool usage: 85688 -Peak NonPaged Pool usage: 6720 - -E:\cchen15\icfp\partree-mp>timeit partree.exe 1000 10 +RTS -N8 -partree 1000 10 = 23712 - -Fri Mar 18 13:57:25 2011 -Cmd: partree.exe 1000 10 +RTS -N8 -Elapsed: 9.843 sec -User 46.239 sec -System 11.029 sec -Total CPU 57.268 sec -Peak WorkingSet Size: 14729216 -Peak Pagefile Usage: 15175680 -Page Fault Count: 3637 -Peak Paged Pool usage: 85688 -Peak NonPaged Pool usage: 7968 --} diff --git a/examples/partree/partree.hs b/examples/partree/partree.hs deleted file mode 100644 --- a/examples/partree/partree.hs +++ /dev/null @@ -1,34 +0,0 @@ --- -*- haskell -*- --- partree --- parallel map over a tree ------------------------------------------------------------------------------ - -module Main where - -import System.Environment(getArgs) -import Control.Parallel -import Tree - -main = do [arg1,arg2] <- getArgs - let - n = read arg1 :: Int -- size of tree in nodes - c = read arg2 :: Int -- work per node - res = partree c n - putStrLn ("partree " ++ unwords [arg1,arg2] ++ " = " ++ show res) - --- worker function to be mapped over the tree; heavily allocating! -bar :: Int -> Int -> Int -bar c n = tree_fold (\x y -> (x+y) `quot` 2) 0 t - where forest = [ let - l = take n (iterate (+i) i) - in - list2tree l - | i <- [1..c + n `mod` 15] ] - t = foldl1 (^:) forest - --- generate a tree with n nodes; --- then map and fold 2 functions over it -partree :: Int -> Int -> Int -partree c n = (force_tree t) `seq` (tree_fold max 0 t) - where t = par_tree_map (bar c) (list2tree [1..n]) - diff --git a/examples/plot_scaling.hs b/examples/plot_scaling.hs deleted file mode 100644 --- a/examples/plot_scaling.hs +++ /dev/null @@ -1,355 +0,0 @@ -#!/usr/bin/env runhaskell -{-# LANGUAGE NamedFieldPuns - #-} - --- This script generates gnuplot plots. --- Give it a .dat file as input... (or it will try to open results.dat) - - -import Text.PrettyPrint.HughesPJClass -import Text.Regex -import Data.List -import Data.Function -import Control.Monad -import System -import System.IO -import System.FilePath -import System.Environment - -import HSH -import Data.Array (listArray, ) -import Data.Monoid (mappend, ) -import Debug.Trace - - -linewidth = "5.0" - --- Schedulers that we don't care to graph right now. --- This happens BEFORE rename ---scheduler_MASK = [5,6,99,10] -scheduler_MASK = [] - --- Ok, gunplot line type 6 is YELLOW... that's not to smart: -line_types = [0..5] ++ [7..] - -round_2digits :: Double -> Double -round_2digits n = (fromIntegral $round (n * 100)) / 100 - ---x11 = terminal Terminal.X11.cons ---x11 = terminal cons ---x11 = terminal Graphics.Gnuplot.Terminal.X11.cons ---x11 = terminal X11.cons - --- Split -parse [a,b,c,d,e,f] = - Entry { name = a, - variant = b, - sched = "trace", - threads = read c, - tmin = read d, - tmed = read e, - tmax = read f, - normfactor = 1.0 - } - ---parse [a,b,c,d,e,f,g,h,i] = --- trace ("Got line with norm factor: "++ show [a,b,c,d,e,f,g,h,i]) --- (parse [a,b,c,d,e,f,g,h]) { normfactor = read i } - -parse other = error$ "Cannot parse, wrong number of fields, "++ show (length other) ++" expected 8 or 9: "++ show other - - --------------------------------------------------------------------------------- --- Let's take a particular interpretation of Enum for pairs: -instance (Enum t1, Enum t2) => Enum (t1,t2) where - succ (a,b) = (succ a, succ b) - pred (a,b) = (pred a, pred b) - toEnum n = (toEnum n, toEnum n) - fromEnum (a,b) = case (fromEnum a, fromEnum b) of - (x,y) | x == y -> x - (x,y) -> error$ "fromEnum of pair: nonmatching numbers: " ++ show x ++" and "++ show y - - --- Removes single blanks and separates lines into groups based on double blanks. -sepDoubleBlanks :: [String] -> [[String]] -sepDoubleBlanks ls = loop [] ls - where - loop acc [] = [reverse acc] - loop acc ("":"":t) = reverse acc : loop [] (stripLeadingBlanks t) - loop acc ("":t) = loop acc t - loop acc (h :t) = loop (h:acc) t - stripLeadingBlanks [] = [] - stripLeadingBlanks ("":t) = stripLeadingBlanks t - stripLeadingBlanks ls = ls - - -remComments :: String -> [String] -> [String] -remComments commentchars ls = filter (pred . stripLeadingWhitespace) ls - where - pred str = not (take (length commentchars) str == commentchars) - stripLeadingWhitespace [] = [] - stripLeadingWhitespace (' ':t) = stripLeadingWhitespace t - stripLeadingWhitespace ls = ls - --------------------------------------------------------------------------------- - --- Here's the schema for the data from my timing tests: -data Entry = Entry { - name :: String, - variant :: String, - sched :: String, - threads :: Int, - tmin :: Double, - tmed :: Double, - tmax :: Double, - normfactor :: Double -} - deriving Show - -instance Pretty Entry where - --pPrint x = pPrint$ show x - pPrint Entry { name, sched, variant, threads, tmin, tmed, tmax, normfactor } = - pPrint ("ENTRY", name, sched, variant, threads, (tmin, tmed, tmax), normfactor ) --- pPrint ("ENTRY", name, variant, sched, threads, tmin, tmed, tmax, normfactor) - - -groupSort fn = - (groupBy ((==) `on` fn)) . - (sortBy (compare `on` fn)) - --- Add three more levels of list nesting to organize the data: ---organize_data :: [Entry] -> [[[[Entry]]]] -organize_data :: [Entry] -> [[[[Entry]]]] -organize_data = - (map (map (groupSort sched))) . - (map (groupSort variant)) . - (groupSort name) - - -newtype Mystr = Mystr String - -instance Show Mystr where - show (Mystr s) = s - -{- --- I ended up giving up on using the gnuplot package on hackage: --- mypath :: Graph2D.T ---Plot2D.T ---plot_benchmark :: [[[Entry]]] -> IO () ---plot_benchmark :: [[[Entry]]] -> Plot2D.T -plot_benchmark [io, pure] = - --Plot.plot (X11.title "foobar" X11.cons) $ - Plot.plot X11.cons $ - Frame.cons (Opts.title ("Benchmark: " ++ benchname ++ " normalized to time " ++ show basetime) $ Opts.deflt) plots - where - benchname = name $ head $ head io - plots = foldl1 mappend (map persched io ++ map persched pure) - basetime = foldl1 min $ map tmed $ - filter ((== 0) . threads) $ - (concat io ++ concat pure) - persched :: [Entry] -> Plot2D.T - persched dat = - let - schd = sched$ head dat - var = variant$ head dat - mins = map tmin dat - meds = map tmed dat - maxs = map tmax dat - --zip4 = map$ \ a b c d -> (a,b,c,d) - zip4 s1 s2 s3 s4 = map (\ ((a,b), (c,d)) -> (a,b,c,d)) - (zip (zip s1 s2) (zip s3 s4)) - pairs = zip4 (map (fromIntegral . threads) dat) - (map (basetime / ) meds) - (map (basetime / ) mins) - (map (basetime / ) maxs) - quads = map (\ (a,b,c,d) -> Mystr (show a ++" "++ show b ++" "++ show d ++" "++ show c)) - pairs - in - fmap (Graph2D.lineSpec $ - LineSpec.title (var ++"/"++ show schd) $ - LineSpec.lineWidth 3.0 $ - LineSpec.pointSize 3.0 $ - LineSpec.deflt) $ - fmap (Graph2D.typ Graph2D.linesPoints) $ - --Plot2D.path pairs - --Plot2D.path (map ( \ (a,b,c,d) -> (a,b)) pairs) - --fmap (Graph2D.typ Graph2D.errorBars) $ - Plot2D.list quads --} - --- Name, Scheduler, Threads, BestTime, Speedup -data Best = Best (String, String, String, Int, Double, Double) - --- Plot a single benchmark as a gnuplot script: -plot_benchmark2 root [io, pure] = - do action $ filter goodSched (io ++ pure) - return$ Best (benchname, bestvariant, - bestsched, bestthreads, best, basetime / best) - where - benchname = name $ head $ head io - -- What was the best single-threaded execution time across variants/schedulers: - - goodSched [] = error "Empty block of data entries..." - goodSched (h:t) = not $ (sched h) `elem` scheduler_MASK - - cat = concat io ++ concat pure - threads0 = filter ((== 0) . threads) cat - threads1 = filter ((== 1) . threads) cat - - map_normalized_time = map (\x -> tmed x / normfactor x) - - times0 = map_normalized_time threads0 - times1 = map_normalized_time threads1 - - basetime = if not$ null times0 - then foldl1 min times0 - else if not$ null times1 - then foldl1 min times1 - else error$ "\nFor benchmark "++ show benchname ++ " could not find either 1-thread or 0-thread run.\n" ++ - --"ALL entries: "++ show (pPrint cat) ++"\n" - "\nALL entries threads: "++ show (map threads cat) - - best = foldl1 min $ map_normalized_time cat - Just best_index = elemIndex best $ map_normalized_time cat - bestsched = sched$ cat !! best_index - bestvariant = variant$ cat !! best_index - bestthreads = threads$ cat !! best_index - - (filebase,_) = break (== '.') $ basename benchname - - -- If all normfactors are the default 1.0 we print a different message: - --let is_norm = not$ all (== 1.0) $ map normfactor ponits - norms = map normfactor (concat io ++ concat pure) - default_norms = all (== 1.0) $ norms - max_norm = foldl1 max norms - - scrub '_' = ' ' - scrub x = x - -- scrub [] = [] - -- scrub ('_':t) = "\\_"++ scrub t - -- scrub (h:t) = h : scrub t - - action lines = - do - let scriptfile = root ++ filebase ++ ".gp" - putStrLn$ " Dumping gnuplot script to: "++ scriptfile - - putStrLn$ " NORM FACTORS "++ show norms - - - runIO$ echo "set terminal postscript enhanced color\n" -|- appendTo scriptfile - runIO$ echo ("set output \""++filebase++".eps\"\n") -|- appendTo scriptfile - runIO$ echo ("set title \"Benchmark: "++ map scrub filebase ++ - ", speedup relative to serial time " ++ show (round_2digits $ basetime * max_norm) ++" seconds "++ --- "for input size " ++ show (round_2digits max_norm) - (if default_norms then "" else "for input size " ++ show (round max_norm)) - --if is_norm then "normalized to work unit" - --if default_norms then "" else " per unit benchmark input" - ++"\"\n") -|- appendTo scriptfile - runIO$ echo ("set xlabel \"Number of Threads\"\n") -|- appendTo scriptfile - runIO$ echo ("set ylabel \"Parallel Speedup\"\n") -|- appendTo scriptfile - - - runIO$ echo ("set xrange [1:]\n") -|- appendTo scriptfile - runIO$ echo ("set key left top\n") -|- appendTo scriptfile - runIO$ echo ("plot \\\n") -|- appendTo scriptfile - - -- In this loop lets do the errorbars: - forM_ (zip [1..] lines) $ \(i,points) -> do - let datfile = root ++ filebase ++ show i ++".dat" - runIO$ echo (" \""++ basename datfile ++"\" using 1:2:3:4 with errorbars lt "++ - show (line_types !! i) - ++" title \"\", \\\n") -|- appendTo scriptfile - - -- Now a second loop for the lines themselves and to dump the actual data to the .dat file: - forM_ (zip [1..] lines) $ \(i,points) -> do - let datfile = root ++ filebase ++ show i ++".dat" - let schd = sched$ head points -- should be the same across all point - let var = variant$ head points -- should be the same across all point - let nickname = var ++"/"++ schd - runIO$ echo ("# Data for variant "++ nickname ++"\n") -|- appendTo datfile - forM_ points $ \x -> do - - -- Here we print a line of output: - runIO$ echo (show (fromIntegral (threads x)) ++" "++ - show (basetime / (tmed x / normfactor x)) ++" "++ - show (basetime / (tmax x / normfactor x)) ++" "++ - show (basetime / (tmin x / normfactor x)) ++" \n") -|- appendTo datfile - - let comma = if i == length lines then "" else ",\\" - runIO$ echo (" \""++ basename datfile ++ - "\" using 1:2 with lines linewidth "++linewidth++" lt "++ - show (line_types !! i) ++" title \""++nickname++"\" "++comma++"\n") - -|- appendTo scriptfile - - --putStrLn$ "Finally, running gnuplot..." - --runIO$ "(cd "++root++"; gnuplot "++basename scriptfile++")" - --runIO$ "(cd "++root++"; ps2pdf "++ filebase ++".eps )" - - ---plot_benchmark2 root ls = putStrLn$ "plot_benchmark2: Unexpected input, list len: "++ show (length ls) -plot_benchmark2 root [io] = plot_benchmark2 root [io,[]] - - - -isMatch rg str = case matchRegex rg str of { Nothing -> False; _ -> True } - -main = do - args <- getArgs - let file = case args of - [f] -> f - [] -> "results.dat" - dat <- run$ catFrom [file] -|- remComments "#" - - let parsed = map (parse . filter (not . (== "")) . splitRegex (mkRegex "[ \t]+")) - (filter (not . isMatch (mkRegex "ERR")) $ - filter (not . isMatch (mkRegex "TIMEOUT")) $ - filter (not . null) dat) - let organized = organize_data$ - -- filter ((`elem` ["io","pure"]) . variant) parsed - parsed - - putStrLn$ "Parsed "++show (length parsed)++" lines containing data." - print organized - - let root = "./" ++ dropExtension file ++ "_graphs/" - -- For hygiene, completely anhilate output directory: - system$ "rm -rf " ++root ++"/" - system$ "mkdir -p "++root - bests <- - forM organized $ \ perbenchmark -> do - best <- plot_benchmark2 root perbenchmark - forM_ perbenchmark $ \ pervariant -> - forM_ pervariant $ \ persched -> - do let mins = map tmin persched - let pairs = (zip (map (fromIntegral . threads) persched) mins) - --putStrLn$ show pairs - --plot Graphics.Gnuplot.Terminal.X11.cons (path pairs) - --System.exitWith ExitSuccess - --plot x11 (path pairs) - return () - - return best - - putStrLn$ "Now generating final plot files...\n\n" - - let summarize hnd = do - hPutStrLn hnd $ "# Benchmark, scheduler, best #threads, best median time, max parallel speedup: " - hPutStrLn hnd $ "# Summary for " ++ file - - let pads n s = take (n - length s) $ repeat ' ' - let pad n x = " " ++ (pads n (show x)) - - forM_ bests $ \ (Best(name, variant, sched, threads, best, speed)) -> - hPutStrLn hnd$ " "++ name++ (pad 25 name) ++ - show variant++ (pad 10 variant)++ - show sched++ (pad 5 sched) ++ - show threads++ (pad 5 threads)++ - show best ++ (pad 15 best) ++ - show speed - hPutStrLn hnd$ "\n\n" - - putStrLn$ "Done." - summarize stdout - withFile (dropExtension file `addExtension` "summary") WriteMode $ summarize - diff --git a/examples/primes.hs b/examples/primes.hs deleted file mode 100644 --- a/examples/primes.hs +++ /dev/null @@ -1,52 +0,0 @@ - - - --- This is a simplistic benchmark but is included just for comparison with Haskell CnC - --- Author: Ryan Newton - -import System.Environment -import Control.Monad.Par -import Control.Monad.Par.AList as A -import Debug.Trace - - --- First a naive serial test for primality: -isPrime :: Int -> Bool -isPrime 2 = True -isPrime n = (prmlp 3 == n) - where prmlp :: Int -> Int - prmlp i = if (rem n i) == 0 - then i else prmlp (i + 2) - ----------------------------------------- - --- Next, a CnC program that calls the serial test in parallel. - -primes :: Int -> Int -> Par (AList Int) -primes start end = --- parMapReduceRange (InclusiveRange start end) - parMapReduceRangeThresh 100 (InclusiveRange start end) - (\n -> if - -- TEMP: Need a strided range here: - (rem n 2 /= 0) && isPrime n - then return$ singleton n - else return$ empty) - (\ a b -> return (append a b)) - empty - --- This version never builds up the list, it simply counts: --- countprimes :: Int -> Int -> Par Int --- countprimes start end = - - -main = do args <- getArgs - let size = case args of - [] -> 1000 -- Should output 168 - [n] -> (read n) - - ls = runPar $ primes 3 size - --- putStrLn (show ls) - putStrLn (show (1 + A.length ls)) -- Add one to include '2'. - return () diff --git a/examples/queens.hs b/examples/queens.hs deleted file mode 100644 --- a/examples/queens.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -import System.Environment -import Control.Monad -import Control.Seq - -import Control.Monad.Par --- import Control.Monad.Par_Strawman - -nqueens :: Int -> Par [[Int]] -nqueens nq = step 0 [] - where - threshold = 5 - - step :: Int -> [Int] -> Par [[Int]] - step !n b - | n >= threshold = return (iterate gen [b] !! (nq - n)) - | otherwise = do - rs <- parMapM (step (n+1)) (gen [b]) - return (concat rs) - - safe :: Int -> Int -> [Int] -> Bool - safe x d [] = True - safe x d (q:l) = x /= q && x /= q+d && x /= q-d && safe x (d+1) l - - gen :: [[Int]] -> [[Int]] - gen bs = [ (q:b) | b <- bs, q <- [1..nq], safe q 1 b ] - - -main = do - args <- fmap (fmap read) getArgs - let n = case args of [] -> 8; [n] -> n - print (length (runPar (nqueens n))) diff --git a/examples/run_tests.sh b/examples/run_tests.sh deleted file mode 100644 --- a/examples/run_tests.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/bash - -# set -e -# set -o errexit - -for file in "$@"; do - echo Running test $file - ./$file &> $file".out" -# echo "Return code: $?" - code=$? - if [ "$code" != 0 ]; then - echo - echo " ERROR, output was:" - cat $file".out" - echo - echo " ERROR: exit code $code" - exit $code - fi -done diff --git a/examples/stream/DEVLOG.txt b/examples/stream/DEVLOG.txt deleted file mode 100644 --- a/examples/stream/DEVLOG.txt +++ /dev/null @@ -1,141 +0,0 @@ - -Notes on development of monad-par streaming framework and benchmarks. ---------------------------------------------------------------------- - -[2011.03.19] Right now I'm seeing a weird behavior where when run --threaded it prints many of the messages before "new"' in the filter -stage, but it doesn't print the messages after "put" in that same -stage. - -This system allows self-stealing, correct? - -[2011.03.19] - - Quick measurements on wasp: - --------------------------- - Throughput of just countupWindowed + measureRate ... - 2 threads is 8600 * 1024 = 8,806,400 = 8.8mHz. - - * With -N4 it uses ~234% CPU and gets sligthly confused, lowering - throughput to 5800-6100 windows/sec from 8600 - - * It actually does work (e.g. doesn't deadlock) to run it with -N1 - because there's only one kernel. The throughput is much more - variable. From 4800-8500 win/sec. GC time is tiny in this - case, 0.5%. - --------------------------- - Throughput of a single amap (+100) kernel = - - * Gets stuck waiting for first kernel -N1 as expected (and fills memory). - - * on -N2 it gets a rate of between 7937 and 8200 wins/sec but then - it gets stuck after about 10 seconds. I don't fully understand - this. The two threads should be enough for the two kernels - right? Currently Par.hs forks a "replacement thread" to continue - working on the queue when runParAsync returns. Therefore there - should be enough haskell threads, even if there are only two Par - scheduler threads. Those two par workers should be preemptable by - the measureRate thread.... - - * on -N3 it works, and gives 6200-7100 wins/sec throughput. Uses - ~245% CPU. Presumably the two par worker threads are hammering - away and the measureRate one is less busy. But if I leave it - running for a while it grew up to 79% (of 16gb) mem usage. - Strange, -s claims the following. How can max resdency be so low!? - - 2,993,287,338,808 bytes allocated in the heap - 17,134,304,736 bytes copied during GC - 3,744,408 bytes maximum residency (152145 sample(s)) - 1,870,240 bytes maximum slop - 14 MB total memory in use (3 MB lost due to fragmentation) - - Generation 0: 4961153 collections, 4961152 parallel, 696.02s, 63.29s elapsed - Generation 1: 152145 collections, 152145 parallel, 115.00s, 22.66s elapsed - - Parallel GC work balance: 1.08 (2102121164 / 1946757116, ideal 3) - - MUT time (elapsed) GC time (elapsed) - Task 0 (worker) : 0.02s ( 0.00s) 0.00s ( 0.00s) - Task 1 (worker) : 1927.40s (742.55s) 0.00s ( 0.00s) - Task 2 (worker) : 1927.40s (742.55s) 0.00s ( 0.00s) - Task 3 (worker) : 1928.34s (743.40s) 0.00s ( 0.00s) - Task 4 (worker) : 1928.34s (743.40s) 0.00s ( 0.00s) - Task 5 (bound) : 0.00s ( 0.00s) 0.11s ( 0.02s) - Task 6 (worker) : 1928.34s (743.40s) 0.00s ( 0.00s) - Task 7 (worker) : 1117.43s (743.40s) 810.91s ( 85.93s) - - SPARKS: 0 (0 converted, 0 pruned) - - INIT time 0.00s ( 0.00s elapsed) - MUT time 1117.32s (743.40s elapsed) - GC time 811.02s ( 85.95s elapsed) - EXIT time 0.00s ( 0.01s elapsed) - Total time 1928.34s (829.36s elapsed) - - %GC time 42.1% (10.4% elapsed) - - Alloc rate 2,678,988,417 bytes per MUT second - - Productivity 57.9% of total user, 134.7% of total elapsed - - gc_alloc_block_sync: 6092257 - whitehole_spin: 0 - gen[0].sync_large_objects: 190255 - gen[1].sync_large_objects: 267 - - Oh, maybe because of the CArray's all the real storage is outside haskell's heap. - - There must be a memory leak in streamMap. Trying to fix it: - - (1) Factored out 'loop'. I need to try to ensure that no closure - holds onto the original head of the stream. Wow! That - lowered throughput a lot (-N3) and drove cpu usage up! 3500 - wins/sec declining to 300. And it still leaks. - The key difference seems to be passing the extra "fn" argument to loop. - - (2) Hmm... I went back to what I *thought* was the previous form - above (that leaked). But now it's getting the good >6000 - throughput and doesn't seem to be leaking. It gives memory - back to the system and goes up and down in mem footprint. - But now it uses 300% cpu. The only difference I can see is - that I changed the module export decl. How could this matter - if compiling into an executable? Nevertheless maybe this - helps it inline.... Now I can run it for 10 min with minimal - memory usage. - - -qa seems to help the variance on -N4, i.e. with more workers - than kernels. - - --------------------------- - Throughput of a single FFT kernel. - - * Oops, maybe this accounts for the difference above between - leaking/non-leaking. The FFT version maintains a high >7000 - wins/sec throughput. But it leaks memory. Maybe it's not - really doing the FFT and is leaking suspensions? - - * Nope... I tried forcing the FFT by inspecting one element of the - output. Still leaks. Well, the answer is simple. It just - can't keep up with a source that has no backpressure. To - confirm this hypothesis, I ran it with -N1 (with the new - yielding source operator). NOPE, it still leaks. - - -[2011.03.20] {Added disjoint_working_sets_pipeline} - -Ok, first try. Not only has this not demonstrated the benefit of -pipeline parallelism, right now it isn't showing much of a speedup at -all. Right now I'm running with default parameters (4 256 10 20000) - -Running with "-N4 -qa" I see large variance. Between 1.0 and 3.3 -seconds. Seeing the same without -qa: - -Running without no extra runtime flags (no -qa): - nothreads: 2.18s - 1thread: 2.3s - 4threads: 1-3 seconds. - -The big difference is running with N>1 it can spend a lot of time in -GC (e.g. 84%!!). But I need to stop running on wasp for actual -parallel speedup measurements -- I seem to have problems using wasp -for this purpose. diff --git a/examples/stream/Makefile b/examples/stream/Makefile deleted file mode 100644 --- a/examples/stream/Makefile +++ /dev/null @@ -1,32 +0,0 @@ -include ../common.mk - -SRC= simple1_measureSrc.hs \ - disjoint_working_sets_pipeline.hs \ - fft_pipeline.hs -EXES= $(SRC:.hs=.exe) - -NOTHREAD= $(SRC:.hs=.nothread.exe) - -# Par source code with relative paths updated for this deeper directory: -RELPARSRC= $(subst ../,../../,$(ALLPARSRC)) - -all: $(EXES) - -%.exe : %.hs $(RELPARSRC) - $(GHC) -O2 --make -i../../ $< -o $@ -threaded -rtsopts - - -#------------------------------------------------------------ -# Build the non-threaded versions. - -nothread: $(NOTHREAD) - -%.nothread.exe: %.hs $(RELPARSRC) - $(GHC) -O2 --make -i../../ $< -o $@ -rtsopts - -#------------------------------------------------------------ -runtests: - ../run_tests.sh $(EXES) - -clean: - rm -f $(EXES) *.o *.hi diff --git a/examples/stream/disjoint_working_sets_pipeline.hs b/examples/stream/disjoint_working_sets_pipeline.hs deleted file mode 100644 --- a/examples/stream/disjoint_working_sets_pipeline.hs +++ /dev/null @@ -1,276 +0,0 @@ -{-# LANGUAGE BangPatterns, ScopedTypeVariables, CPP #-} -{-# OPTIONS_GHC -fwarn-unused-imports #-} - --- The goal of this benchmark is to demonstrate kernels that have private --- state which has to be read from memory on each invocation. Further, --- the state forms the majority of the working set -- it's larger than --- the streaming input. - --- In theory this means that keeping a kernel on one core and --- exploiting pipeline parallelism is better than following the data --- through the stream graph in a depth first traversal. - - ---module Main(main) where -module Main where - -import Control.Monad as C -import Control.Monad.Par -import Control.Monad.Par.Stream as S -import Control.Monad.Par.OpenList -import Control.DeepSeq -import Control.Exception -import Control.Parallel.Strategies as Strat - --- import Data.Array.Unboxed as U -import Data.Complex -import Data.Int -import Data.Word -import Data.List (intersperse) -import Data.List.Split (chunk) - -import Prelude as P -import System.Environment -import System.Exit -import System.CPUTime -import System.CPUTime.Rdtsc -import GHC.Conc as Conc -import GHC.IO (unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO) - -import Debug.Trace -import Control.Monad.Par.Logging - -import qualified Data.Vector.Unboxed as UV -import Data.Vector.Unboxed hiding ((++)) - --- Performs some (presently meaningless) computation on a state & a --- window (stream element) to compute a new state and new window. --- --- Assumes statesize is a multiple of bufsize: -statefulKern :: Vector Double -> Vector Double -> (Vector Double, Vector Double) -statefulKern state buf = (newstate, newelem) - where - -- We could probably test the memory behavior we're interested in - -- better with inplace update here... but for now, this: - newstate = UV.map (\d -> d/sum + 2) state - newelem = UV.map (+sum) buf - - sum = P.sum partialSums - partialSums = [ sumslice (cutslice n) | n <- [0..factor-1] ] - - cutslice n = UV.slice (n*blen) blen state - sumslice slce = UV.sum (UV.zipWith (+) buf slce) - - factor = slen `quot` blen - slen = UV.length state - blen = UV.length buf - --------------------------------------------------------------------------------- - -monadpar_version (_,numfilters, bufsize, statecoef, numwins) = do - putStrLn$ "Running monad-par version." - - let statesize = bufsize * statecoef - results <- evaluate $ runPar$ do - strm1 :: Stream (UV.Vector Double) <- S.generate numwins (\n -> UV.replicate bufsize 0) - -- Make a pipeline of numfilters stages: - let initstate = UV.generate statesize fromIntegral - pipe_end <- C.foldM (\s _ -> streamScan statefulKern initstate s) strm1 [1..numfilters] - - sums <- streamMap UV.sum pipe_end -#if 0 - return sums - - -- This is tricky, but two different consumers shouldn't prevent - -- garbage collection. - ls <- toListSpin results --- Just (Cons h _) <- pollIVar results - putStrLn$ "Sum of first window: " ++ show (P.head ls) - forkIO$ measureRateList ls - putStrLn$ "Final sum = "++ show (P.sum ls) -#else - - streamFold (+) 0 sums - - putStrLn$ "Final sum = "++ show results -#endif - - --------------------------------------------------------------------------------- - -sparks_version (_,numfilters, bufsize, statecoef, numwins) = do - putStrLn$ "Running sparks version." - - -- Here we represent the stream as a plain list. - let - statesize = bufsize * statecoef - strm1 :: [UV.Vector Double] = P.replicate numwins $ UV.replicate bufsize 0 - initstate = UV.generate statesize fromIntegral - applyKern = scan statefulKern initstate - --- This one has the problem that it fully evaluates the stream for the --- first kernel before moving on to the second: --- strm_last = (parRepeatFun numfilters applyKern) strm1 - - pipe_end = applyNKernels statefulKern numfilters initstate strm1 - - sums = P.map UV.sum pipe_end --- #define SERIAL -#ifndef SERIAL - `using` (Strat.parBuffer numCapabilities rwhnf) -#endif - - putStrLn$ "Sum of first window: "++ show (P.head sums) - measureRateList (sums) --- measureRateList (strm_last) --- measureRateList (forceList strm_last) - putStrLn$ "Final Sum = " ++ show (P.sum sums) - --- Make sure the cars of a list are evaluated before following each cdr: -forceList [] = [] -forceList (h:t) = rnf h `seq` forceList t - --- A slightly different version of Data.List.scanl -scan :: (a -> b -> (a,c)) -> a -> [b] -> [c] -scan f q [] = [] -scan f q (h:t) = h' : scan f q t - where - (q',h') = f q h - -type StatefulKernel s a b = s -> a -> (s,b) - --- applyNKernels _ _ _ [] = [] -applyNKernels :: NFData a => StatefulKernel s a a -> Int -> s -> [a] -> [a] -applyNKernels _ 0 _ ls = ls -applyNKernels kern n init ls = - applyNKernels kern (n-1) init (loop init ls) - where - loop st [] = [] - loop st (h:t) = - let (st', x) = kern st h in -#ifndef SERIAL - rnf x `par` -#endif - x : loop st' t - --- Compose two stateful kernels in parallel. -composeStatefulKernels :: (NFData b, NFData s1) => - StatefulKernel s1 a b -> StatefulKernel s2 b c - -> StatefulKernel (s1,s2) a c --- composeStatefulKernels (f1,f2) (s1,s2) x = -composeStatefulKernels f1 f2 (s1,s2) x = - rnf pr1 `par` (newstate, snd pr2) - where - pr1 = f1 s1 x - pr2 = f2 s2 (snd pr1) - newstate = (fst pr1, fst pr2) - - -parRepeatFun n f = --- P.foldr (.) id (P.replicate n f) - P.foldr (.|| rdeepseq) id (P.replicate n f) - - --------------------------------------------------------------------------------- --- Main script - -default_version = "monad" -default_numfilters = 4 -default_bufsize = 256 -default_statecoef = 10 -- in MULTIPLES of bufsize -default_numwins = 10 * 1000 - - -main = do - args <- getArgs - arg_tup@(version,_,_,_,_) <- - case args of - [] -> return (default_version, default_numfilters, default_bufsize, default_statecoef, default_numwins) - [a,b,c,d,e] -> return (a, read b, read c, read d, read e) - _ -> do - putStrLn$ "ERROR: Invalid arguments, must take 0 or 5 args." - putStrLn$ " Expected args: (version='monad'|'sparks' #filters, bufsize, stateSizeMultiplier, #bufsToProcess)" - putStrLn$ " Received args: "++ show args - exitFailure - - putStrLn$ "numCapabilities: "++ show numCapabilities - putStrLn$ " Frequency in measurable ticks: "++ commaint one_second ++ "\n" - - case version of - "monad" -> monadpar_version arg_tup - "sparks" -> sparks_version arg_tup - _ -> error$ "unknown version: "++version - - putStrLn$ "Finally, dumping all logs:" - printAllLogs - - - --- It is not necessary to evaluate every element in the case of an unboxed vector. -instance NFData a => NFData (UV.Vector a) where - rnf !vec = () - - -print_ msg = trace msg $ return () - --- work pop 1 peek N push 1 --- float->float filter --- firFilter n coefs = --- { - --- float sum = 0; --- for (int i = 0; i < N; i++) --- sum += peek(i) * COEFF[N-1-i]; --- pop(); --- push(sum); --- } --- } - - -{- - -Here's what cachegrind says (on 4 core nehalem): - - $ valgrind --tool=cachegrind ./stream/disjoint_working_sets_pipeline monad 4 768 10 1000 +RTS -N4 - ..... - [measureRate] current rate: 58 Total elems&time 916 181,988,055,721 - [measureRate] Hit end of stream after 1000 elements. - Final sum = 1.560518243231086e22 - ==21202== - ==21202== I refs: 7,111,462,273 - ==21202== I1 misses: 374,190 - ==21202== L2i misses: 298,364 - ==21202== I1 miss rate: 0.00% - ==21202== L2i miss rate: 0.00% - ==21202== - ==21202== D refs: 3,882,935,974 (3,542,949,529 rd + 339,986,445 wr) - ==21202== D1 misses: 14,606,684 ( 9,824,455 rd + 4,782,229 wr) - ==21202== L2d misses: 6,774,479 ( 2,088,565 rd + 4,685,914 wr) - ==21202== D1 miss rate: 0.3% ( 0.2% + 1.4% ) - ==21202== L2d miss rate: 0.1% ( 0.0% + 1.3% ) - ==21202== - ==21202== L2 refs: 14,980,874 ( 10,198,645 rd + 4,782,229 wr) - ==21202== L2 misses: 7,072,843 ( 2,386,929 rd + 4,685,914 wr) - ==21202== L2 miss rate: 0.0% ( 0.0% + 1.3% ) - - -Sparks version: - Final Sum = 1.560518243231086e22 - ==21226== - ==21226== I refs: 5,898,314,238 - ==21226== I1 misses: 291,271 - ==21226== L2i misses: 246,518 - ==21226== I1 miss rate: 0.00% - ==21226== L2i miss rate: 0.00% - ==21226== - ==21226== D refs: 3,264,359,909 (3,206,394,437 rd + 57,965,472 wr) - ==21226== D1 misses: 16,003,068 ( 10,905,138 rd + 5,097,930 wr) - ==21226== L2d misses: 9,177,043 ( 4,207,106 rd + 4,969,937 wr) - ==21226== D1 miss rate: 0.4% ( 0.3% + 8.7% ) - ==21226== L2d miss rate: 0.2% ( 0.1% + 8.5% ) - ==21226== - ==21226== L2 refs: 16,294,339 ( 11,196,409 rd + 5,097,930 wr) - ==21226== L2 misses: 9,423,561 ( 4,453,624 rd + 4,969,937 wr) - ==21226== L2 miss rate: 0.1% ( 0.0% + 8.5% ) - - -} diff --git a/examples/stream/fft_pipeline.hs b/examples/stream/fft_pipeline.hs deleted file mode 100644 --- a/examples/stream/fft_pipeline.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# OPTIONS_GHC -fwarn-unused-imports #-} - -module Main(main) where - -import Control.Monad.Par -import Control.Monad.Par.Stream as S -import Control.Exception -import Data.Complex -import GHC.Conc as Conc -import Debug.Trace -import Math.FFT (dft) - -type Elt = Complex Double - -fft_kern :: Window Elt -> Window Elt -fft_kern arr = dft arr - --- -- TEMP, evaluate one element to make sure the fft really gets called: --- -- trace ("One elt sample: "++ show (arr!10)) $ --- case arr2 ! 10 of _ -> arr2 --- where arr2 = dft arr - --------------------------------------------------------------------------------- --- Main script - --- target = maxBound -target = 10 * 1000 * 1000 -bufsize = 1024 - -main = do - putStrLn$ "numCapabilities: "++ show numCapabilities - putStrLn$ " Frequency in measurable ticks: "++ commaint one_second ++ "\n" - - - putStrLn$ "Performing FFT of "++ commaint target ++" numbers windowed into buffers of size "++ show bufsize ++"\n" - - results <- evaluate $ runParAsync$ do - - strm1 <- countupWin bufsize target :: Par (WStream Elt) - - print_$ "\n Next, applying FFT filter... " - strm2 <- streamMap fft_kern strm1 - --- Make a pipeline of 10 stages: --- strm2 <- foldl (\ s _ -> streamMap kern0) strm1 [1..10] - - print_$ "\n Stream graph constructed, returning from Par computation... " - return strm2 - - measureRate results - putStrLn$ "End of stream reached. All done." - - -print_ msg = trace msg $ return () - --- work pop 1 peek N push 1 --- float->float filter --- firFilter n coefs = --- { - --- float sum = 0; --- for (int i = 0; i < N; i++) --- sum += peek(i) * COEFF[N-1-i]; --- pop(); --- push(sum); --- } --- } - - -{- - Notes: - - - - -} diff --git a/examples/stream/simple1_measureSrc.hs b/examples/stream/simple1_measureSrc.hs deleted file mode 100644 --- a/examples/stream/simple1_measureSrc.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# OPTIONS_GHC -fwarn-unused-imports #-} - -module Main(main) where - -import Control.Monad -import Control.Monad.Par -import Control.Monad.Par.Stream as S -import Control.Monad.Par.OpenList -import Control.DeepSeq -import Control.Exception - --- import Data.Array.Unboxed as U -import Data.Array.CArray as C -import Data.Complex -import Data.Int -import Data.Word -import Data.List (intersperse) -import Data.List.Split (chunk) - -import System.CPUTime -import System.CPUTime.Rdtsc -import GHC.Conc as Conc -import GHC.IO (unsafePerformIO, unsafeDupablePerformIO, unsafeInterleaveIO) -import Debug.Trace - --------------------------------------------------------------------------------- --- Main script - -main = do - - -- Generate 20 million elements: - let s = countupWin 1024 (20 * 1000 * 1000) :: Par (WStream Int) - measureRate $ runParAsync s - - putStrLn$ "Done with 5 million elements." diff --git a/examples/sumeuler/ListAux.hs b/examples/sumeuler/ListAux.hs deleted file mode 100644 --- a/examples/sumeuler/ListAux.hs +++ /dev/null @@ -1,41 +0,0 @@ -module ListAux where - -import Data.List - - --- splitting into n parts, and its inverse: - -splitIntoN :: Int -> [a] -> [[a]] -splitIntoN n xs = takeIter parts xs - where l = length xs - parts = zipWith (+) ((replicate (l `mod` n) 1) ++ repeat 0) - (replicate n (l `div` n)) -takeIter :: [Int] -> [a] -> [[a]] -takeIter [] [] = [] -takeIter [] _ = error "elements left over" -takeIter (t:ts) xs = hs : takeIter ts rest - where (hs,rest) = splitAt t xs - -unSplit :: [[a]] -> [a] -unSplit = concat - --- splitting into parts of same size. Inverse is concat again. - -splitAtN :: Int -> [a] -> [[a]] -splitAtN n [] = [] -splitAtN n xs = ys : splitAtN n zs - where (ys,zs) = splitAt n xs - ----------------------------------------- - --- splitting round-robin until list runs empty, and its inverse: - -unshuffle :: Int -> [a] -> [[a]] -unshuffle n xs = [takeEach n (drop i xs) | i <- [0..n-1]] - where takeEach n [] = [] - takeEach n (x:xs) = x : takeEach n (drop (n-1) xs) - --- inverse to unshuffle -shuffle :: [[a]] -> [a] -shuffle = concat . transpose - diff --git a/examples/sumeuler/Makefile b/examples/sumeuler/Makefile deleted file mode 100644 --- a/examples/sumeuler/Makefile +++ /dev/null @@ -1,7 +0,0 @@ -include ../common.mk - -sumeuler.exe : $(wildcard *.hs) ../../Control/Monad/Par.hs - $(GHC) -O2 -cpp --make -i../.. SumEuler.hs -o $@ -threaded -rtsopts - -clean: - rm -f *.exe *.hi *.o diff --git a/examples/sumeuler/SumEuler.hs b/examples/sumeuler/SumEuler.hs deleted file mode 100644 --- a/examples/sumeuler/SumEuler.hs +++ /dev/null @@ -1,287 +0,0 @@ -{-# OPTIONS -Wall #-} --- --- Euler totient function (strategic version). --- Orig taken from "Research Directions in Parallel Functional Programming", --- Chapter "Performance Monitoring", Nathan Charles and Colin Runciman. --- --- (c) 2001 Hans-Wolfgang Loidl --- --- modifications by Jost Berthold, 07/2008: --- ported to current GHC = hierarchical libraries --- removed some dead (unused) code --- simplified/secured usage --- included a reference computation (using prime numbers) --- tested best version (JFP_Final) against two "equivalents" using --- strategies --- ---------------------------------------------------------------------------- - -module Main where - -import System.Environment (getArgs) - -import Control.Monad.Par - -import Control.Monad (when) - -import ListAux -- split/join functions, put in new module -import SumEulerPrimes - ---------------------------------------------------------------------------- --- Generic clustering routines - --- Classes --- maybe: class (Functor c) => MMonad c where { ... mmap = fmap } -class MMonad c where - munit :: a -> c a - mjoin :: c (c a) -> c a - mmap :: (a -> b) -> c a -> c b - -class (MMonad c) => MMonadPlus c where - mzero :: c a - mplus :: c a -> c a -> c a - -class (MMonad c) => Cluster c where - cluster :: Int -> c a -> c (c a) - decluster :: c (c a) -> c a - lift :: (c a -> b) -> (c (c a) -> (c b)) - -- default defs - --cluster = ??? - decluster = mjoin - lift = mmap - --- Instances -instance MMonad [] where - munit x = [x] - mjoin = concat - mmap = map - -instance Cluster [] where - cluster = splitAtN - ---------------------------------------------------------------------------- - -usage :: String -usage = "Usage: version size chunksize" - ++"\nFor versions see source code." - -main :: IO () -main = do args <- getArgs - let - lenArgs = length args - when (lenArgs < 3) - (putStrLn (usage ++ "\n(using defaults: 38,5000,100)")) - let - argDef :: Read a => Int -> a -> a - argDef m defVal | m < lenArgs = read (args!!m) - | otherwise = defVal - x, n, c :: Int - x = argDef 0 38 -- which sumEuler to use - n = argDef 1 5000 -- size of the interval - c = argDef 2 100 -- chunksize - -- parallel computation - (res, _str) = case x of - - _ -> (sumEuler_monadpar c n, "monad-par version") -#if 0 - ------------------ - -- BEST VERSION: - 38 -> (sumEulerJFP_Final c n, "JFP_Final paper version (splitAtN)") - -- VERSIONS TO TEST ADDITIONALLY: --- 48 -> (sumEulerS8 c n, "parallel w/ parChunkFoldMap strategy") --- 58 -> (sumEulerS8' c n, "parallel w/ parChunkFold'Map strategy") - 8 -> (sumEulerJFP c n, "JFP paper version (splitAtN)") - ------------------ - 0 -> (sumEuler_seq n, "sequential") - 1 -> (sumEulerS1 n, "parallel w/ parList strategy") - -- not bad: - 2 -> (sumEulerS2 c n, "parallel w/ parListChunk") - 3 -> (sumEulerChunk c n,"parallel w/ chunkify") - 4 -> (sumEulerShuffle c n,"parallel w/ shuffle") - 5 -> (sumEulerCluster c n,"parallel w/ generic clustering") - -- not bad: - 6 -> (sumEulerS6 c n, "parallel w/ parListChunk over reversed list") --- 7 -> (sumEulerS7 c n, "parallel w/ parChunkFoldMap strategy") - 18 -> (sumEulerJFP1 c n, "JFP1 paper version (splitIntoChunks)") - 28 -> (sumEulerJFP0 c n, "JFP0 paper version (explicit list comprh)") --- 9 -> (sumEulerStepList c n, "parallel w/ seqStepList for strategic shuffling") - _ -> error "undefined version." -#endif - - putStrLn ("sumEuler [" ++ show base ++ ".." ++ show (base+n) ++ "] = " ++ show res) - - -- reference implementation (which is rather fast) - let expected = sumPhi n - when False $ putStrLn ("Expected result: " ++ show expected) - ---------------------------------------------------------------------------- --- main computation function in many variants - --- HERE: best versions in contrast - -#if 0 -sumEulerJFP :: Int -> Int -> Int -sumEulerJFP c n = sum (map (sum . map euler) (splitAtN c (mkList n)) - `using` parList rdeepseq) - -sumEulerJFP_Final :: Int -> Int -> Int -sumEulerJFP_Final c n = sum ([(sum . map euler) x | x <- splitAtN c [n,n-1..0]] - `using` parList rdeepseq) -#endif - -sumEuler_monadpar :: Int -> Int -> Int -sumEuler_monadpar c n = runPar $ --- sum `fmap` parMap (sum . map euler) (splitAtN c [n,n-1..0]) - sum `fmap` parMap euler [n,n-1..0] - - --- -- using a fold-of-map strategy w/ folding inside a chunk --- sumEulerS8 :: Int -> Int -> Int --- sumEulerS8 c n = parChunkFoldMap c rnf (+) euler (mkList n) --- --- -- using a fold-of-map strategy w/ STRICT LEFT-folding inside a chunk --- sumEulerS8' :: Int -> Int -> Int --- sumEulerS8' c n = parChunkFoldMap' c rnf (+) euler (mkList n) --- --- -- parallel fold-of-map with chunking over fold and map --- parChunkFoldMap :: (NFData b) => Int -> Strategy b -> --- (b -> b -> b) -> (a -> b) -> [a] -> b --- parChunkFoldMap c s f g xs = foldl1 f (map (foldl1 f . map g) --- (splitAtN c xs) --- `using` parList s) --- --- -- parallel fold-of-map with chunking over fold and map --- parChunkFoldMap' :: (NFData b) => Int -> Strategy b -> --- (b -> b -> b) -> (a -> b) -> [a] -> b --- parChunkFoldMap' c s f g xs = foldl1' f (map (foldl1' f . map g) --- (splitAtN c xs) --- `using` parList s) - -#if 0 ------------------------------------------------------------------------ --- OTHER VARIANTS - --- strategic function application -sumEulerS1 :: Int -> Int -sumEulerS1 n = sum ( map euler (mkList n) - `using` - parList rdeepseq ) - --- NUKED: --- sumEulerS1 c n = sum $|| (parListChunk c rnf) $ map euler $ mkList $ n - --- naive parallel version w/ parList -sumEulerS2 :: Int -> Int -> Int -sumEulerS2 c n = sum ( map euler (mkList n) - `using` - parListChunk c rdeepseq ) - --- using a parallel fold over a chunkified list -sumEulerS6 :: Int -> Int -> Int -sumEulerS6 c n = sum (map (sum . map euler) (splitAtN c (mkList n)) - `using` parList rdeepseq) - --- -- using a fold-of-map strategy over a chunkified list --- sumEulerS7 :: Int -> Int -> Int --- sumEulerS7 c n = parFoldChunkMap c rnf (+) euler (mkList n) - --- explicit restructuring -sumEulerChunk :: Int -> Int -> Int -sumEulerChunk c n = sum (parMap rdeepseq ( \ xs -> sum (map euler xs)) - (splitAtN c (mkList n))) - --- using generic clustering functions -sumEulerCluster :: Int -> Int -> Int -sumEulerCluster c n = sum ((lift worker) (cluster c (mkList n)) - `using` parList rdeepseq) - where worker = sum . map euler - --- using a shuffling to improve load balance -sumEulerShuffle :: Int -> Int -> Int -sumEulerShuffle c n = sum ((map worker) (unshuffle (noFromSize c n) (mkList n)) - `using` parList rdeepseq) - where worker = sum . map euler - -noFromSize :: Int -> Int -> Int -noFromSize c n | n `mod` c == 0 = n `div` c - | otherwise = n `div` c + 1 - --- -- Evaluates every n-th element in the list starting with the first elem --- seqStepList :: Int -> Strategy a -> Strategy [a] --- seqStepList _ _strat [] = () --- seqStepList n strat (x:xs) = strat x `pseq` (seqStepList n strat (drop (n-1) xs)) --- --- seqStepList' :: Int -> Strategy a -> Strategy [a] --- -- seqStepList' _ strat [] = () --- seqStepList' n strat xs = parList (\ i -> seqStepList n strat (drop i xs)) [0..n-1] --- --- sumEulerStepList :: Int -> Int -> Int --- sumEulerStepList c n = sum ( map euler (mkList n) --- `using` --- seqStepList' n' rnf ) --- where --worker = sum . map euler --- n' = if n `mod` c == 0 then n `div` c else (n `div` c)+1 - --- --------------------------------------------------------------------------- --- Variants of the code for the JFP paper --- --------------------------------------------------------------------------- - -sumEulerJFP0 :: Int -> Int -> Int -sumEulerJFP0 c n = sum ([ (sum . map euler) [ c*i+j | j <- [0..c-1], c*i+j<=n ] - | i <- [0..(n+c-1) `div` c - 1] ] - `using` parList rdeepseq) - -sumEulerJFP1 :: Int -> Int -> Int -sumEulerJFP1 c n = sum (map (sum . map euler) (splitIntoChunks c n) - `using` parList rdeepseq) - -#endif - -splitIntoChunks :: Int -> Int -> [[Int]] -splitIntoChunks c n = [ [ c*i+j | j <- [0..c-1], c*i+j<=n ] - | i <- [0..(n+c-1) `div` c - 1] ] - --- boring sequential version -sumEuler_seq :: Int -> Int -sumEuler_seq = sum . map euler . mkList - ---------------------------------------------------------------------------- --- smallest input for euler -base :: Int -base = 0 - --- produce a list of input values -mkList :: Int -> [Int] -mkList = reverse . enumFromTo base . (+ base) --- random numbers --- mkList seed n = take n (randoms seed) - ---------------------------------------------------------------------------- --- main fct - -euler :: Int -> Int -euler n = length (filter (relprime n) [1..(n-1)]) - ---------------------------------------------------------------------------- --- orig code from Nathan -{- -euler :: Int -> Int -euler n = let - relPrimes = let - numbers = [1..(n-1)] - in - numbers `par` (filter (relprime n) numbers) - in - (spine relPrimes) `par` (length relPrimes) --} - ---------------------------------------------------------------------------- --- aux fcts - -hcf :: Int -> Int -> Int -hcf x 0 = x -hcf x y = hcf y (rem x y) - -relprime :: Int -> Int -> Bool -relprime x y = hcf x y == 1 - diff --git a/examples/sumeuler/SumEulerPrimes.hs b/examples/sumeuler/SumEulerPrimes.hs deleted file mode 100644 --- a/examples/sumeuler/SumEulerPrimes.hs +++ /dev/null @@ -1,36 +0,0 @@ -module SumEulerPrimes where - -import Data.List - -sumPhi n = sum (map phiOpt [1..n]) - -phiOpt :: Int -> Int -phiOpt 1 = 0 -phiOpt n = foldl (*) 1 [ (p-1)*p^(k-1) - | (p,k) <- primefactors n ] - --- factorise n to a list of (prime, multiplicity) -primefactors :: Int -> [(Int,Int)] -primefactors n | n <= 1 = [] - | otherwise = primeList (primesIn primes n) - --- gather identical primes in the list -primeList :: [Int] -> [(Int,Int)] -primeList ps = [ (x, length (filter (==x) ps)) - | x <- nub ps ] - --- brute-force factorisation, using precomputed prime list -primesIn :: [Int] -> Int -> [Int] -primesIn [] _ = error "no primes left!" -primesIn ps@(p:rest) n | p > n = [] - | n `mod` p == 0 = p:primesIn ps (n `div` p) - | otherwise = primesIn rest n - --- prime numbers, by sieve of Eratosthenes -primes :: [Int] -primes = sieve [2..] -sieve :: [Int] -> [Int] -sieve [] = [] -sieve (x:xs) = x: (sieve (filter (not . multiple) xs)) - where multiple y = rem y x == 0 - diff --git a/examples/timeout.sh b/examples/timeout.sh deleted file mode 100644 --- a/examples/timeout.sh +++ /dev/null @@ -1,91 +0,0 @@ -#!/bin/bash -# -# The Bash shell script executes a command with a time-out. -# Upon time-out expiration SIGTERM (15) is sent to the process. If the signal -# is blocked, then the subsequent SIGKILL (9) terminates it. -# -# Based on the Bash documentation example. - -# Hello Chet, -# please find attached a "little easier" :-) to comprehend -# time-out example. If you find it suitable, feel free to include -# anywhere: the very same logic as in the original examples/scripts, a -# little more transparent implementation to my taste. -# -# Dmitry V Golovashkin - -scriptName="${0##*/}" - -declare -i DEFAULT_TIMEOUT=9 -declare -i DEFAULT_INTERVAL=1 -declare -i DEFAULT_DELAY=1 - -# Timeout. -declare -i timeout=DEFAULT_TIMEOUT -# Interval between checks if the process is still alive. -declare -i interval=DEFAULT_INTERVAL -# Delay between posting the SIGTERM signal and destroying the process by SIGKILL. -declare -i delay=DEFAULT_DELAY - -function printUsage() { - cat < 0)); do - sleep $interval - kill -0 $$ || exit 0 - ((t -= interval)) - done - - # Be nice, post SIGTERM first. - # The 'exit 0' below will be executed if any preceeding command fails. - kill -s SIGTERM $$ && kill -0 $$ || exit 0 - sleep $delay - kill -s SIGKILL $$ -) 2> /dev/null & - -exec "$@" diff --git a/monad-par.cabal b/monad-par.cabal --- a/monad-par.cabal +++ b/monad-par.cabal @@ -1,24 +1,49 @@ Name: monad-par -Version: 0.1.0.3 +Version: 0.3 Synopsis: A library for parallel programming based on a monad + +-- Version history: +-- 0.1 : First release +-- 0.1.0.1 : +-- 0.1.0.2 : +-- 0.1.1.0 : module reorganization, moving ParClass + +-- 0.2 : Bumped for new class-based API +-- 0.2.1 : Bumped for change AList +-- 0.2.2 : incorporation of real deque package +-- 0.2.3 : Restricted module export for 0.2 release. + +-- 0.3 : Factored/reorganized modules and packages. +-- *This* package is the original, core monad-par. + + Description: This library offers an alternative parallel programming API to that provided by the @parallel@ package. - The 'Par' monad allows the simple description of + A 'Par' monad allows the simple description of parallel computations, and can be used to add parallelism to pure Haskell code. The basic API is straightforward: the monad supports forking and simple communication in terms of 'IVar's. - The library comes with an efficient work-stealing + The library comes with a work-stealing implementation, but the internals are also exposed so that you can build your own scheduler if necessary. + Examples of use can be found in the examples/ directory of the source package. + + The modules below provide additionaly schedulers, + data structures, and other added capabilities + layered on top of the 'Par' monad. + +-- * Finish These +-- * Module Descriptions + Homepage: https://github.com/simonmar/monad-par License: BSD3 License-file: LICENSE @@ -28,66 +53,93 @@ Stability: Experimental Category: Control,Parallelism,Monads Build-type: Simple -Cabal-version: >=1.2 +Cabal-version: >=1.8 + extra-source-files: - examples/benchlist.txt - examples/benchmark.sh - examples/blackscholes_data.hs - examples/blackscholes.hs - examples/cholesky.hs - examples/cholesky_matrix6.dat - examples/coins.hs - examples/common.mk - examples/get_cholesky_data.sh - examples/Makefile - examples/mandel.hs - examples/matmult/ListAux.hs - examples/matmult/Makefile - examples/matmult/MatMult.hs - examples/matmult/matmult.stdout - examples/minimax/Board.hs - examples/minimax/Game.hs - examples/minimax/Main.hs - examples/minimax/Makefile - examples/minimax/minimax.stdout - examples/minimax/Prog.hs - examples/minimax/Tree.hs - examples/minimax/Wins.hs - examples/nbody.hs - examples/ntimes - examples/ntimes_minmedmax - examples/parfib.hs - examples/partree/Makefile - examples/partree/partree.hs - examples/partree/Tree.hs - examples/plot_scaling.hs - examples/PortablePixmap.lhs - examples/primes.hs - examples/queens.hs - examples/run_tests.sh - examples/stream/DEVLOG.txt - examples/stream/disjoint_working_sets_pipeline.hs - examples/stream/fft_pipeline.hs - examples/stream/Makefile - examples/stream/simple1_measureSrc.hs - examples/sumeuler/ListAux.hs - examples/sumeuler/Makefile - examples/sumeuler/SumEuler.hs - examples/sumeuler/SumEulerPrimes.hs - examples/timeout.sh tests/AListTest.hs - tests/Test.hs - Control/Monad/Par/Stream.hs + tests/AllTests.hs + tests/AsyncTest.hs + tests/Makefile + tests/ParTests.hs + tests/TestHelpers.hs + tests/TestParDist.hs + tests/Test_ContReaderT.hs + tests/Test_ReaderContT.hs + tests/hs_cassandra_microbench.hs + tests/hs_cassandra_microbench2.hs Library - Exposed-modules: Control.Monad.Par - , Control.Monad.Par.OpenList - , Control.Monad.Par.AList - , Control.Monad.Par.IList - , Control.Monad.Par.Internal - Build-depends: base >= 4 && < 5, - deepseq >= 1.1 && < 1.4, - HUnit >= 1.2 + Exposed-modules: + -- The classic, simple monad-par interface: + Control.Monad.Par + + -- This is the default scheduler: + , Control.Monad.Par.Scheds.Trace + , Control.Monad.Par.Scheds.TraceInternal + + -- Replacement scheduler for Trace: + , Control.Monad.Par.Scheds.Direct + + -- This scheduler uses sparks rather than IO threads. + -- It only supports Futures, not full IVars: + , Control.Monad.Par.Scheds.Sparks + + Build-depends: base >= 4 && < 5 + -- This provides the interface which monad-par implements: + , abstract-par + , abstract-deque >= 0.1.4 + -- Extras such as parMap, RNG, State + , monad-par-extras == 0.3.* + , deepseq >= 1.1 + , array >= 0.3 + , mwc-random >= 0.11 + , containers + , parallel >= 3.1 + , mtl >= 2.0.1.0 + ghc-options: -O2 Other-modules: + ------------------------------------------------------------ + -- Schedulers & Infrastructure -- + ------------------------------------------------------------ + + -- Strawman scheduler that forks IO threads: + -- Control.Monad.Par.Scheds.ContFree, + + -- Internal logging framework: + -- Control.Monad.Par.Logging, + + -- Serial Elision is currently experimental: + -- Control.Monad.Par.Scheds.SerialElision + + ------------------------------------------------------------ + -- Data Structures -- + ------------------------------------------------------------ + + -- ILists are internal: + -- , Control.Monad.Par.IList + + -- RRN: Not exposing Streams or OpenLists yet. Need to improve performance. + -- We have some ideas for enabling bounded chans while preventing deadlock: + -- , Control.Monad.Par.OpenList + -- , Control.Monad.Par.Stream + + +Test-Suite test-monad-par + type: exitcode-stdio-1.0 + main-is: tests/AllTests.hs + ghc-options: -itests -rtsopts -threaded + build-depends: base >= 4 && < 5 + , abstract-par, monad-par-extras + , array >= 0.3 + , deepseq >= 1.2 + , time + , QuickCheck, HUnit + , test-framework-hunit, test-framework-quickcheck2 + , test-framework, test-framework-th + -- , binary + + + + diff --git a/tests/AListTest.hs b/tests/AListTest.hs --- a/tests/AListTest.hs +++ b/tests/AListTest.hs @@ -1,10 +1,47 @@ -import Control.Monad.Par.AList +module AListTest ( tests ) where +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.HUnit +import Test.QuickCheck + +import Control.Monad.Par.AList as A +import Prelude hiding (tail, length, map, filter) +import qualified Prelude as P + + + -------------------------------------------------------------------------------- --- Testing +-- QuickCheck properties --- For testing: +prop_tofrom :: [Int] -> Bool +prop_tofrom xs = toList (fromList xs) == xs + +prop_tofromB :: [Int] -> Bool +prop_tofromB xs = toList (fromListBalanced xs) == xs + +prop_balance :: [Int] -> Bool +prop_balance xs = toList (balance (fromList xs)) == xs + +prop_map :: [Int] -> Bool +prop_map ls = map (+1) (fromList ls) == fromList (P.map (+1) ls) + +prop_filter :: [Int] -> Bool +prop_filter ls = filter odd (fromList ls) == fromList (P.filter odd ls) + +-- | All QuickCheck tests together: +test = mapM_ quickCheck [ prop_tofrom + , prop_tofromB + , prop_balance + , prop_map + , prop_filter + ] + +-------------------------------------------------------------------------------- +-- Testing Utils: + bintree 0 x = x bintree n x = Append sub sub where sub = bintree (n-1) x @@ -14,24 +51,29 @@ showDbg (Append l r) = "("++showDbg l++" | "++showDbg r++")" showDbg (AList l) = show l -alist_tests :: Test -alist_tests = - TestList - [ - - 8 ~=? (length$ tail$ tail$ fromList [1..10]) - , 1 ~=? (length$ tail$tail$ cons 1$ cons 2$ cons 3 empty) - - , 253 ~=? (length$ tail$tail$tail$ bintree 8 $ singleton 'a') - , 0 ~=? (length$ bintree 8 $ empty) +-------------------------------------------------------------------------------- - , "((1 | 1) | (1 | 1))" ~=? (showDbg$ bintree 2 $ singleton 1) - , "((_ | 1) | (1 | 1))" ~=? (showDbg$ tail$ bintree 2 $ singleton 1) - , "(_ | (1 | 1))" ~=? (showDbg$ tail$tail$ bintree 2 $ singleton 1) +tests = [ + -- testGroup "AList HUnit Tests" (hUnitTestToTests alist_tests), - ] + testGroup "AList HUnit Tests" [ + testCase "fromList1" $ 8 @=? (length$ tail$ tail$ fromList [1..10]) + , testCase "cons X3" $ 1 @=? (length$ tail$tail$ cons 1$ cons 2$ cons 3 empty) + , testCase "tail X3" $ 253 @=? (length$ tail$tail$tail$ bintree 8 $ singleton 'a') + , testCase "len bintree"$ 0 @=? (length$ bintree 8 $ empty) -t = runTestTT alist_tests + , testCase "inspect tree1"$ "((1 | 1) | (1 | 1))" @=? (showDbg$ bintree 2 $ singleton 1) + , testCase "inspect tree2"$ "((_ | 1) | (1 | 1))" @=? (showDbg$ tail$ bintree 2 $ singleton 1) + , testCase "inspect tree3"$ "(_ | (1 | 1))" @=? (showDbg$ tail$tail$ bintree 2 $ singleton 1) + ], + testGroup "AList QuickCheck Tests " [ + testProperty "map" prop_map + , testProperty "filter" prop_filter + , testProperty "tofrom" prop_tofrom + , testProperty "tofromB" prop_tofromB + , testProperty "balance" prop_balance + ] + ] --- TODO: Quickcheck. +-- main = defaultMain tests diff --git a/tests/AllTests.hs b/tests/AllTests.hs new file mode 100644 --- /dev/null +++ b/tests/AllTests.hs @@ -0,0 +1,18 @@ + +-- | Combine individual test modules into a single module. + +module Main where + +import Test.Framework (defaultMain, testGroup) +import qualified AListTest +import qualified ParTests +import qualified AsyncTest + +main = defaultMain $ concat $ + [ AListTest.tests + , ParTests.tests +-- Not working right now: +-- , AsyncTests.tests + ] + +-- main = AsyncTests.manual_main diff --git a/tests/AsyncTest.hs b/tests/AsyncTest.hs new file mode 100644 --- /dev/null +++ b/tests/AsyncTest.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TemplateHaskell #-} + +module AsyncTest (tests, manual_main) where + +import Control.Exception +import Control.Monad.Par.Scheds.Trace +import Control.Monad.Par.Scheds.TraceInternal (Par(..),Trace(Fork),runCont,runParAsync) +import Test.Framework.TH (testGroupGenerator) +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.HUnit + +import TestHelpers + +-------------------------------------------------------------------------------- + +-- A D E or A D B E but no C +-- +-- ODD -- this passes when run manually (compiled or interpreted) but +-- fails when run through the test framework [2011.10.25]. +case_async_test2 = + do x <- async2 + case words x of + ["A","D","E"] -> return () + ["A","D","B","E"] -> return () + _ -> error$ "async_test2: Bad output: "++ show (words x) + +async2 = collectOutput $ \ r -> do + prnt r "A" + evaluate$ runParAsync $ + do + fork $ do _prnt r "B" + x <- _unsafeio$ waste_time 0.5 + _prnt r$ "C "++ show x +-- _prnt r$ "C "++ show (_waste_time awhile) + _prnt r "D" + prnt r "E" + +-------------------------------------------------------------------------------- + +tests = [ $(testGroupGenerator) ] + +-- It works fine when run like this: +manual_main = do x <- async2; putStrLn x + case_async_test2 +-- case_async_test1 diff --git a/tests/Makefile b/tests/Makefile new file mode 100644 --- /dev/null +++ b/tests/Makefile @@ -0,0 +1,32 @@ + +# NOTE!! THIS IS REDUNDANT WITH THE CABAL TEST-SUITE IN monad-par.cabal +# +# This is simply an alternative way to run the tests. + + +# These are HUnit/QuickCheck tests, factored out of their respective files: +SRC = ParTests.hs AListTest.hs AsyncTests.hs TestHelpers.hs Makefile +TESTS= AllTests.hs +EXES= $(TESTS:.hs=.exe) + +all: $(EXES) test + +.SUFFIXES: .hs .exe + +.hs.exe: $< $(SRC) + ghc -i.. --make $< -o $@ -rtsopts -threaded + +deps: + cabal install QuickCheck HUnit test-framework test-framework-hunit test-framework-quickcheck2 test-framework-th + +test: + @echo + @echo "Running tests:" + @echo "==================================" + ./AllTests.exe +RTS -N2 +# "for t in $(EXES); do $t; done" +# ./ParTests.exe +# ./AListTest.exe + +clean: + rm -f *.hi *.exe *.o diff --git a/tests/ParTests.hs b/tests/ParTests.hs new file mode 100644 --- /dev/null +++ b/tests/ParTests.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE TemplateHaskell, BangPatterns #-} + +module ParTests (tests) where + +import Control.Monad.Par.Combinator + +import Control.Monad.Par.Scheds.Trace +import Control.Monad.Par.Scheds.TraceInternal (Par(..),Trace(Fork),runCont,runParAsync) + +-- import Control.Monad.Par.Scheds.Direct + +import Control.Concurrent.Chan +import Control.Exception +import System.IO.Unsafe +import Data.IORef +import Test.HUnit +import Test.Framework.TH (testGroupGenerator) +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.HUnit +-- import Test.Framework.Providers.QuickCheck2 (testProperty) +import System.Timeout + +import TestHelpers + +-- ----------------------------------------------------------------------------- + +-- Testing + +three = (3::Int) +par res m = res @=? runPar m + +case_justReturn = par three (return 3) +case_oneIVar = par three (do r <- new; put r 3; get r) + + +-- [2012.01.02] Apparently observing divergences here too: +case_forkNFill = par three (do r <- new; fork (put r 3); get r) + +-- [2012.05.02] The nested Trace implementation sometimes fails to +-- throw this exception, so we expect either the exception or a +-- timeout. This is reasonable since we might expect a deadlock in a +-- non-Trace scheduler. --ACF +case_getEmpty = do + _ <- timeout 100000 $ assertException "no result" $ + runPar $ do r <- new; get r + return () + + +-- [2012.01.02] Observed a blocked-indef-on-MVar failure here on +-- master branch with 16 threads: +-- +-- | Simple diamond test. +case_test_diamond = 9 @=? (m :: Int) + where + m = runPar $ do + [a,b,c,d] <- sequence [new,new,new,new] + fork $ do x <- get a; put b (x+1) + fork $ do x <- get a; put c (x+2) + fork $ do x <- get b; y <- get c; put d (x+y) + fork $ do put a 3 + get d + +-- | Violate IVar single-assignment: +-- +-- NOTE: presently observing termination problems here. +-- runPar is failing to exist after the exception? +disabled_case_multiput = assertException "multiple put" $ + runPar $ do + a <- new + put a (3::Int) + put a (4::Int) + return () + + +-- disabled_test3 = assertException "multiple put" $ +-- runPar $ do +-- a <- new +-- put a (3::Int) +-- both (return 1) (return 2) +-- where +-- -- both a b >> c == both (a >> c) (b >> c) +-- -- Duplicate the continuation: is this useful for anything? +-- both :: Par a -> Par a -> Par a +-- both a b = Par $ \c -> Fork (runCont a c) (runCont b c) + +case_test_pmrr1 = + par 5050 $ parMapReduceRangeThresh 1 (InclusiveRange 1 100) + (return) (return `bincomp` (+)) 0 + where bincomp unary bin a b = unary (bin a b) + + +------------------------------------------------------------ + +-- Observe the real time ordering of events: + +-- A D B C E +case_async_test1 = + do x <- res + case words x of + ["A","D","B","C",_,"E"] -> return () + _ -> error$ "Bad output: "++ show (words x) + where + res = collectOutput $ \ r -> do + prnt r "A" + evaluate$ runPar $ + do + fork $ do _prnt r "B" + x <- _unsafeio$ waste_time 0.5 + _prnt r$ "C "++ show x +-- _prnt r$ "C "++ show (_waste_time awhile) + _prnt r "D" + prnt r$ "E" + + + +------------------------------------------------------------ + +tests = [ $(testGroupGenerator) ] + diff --git a/tests/Test.hs b/tests/Test.hs deleted file mode 100644 --- a/tests/Test.hs +++ /dev/null @@ -1,74 +0,0 @@ -module Main where - -import Test.HUnit - --- ----------------------------------------------------------------------------- - --- Testing - -_test :: IO () -_test = do - print ((runPar $ return 3) :: Int) - print (runPar $ do r <- new; put r (3 :: Int); get r) - print (runPar $ do r <- new; fork (put r (3::Int)); get r) - print ((runPar $ do r <- new; get r) :: Int) - -_test2 :: Int -_test2 = runPar $ do - [a,b,c,d] <- sequence [new,new,new,new] - fork $ do x <- get a; put b (x+1) - fork $ do x <- get a; put c (x+2) - fork $ do x <- get b; y <- get c; put d (x+y) - fork $ do put a 3 - get d - -_test3 :: Int -_test3 = runPar $ do - a <- new - put a (3::Int) - both (return 1) (return 2) - --- is there a standard lib thing for this? - -_test_pmrr1 :: Int -_test_pmrr1 = runPar$ parMapReduceRangeThresh 1 (InclusiveRange 1 100) - (return) (return `bincomp` (+)) 0 - where bincomp unary bin a b = unary (bin a b) - -_unsafeio :: IO a -> Par a -_unsafeio io = let x = unsafePerformIO io in - x `seq` return x - -_print :: String -> Par () -_print = _unsafeio . putStrLn - -_waste_time :: Int -> Double -_waste_time n = loop n 1.00111 - where - loop 0 !x = x - loop !n !x | x > 100.0 = loop (n-1) (x / 2) - loop !n !x = loop (n-1) (x + x * 0.5011) - - -_async_test1 = do -- A D B C E - putStrLn "A" - evaluate$ runPar $ - do - fork $ do _print "B" - _print$ "C "++ show (_waste_time 300000000) - _print "D" - putStrLn$ "E" - -_async_test2 = do -- A D E or A D B E but no C - putStrLn "A" - evaluate$ runParAsync $ - do - fork $ do _print "B" - _print$ "C "++ show (_waste_time 300000000) - _print "D" - putStrLn$ "E" - - --- TODO: add the async_tests above to the test list. -_par_tests :: Test -_par_tests = TestList [] diff --git a/tests/TestHelpers.hs b/tests/TestHelpers.hs new file mode 100644 --- /dev/null +++ b/tests/TestHelpers.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE BangPatterns #-} + +module TestHelpers where + +import Data.List +import Prelude hiding (catch) +import Control.Exception +import System.IO.Unsafe (unsafePerformIO) +import Data.IORef +import Data.Time.Clock + +-- import Control.Monad.Par.Unsafe +import Control.Monad.Par.Scheds.Trace +import Control.Monad.Par.Scheds.TraceInternal (Par(..),Trace(Fork),runCont,runParAsync) + +------------------------------------------------------------ +-- Helpers + +_unsafeio :: IO a -> Par a +_unsafeio io = let x = unsafePerformIO io in + x `seq` return x + +_waste_time :: Int -> Double +_waste_time n = loop n 1.00111 + where + loop 0 !x = x + loop !n !x | x > 100.0 = loop (n-1) (x / 2) + loop !n !x = loop (n-1) (x + x * 0.5011) + +-- This version watches the clock so it uses a constant amount of time +-- regadless of compile/interpret mode an opt lvl. +waste_time :: Double -> IO Double +waste_time seconds = + do strt <- getCurrentTime + let loop !x | x > 100.0 = chk (x / 2) + loop !x = chk (x + x * 0.5011) + chk !x = do t <- getCurrentTime + if diffUTCTime t strt >= realToFrac seconds + then return x + else loop x + loop 1.00111 + +-- Obviously this takes a lot longer if it's interpreted: +--awhile = 300000000 +awhile = 3 * 1000 * 1000 +-- awhile = 300000 + +atomicModifyIORef_ rf fn = atomicModifyIORef rf (\x -> (fn x, ())) + + +-- Haskell doesn't offer a way to create a Handle for in-memory output. +-- So here we use IORefs instead +collectOutput :: (IORef [String] -> IO ()) -> IO String +collectOutput fn = + do c <- newIORef [] + fn c + ls <- readIORef c + return (unlines (reverse ls)) + +prnt :: IORef [String] -> String -> IO () +prnt ref str = atomicModifyIORef_ ref (str:) + +_prnt :: IORef [String] -> String -> Par () +_prnt ref = _unsafeio . prnt ref + + + +-- ----------------------------------------------------------------------------- + +-- assertException :: (Exception e, Eq e) => e -> IO a -> IO () +-- assertException ex action = +-- handleJust isWanted (const $ return ()) $ do +-- action +-- assertFailure $ "Expected exception: " ++ show ex +-- where isWanted = guard . (== ex) + +-- Ensure that evaluating an expression returns an exception +assertException :: String -> a -> IO () +assertException msg val = do + x <- catch (do evaluate val; return Nothing) + (\e -> do putStrLn$ "Good. Caught exception: " ++ show (e :: SomeException) + return (Just$ show e)) + case x of + Nothing -> error "Failed to get an exception!" + Just s -> + if isInfixOf msg s + then return () + else error$ "Got the wrong exception, expected to see the text: "++ show msg + ++ "\nInstead got this exception:\n " ++ show s + diff --git a/tests/TestParDist.hs b/tests/TestParDist.hs new file mode 100644 --- /dev/null +++ b/tests/TestParDist.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-} +{-# OPTIONS_GHC -O2 -ddump-splices #-} + +-- Simple tests of distributed work stealing. +---------------------------------------------- + +import System.Environment (getArgs) +import qualified Control.Monad.Par.Meta.Dist as D + +import Control.Monad.IO.Class (liftIO) +import Control.Monad (mapM_) +-- Tweaked version of CloudHaskell's closures: +import Remote2.Call (mkClosureRec, remotable) + +import Control.Concurrent (myThreadId, threadDelay) +import System.Process (readProcess) +import System.Posix.Process (getProcessID) +import Data.Char (isSpace) +import Data.Typeable +import Data.Binary + +import qualified Data.ByteString.Char8 as BS + +-- import qualified Data.IntMap as M +-- import qualified Data.Set as M +-------------------------------------------------------------------------------- + + +-- A description of a fake work topology which is executed by sleeping +-- (threadDelay) different amounts at different points. +-- Presently this describes futures-only work: +data FakeWork = Work Time FakeWork + | Fork FakeWork FakeWork + | SyncAll FakeWork + | Nop + +-- | Spawn Id FakeWork FakeWork +-- | Seq [FakeWork] +-- | Sync Id FakeWork + deriving (Eq,Show,Read,Typeable) +-- All constructors take a continuation. + +type Time = Int -- Time in milliseconds +type Id = Int + +-- A simple test that ensures a single steal for two workers: +-- t1 = Spawn 11 (Work 101) $ +-- Seq [Work 102, +-- Sync 11] + +t1 = Fork (Work 101 Nop) $ + Work 102 $ + SyncAll Nop + +t2 = switcher 3 3 True + +-- This one alternates where the *real* work will be. +-- +-- Takes number of switches. Performs a shrinking number of work +-- items per "straightaway": +switcher 1 m _ = Work 100 (SyncAll Nop) +switcher _ _ False = Work 101 (SyncAll Nop) +switcher n m True = Work 102 $ switcher n (m-1) True +switcher n 1 b = Fork (switcher (n-1) n b) + (switcher (n-1) n (not b)) + +---------------------------------------------------------------------------------------------------- + +runTest :: FakeWork -> D.Par () +--runTest fw = theloop fw M.empty +runTest fw = theloop fw [] + +theloop fw ls = + case fw of + Nop -> return () + Work t cont -> + do liftIO$ threadDelay (t * 1000) + liftIO$ putStrLn$ "Finished work "++show t + theloop cont ls +-- Seq ls -> mapM_ theloop ls +-- Spawn id fw cont -> + Fork child cont -> + do + iv <- D.longSpawn$ $(mkClosureRec 'runTest) child + -- Associate id with ivar +-- theloop cont (M.insert id iv mp) + theloop cont (iv:ls) + SyncAll cont -> + do mapM_ D.get ls + theloop cont [] + +-- Generate stub code for RPC: +remotable ['runTest] + +-- instance Serialize FakeWork where + +instance Binary FakeWork where + put fw = put (show fw) +-- get str = return (read (BS.unpack str)) + get = get >>= return . read + + +---------------------------------------------------------------------------------------------------- + +main = do + [version] <- getArgs + case version of + "slave" -> D.runParSlaveWithTransport [__remoteCallMetaData] D.TCP + "master" -> do + D.runParDistWithTransport [__remoteCallMetaData] D.TCP (runTest t1) + putStrLn $ "Finished with work. Calling SHUTDOWN..." + D.shutdownDist + putStrLn $ "... returned from shutdown, apparently successful." + + str -> error$"Unhandled mode: " ++ str diff --git a/tests/Test_ContReaderT.hs b/tests/Test_ContReaderT.hs new file mode 100644 --- /dev/null +++ b/tests/Test_ContReaderT.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE CPP, ScopedTypeVariables #-} + +-- If we instead commute the monad transformers we can change the +-- reader value observed by a continuation. + +import Control.Monad.Cont as C +import qualified Control.Monad.Reader as R +import Data.IORef +import Text.Printf + +type M a = C.ContT () (R.ReaderT Int IO) a + +test ref = do + x <- R.ask + liftIO$ printf "Observed value %d before callCC\n" x + callCC$ \cont -> do + liftIO$ writeIORef ref cont + liftIO$ printf "Write ioref inside callcc...\n" + z <- R.ask + liftIO$ printf "Observed value %d in invoked continuation\n" z + return () + +main = do ref :: IORef (() -> M ()) <- newIORef (error "should not be used") + let m0 = test ref + m1 = C.runContT m0 (\ () -> return ()) + m2 = R.runReaderT m1 (100::Int) + m2 + + k <- readIORef ref + let m3 = do + w <- lift$ R.ask + liftIO$ putStrLn ("In new runReader instance: observed " ++ show w) + k () + liftIO$ putStrLn " !! Should not reach here..." + + R.runReaderT (C.runContT m3 (\ () -> return ())) 200 + putStrLn "Done with main." diff --git a/tests/Test_ReaderContT.hs b/tests/Test_ReaderContT.hs new file mode 100644 --- /dev/null +++ b/tests/Test_ReaderContT.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE CPP #-} + + +import Control.Monad.Cont as C +import qualified Control.Monad.Reader as R +import Data.IORef +import Text.Printf + +type M a = R.ReaderT Int ContIO a +type ContIO = C.ContT () IO + +test ref = do + x <- R.ask + liftIO$ printf "Observed value %d before callCC\n" x + callCC$ \cont -> do + y <- R.ask + liftIO$ writeIORef ref cont + liftIO$ printf "Observed value %d inside callCC\n" y + z <- R.ask + liftIO$ printf "Observed value %d in invoked continuation\n" z + return () + +main = do ref <- newIORef (error "unused") + let test' = do test ref + m1 = do R.runReaderT test' (100::Int) + + C.runContT m1 (\ () -> return ()) + k <- readIORef ref + let m2 = do w <- R.ask + liftIO$ putStrLn (" In new runReader instance: observed " ++ show w) + k () + liftIO$ putStrLn " !! Should not reach here..." + + C.runContT (R.runReaderT m2 200) (\ () -> return ()) + putStrLn "Done with main." diff --git a/tests/hs_cassandra_microbench.hs b/tests/hs_cassandra_microbench.hs new file mode 100644 --- /dev/null +++ b/tests/hs_cassandra_microbench.hs @@ -0,0 +1,88 @@ + +-- Peculiar: +-- * Requires hscassandra 0.0.8, available on github only + +-- Functions to: +-- * Connect to a cassandra nosql server +-- * Put a bytestring +-- * Get a bytestring + +-- This file acts as a microbench for insertion or retrieval of keys + +import Database.Cassandra +import Database.Cassandra.Types +import qualified Data.ByteString.Lazy.Char8 as BS +import qualified Database.Cassandra.Thrift.Cassandra_Types as CT +import Data.Either.Utils +import qualified Data.List as L +import System.Time +import Data.Time.Clock +import System.Environment +import Control.Monad +import qualified Data.Set as S + + +config = CassandraConfig { cassandraKeyspace = "Test2" + , cassandraConsistencyLevel = ONE + , cassandraHostname = "127.0.0.1" + , cassandraPort = 9160 + , cassandraUsername = "" + , cassandraPassword = "" + } + +pack :: [Char] -> BS.ByteString +pack string = BS.pack string + +deColumnValue :: Column -> BS.ByteString +deColumnValue (Column _ value _) = value + +fetchValue string = runCassandraT config $ do + res <- get "Users" (pack string) AllColumns + return $ deColumnValue $ head $ res + +insertValue string byteString = runCassandraT config $ do + insert "Users" (pack string) [ (pack "name") =: byteString ] + +removeValue string = runCassandraT config $ do + remove "Users" (pack string) (ColNames [ (pack "name") ]) + +main = do + + --input <- readFile "/usr/share/dict/words" + --let words = tail $ lines input + let words = map (\n -> (show n) ++ "Thequickbrownfoxjumpedoverthelazydog") $ take 5000 [1..] + + + putStrLn "Benchmarking Cassandra bindings by writing in every dictionary file word as a k,v pair." + + putStrLn "About to start timing writes..." + + writeStart <- getCurrentTime + mapM_ (\w -> insertValue w (pack w)) words + writeStop <- getCurrentTime + + let writeTime = diffUTCTime writeStop writeStart + + putStrLn ("Writes took " ++ (show $ writeTime)) + + putStrLn "Starting reads..." + + readStart <- getCurrentTime + mapM_ (\w -> fetchValue w) words + let pairs = length words + readStop <- getCurrentTime + + let readTime = diffUTCTime readStop readStart + + putStrLn ("Reads took " ++ (show $ readTime)) + + let totalTime = diffUTCTime readStop writeStart + + putStrLn ("Total time: " ++ (show $ totalTime)) + + putStrLn "Removing keys..." + + mapM_ (\w -> removeValue w) words + + + diff --git a/tests/hs_cassandra_microbench2.hs b/tests/hs_cassandra_microbench2.hs new file mode 100644 --- /dev/null +++ b/tests/hs_cassandra_microbench2.hs @@ -0,0 +1,91 @@ + +-- Peculiar: +-- * Requires hscassandra 0.0.8, available on github only + +-- Functions to: +-- * Connect to a cassandra nosql server +-- * Put a bytestring +-- * Get a bytestring + +-- This file acts as a microbench for insertion or retrieval of keys + +import Database.Cassandra +import Database.Cassandra.Types +import qualified Data.ByteString.Lazy.Char8 as BS +import qualified Database.Cassandra.Thrift.Cassandra_Types as CT +import Data.Either.Utils +import qualified Data.List as L +import System.Time +import Data.Time.Clock +import System.Environment +import Control.Monad +import qualified Data.Set as S + + +config = CassandraConfig { cassandraKeyspace = "Test2" + , cassandraConsistencyLevel = ONE + , cassandraHostname = "127.0.0.1" + , cassandraPort = 9160 + , cassandraUsername = "" + , cassandraPassword = "" + } + +pack :: [Char] -> BS.ByteString +pack string = BS.pack string + +deColumnValue :: Column -> BS.ByteString +deColumnValue (Column _ value _) = value + +fetchValue string = runCassandraT config $ do + res <- get "Users" (pack string) AllColumns + return $ deColumnValue $ head $ res + +insertValue string byteString = runCassandraT config $ do + insert "Users" (pack string) [ (pack "name") =: byteString ] + +removeValue string = runCassandraT config $ do + remove "Users" (pack string) (ColNames [ (pack "name") ]) + +main = do + + let words = map (\n -> (show n) ++ "Thequickbrownfoxjumpedoverthelazydog") $ take 50000 [1..] + + putStrLn "Benchmarking Cassandra binding." + + putStrLn "About to start timing writes..." + + writeStart <- getCurrentTime + + runCassandraT config $ do + mapM_ (\w -> insert "Users" (pack w) [(pack "name") =: (pack w) ]) words + + writeStop <- getCurrentTime + + let writeTime = diffUTCTime writeStop writeStart + + putStrLn ("Writes took " ++ (show $ writeTime)) + + putStrLn "Starting reads..." + + readStart <- getCurrentTime + + runCassandraT config $ do + mapM_ (\w -> get "Users" (pack w) AllColumns) words + + readStop <- getCurrentTime + + let readTime = diffUTCTime readStop readStart + + putStrLn ("Reads took " ++ (show $ readTime)) + + let totalTime = diffUTCTime readStop writeStart + + putStrLn ("Total time: " ++ (show $ totalTime)) + + putStrLn "Removing keys..." + + runCassandraT config $ do + mapM_ (\w -> remove "Users" (pack w) (ColNames [ (pack "name") ])) words + + +