Repository : ssh://darcs.haskell.org//srv/darcs/packages/parallel On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e4f34d858cd330084abbc86e3e4dbe6727b43f06 >--------------------------------------------------------------- commit e4f34d858cd330084abbc86e3e4dbe6727b43f06 Author: Simon Marlow <[email protected]> Date: Thu Aug 11 14:41:14 2011 +0100 Change Eval to be a State# monad, and use GHC's new spark# and seq# primitives to implement rseq and rpar. >--------------------------------------------------------------- Control/Parallel/Strategies.hs | 24 ++++++++++++------------ 1 files changed, 12 insertions(+), 12 deletions(-) diff --git a/Control/Parallel/Strategies.hs b/Control/Parallel/Strategies.hs index 18c9668..14b0c9d 100644 --- a/Control/Parallel/Strategies.hs +++ b/Control/Parallel/Strategies.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MagicHash, UnboxedTuples #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies @@ -111,7 +111,7 @@ module Control.Parallel.Strategies ( , (-||) -- * For Strategy programmers - , Eval(Done) -- instances: Monad, Functor, Applicative + , Eval -- instances: Monad, Functor, Applicative , runEval -- :: Eval a -> a , @@ -146,7 +146,7 @@ import Control.Monad import qualified Control.Seq -import GHC.Exts (lazy, par#) +import GHC.Exts infixr 9 `dot` -- same as (.) infixl 0 `using` -- lowest precedence and associate to the left @@ -187,17 +187,17 @@ infixl 0 `using` -- lowest precedence and associate to the left -- > evalPair f g (a,b) = pure (,) <$> f a <*> g b -- -data Eval a = Done a +newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #)) -- | Pull the result out of the monad. runEval :: Eval a -> a -runEval (Done x) = x +runEval (Eval x) = case x realWorld# of (# _, a #) -> a instance Monad Eval where - return x = Done x - Done x >>= k = lazy (k x) -- Note: pattern 'Done x' makes '>>=' strict - -{-# RULES "lazy Done" forall x . lazy (Done x) = Done x #-} + return x = Eval $ \s -> (# s, x #) + Eval x >>= k = Eval $ \s -> case x s of + (# s', a #) -> case lazy (k a) of + Eval f -> f s' instance Functor Eval where fmap = liftM @@ -325,7 +325,7 @@ r0 x = return x -- > rseq == evalSeq Control.Seq.rseq -- rseq :: Strategy a -rseq x = x `seq` return x +rseq x = Eval $ \s -> seq# x s -- Proof of rseq == evalSeq Control.Seq.rseq -- @@ -340,7 +340,7 @@ rseq x = x `seq` return x -- > rdeepseq == evalSeq Control.Seq.rdeepseq -- rdeepseq :: NFData a => Strategy a -rdeepseq x = rnf x `pseq` return x +rdeepseq x = do rseq (rnf x); return x -- Proof of rdeepseq == evalSeq Control.Seq.rdeepseq -- @@ -353,7 +353,7 @@ rdeepseq x = rnf x `pseq` return x -- | 'rpar' sparks its argument (for evaluation in parallel). rpar :: a -> Eval a -rpar x = case (par# x) of { _ -> Done x } +rpar x = Eval $ \s -> spark# x s {-# INLINE rpar #-} -- -------------------------------------------------------------------------- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
