[commit: parallel] master: make this compile with 7.0 and older again (3d97b16)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/parallel

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/3d97b1672e38fee8562dc07ef33c68bb553c43b5

>---------------------------------------------------------------

commit 3d97b1672e38fee8562dc07ef33c68bb553c43b5
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Oct 7 13:42:42 2011 +0100

    make this compile with 7.0 and older again

>---------------------------------------------------------------

 Control/Parallel/Strategies.hs |   33 +++++++++++++++++++++++++++++++++
 1 files changed, 33 insertions(+), 0 deletions(-)

diff --git a/Control/Parallel/Strategies.hs b/Control/Parallel/Strategies.hs
index 5a148bf..3fc6aea 100644
--- a/Control/Parallel/Strategies.hs
+++ b/Control/Parallel/Strategies.hs
@@ -188,7 +188,12 @@ infixl 0 `using`   -- lowest precedence and associate to the left
 -- > evalPair f g (a,b) = pure (,) <$> f a <*> g b
 --
 
+#if __GLASGOW_HASKELL__ >= 702
+
 newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))
+  -- GHC 7.2.1 added the seq# and spark# primitives, that we use in
+  -- the Eval monad implementation in order to get the correct
+  -- strictness behaviour.
 
 -- | Pull the result out of the monad.
 runEval :: Eval a -> a
@@ -199,6 +204,22 @@ instance Monad Eval where
   Eval x >>= k = Eval $ \s -> case x s of
                                 (# s', a #) -> case lazy (k a) of
                                                       Eval f -> f s'
+#else
+
+data Eval a = Done a
+
+-- | Pull the result out of the monad.
+runEval :: Eval a -> a
+runEval (Done x) = x
+
+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 #-}
+
+#endif
+
 
 instance Functor Eval where
   fmap = liftM
@@ -326,7 +347,11 @@ r0 x = return x
 -- > rseq == evalSeq Control.Seq.rseq
 --
 rseq :: Strategy a
+#if __GLASGOW_HASKELL__ >= 702
 rseq x = Eval $ \s -> seq# x s
+#else
+rseq x = x `seq` return x
+#endif
 
 -- Proof of rseq == evalSeq Control.Seq.rseq
 --
@@ -354,7 +379,11 @@ rdeepseq x = do rseq (rnf x); return x
 
 -- | 'rpar' sparks its argument (for evaluation in parallel).
 rpar :: a -> Eval a
+#if __GLASGOW_HASKELL__ >= 702
 rpar  x = Eval $ \s -> spark# x s
+#else
+rpar  x = case (par# x) of { _ -> Done x }
+#endif
 {-# INLINE rpar  #-}
 
 -- | instead of saying @rpar `dot` strat@, you can say
@@ -368,12 +397,16 @@ rpar  x = Eval $ \s -> spark# x s
 --
 --
 rparWith :: Strategy a -> Strategy a
+#if __GLASGOW_HASKELL__ >= 702
 rparWith s a = do l <- rpar r; return (case l of Lift x -> x)
   where r = case s a of
               Eval f -> case f realWorld# of
                           (# _, a' #) -> Lift a'
 
 data Lift a = Lift a
+#else
+rparWith s a = do l <- rpar (s a); return (case l of Done x -> x)
+#endif
 
 -- --------------------------------------------------------------------------
 -- Strategy combinators for Traversable data types