    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Parallel.Strategies
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Parallel strategy combinators. See
    -- <http://www.macs.hw.ac.uk/~dsg/gph/papers/html/Strategies/strategies.html>
    -- for more information.
    --
    -- Original authors:
    --	Phil Trinder, Hans-Wolfgang Loidl, Kevin Hammond et al.
    --
    -----------------------------------------------------------------------------
    module Control.Parallel.Strategies (
       -- *	Strategy Type, Application and Semantics
       Done, Strategy,
       (>|), (>||),
       using, demanding, sparking,
       -- *	Basic Strategies
       r0, rwhnf, NFData(..),
       -- * Strategic Function Application
       ($|), ($||),
       (.|), (.||),
       (-|), (-||),
       -- * Tuples
       seqPair, parPair,
       seqTriple, parTriple,
       -- * Lists: Parallel Strategies
       parList, parListN, parListNth, parListChunk,
       parMap, parFlatMap, parZipWith,
       -- * Lists: Sequential Strategies
       seqList, seqListN, seqListNth, parBuffer,
       -- *	Arrays
       seqArr, parArr,
       -- * Deprecated types and functions
       sPar, sSeq,
       Assoc(..),
       fstPairFstList, force, sforce
      ) where

    -- based on hslibs/concurrent/Strategies.lhs; see it for more detailed
    -- code comments.

    import Control.Parallel as Parallel (par, pseq)
    import Data.Array
    import Data.Complex
    import Data.Int
    import qualified Data.IntMap (IntMap, toList)
    import qualified Data.IntSet (IntSet, toList)
    import qualified Data.Map (Map, toList)
    import qualified Data.Set (Set, toList)
    import qualified Data.Tree (Tree(..))
    import Data.Word

    import Prelude hiding (seq)
    import qualified Prelude (seq)

    -- not a terribly portable way of getting at Ratio rep.
    #ifdef __GLASGOW_HASKELL__
    import GHC.Real	(Ratio(..))	-- The basic defns for Ratio
    #endif

    #ifdef __HUGS__
    import Hugs.Prelude(Ratio(..) )
    #endif

    #ifdef __NHC__
    import Ratio (Ratio(..) )
    #endif

    infixl 0 `using`,`demanding`,`sparking`              -- weakest precedence!

    infixr 2 >||                -- another name for par
    infixr 3 >|                 -- another name for seq
    infixl 6 $||, $|            -- strategic function application (seq and par)
    infixl 9 .|, .||, -|, -||   -- strategic (inverse) function composition

    -- We need 'pseq', not the Prelude 'seq' here.  See the documentation
    -- with 'pseq' in Control.Parallel.
    seq = Parallel.pseq

    ------------------------------------------------------------------------------
    -- *			Strategy Type, Application and Semantics
    ------------------------------------------------------------------------------

    {-
    The basic combinators for strategies are 'par' and 'seq' but with types that
    indicate that they only combine the results of a strategy application.

    NB: This version can be used with Haskell 1.4 (GHC 2.05 and beyond), *but*
        you won't get strategy checking on seq (only on par)!

    The operators >| and >|| are alternative names for `seq` and `par`.
    With the introduction of a Prelude function `seq` separating the Prelude
    function from the Strategy function becomes a pain. The notation also matches
    the notation for strategic function application.
    -}

    type Done = ()

    -- | A strategy takes a value and returns a 'Done' value to indicate that
    --   the specifed evaluation has been performed.
    type Strategy a = a -> Done

    -- | Evaluates the first argument before the second.
    (>|) :: Done -> Done -> Done
    {-# INLINE (>|) #-}
    (>|) = Prelude.seq

    -- | Evaluates the first argument in parallel with the second.
    (>||) :: Done -> Done -> Done
    {-# INLINE (>||) #-}
    (>||) = Parallel.par

    -- | Takes a value and a strategy, and applies the strategy to the
    -- value before returning the value. Used to express data-oriented
    -- parallelism. @x \`using\` s@ is a projection on @x@, i.e. both:
    --
    -- [a retraction] @x \`using\` s@ &#x2291; @x@
    --
    -- [idempotent] @(x \`using\` s) \`using\` s@ = @x \`using\` s@
    --
    using :: a -> Strategy a -> a
    using x s = s x `seq` x

    -- | Evaluates the second argument before the first.
    -- Used to express control-oriented parallelism. The second
    -- argument is usually a strategy application.
    demanding :: a -> Done -> a
    demanding = flip seq

    -- | Evaluates the second argument in parallel with the first.
    -- Used to express control-oriented
    -- parallelism. The second argument is usually a strategy application.
    sparking :: a -> Done -> a
    sparking  = flip Parallel.par
    -- Sparking should only be used
    -- with a singleton sequence as it is not necessarily executed.

    -- | A strategy corresponding to 'par':
    -- @x \`par\` e@ = @e \`using\` sPar x@.
    --
    -- 'sPar' has been superceded by 'sparking'.
    -- Replace @e \`using\` sPar x@ with @e \`sparking\` rwhnf x@.
    {-# DEPRECATED sPar "Use sparking instead." #-}
    sPar :: a -> Strategy b
    sPar x y = x `par` ()

    -- | A strategy corresponding to 'seq':
    -- @x \`seq\` e@ = @e \`using\` sSeq x@.
    --
    -- 'sSeq' has been superceded by 'demanding'.
    -- Replace @e \`using\` sSeq x@ with @e \`demanding\` rwhnf x@.
    {-# DEPRECATED sSeq "Use demanding instead." #-}
    sSeq :: a -> Strategy b
    sSeq x y = x `seq` ()

    -----------------------------------------------------------------------------
    -- *			Basic Strategies
    -----------------------------------------------------------------------------

    -- | Performs /no/ evaluation of its argument.
    r0 :: Strategy a
    r0 x = ()

    -- | Reduces its argument to weak head normal form.
    rwhnf :: Strategy a
    rwhnf x = x `seq` ()

    class NFData a where
      -- | Reduces its argument to (head) normal form.
      rnf :: Strategy a
      -- Default method. Useful for base types. A specific method is necessay for
      -- constructed types
      rnf = rwhnf

    class (NFData a, Integral a) => NFDataIntegral a
    class (NFData a, Ord a) => NFDataOrd a

    ------------------------------------------------------------------------------
    -- *                     Strategic Function Application
    ------------------------------------------------------------------------------

    {-
    These are very
    handy when writing pipeline parallelism asa sequence of @$@, @$|@ and
    @$||@'s. There is no need of naming intermediate values in this case. The
    separation of algorithm from strategy is achieved by allowing strategies
    only as second arguments to @$|@ and @$||@.
    -}

    -- | Sequential function application. The argument is evaluated using
    --   the given strategy before it is given to the function.
    ($|) :: (a -> b) -> Strategy a -> a -> b
    f $| s  = \ x -> f x `demanding` s x

    -- | Parallel function application. The argument is evaluated using
    -- the given strategy, in parallel with the function application.
    ($||) :: (a -> b) -> Strategy a -> a -> b
    f $|| s = \ x -> f x `sparking` s x

    -- | Sequential function composition. The result of
    -- the second function is evaluated using the given strategy,
    -- and then given to the first function.
    (.|) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c)
    (.|) f s g = \ x -> let  gx = g x
                        in   f gx `demanding` s gx

    -- | Parallel function composition. The result of the second
    -- function is evaluated using the given strategy,
    -- in parallel with the application of the first function.
    (.||) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c)
    (.||) f s g = \ x -> let  gx = g x
                         in   f gx `sparking` s gx

    -- | Sequential inverse function composition,
    -- for those who read their programs from left to right.
    -- The result of the first function is evaluated using the
    -- given strategy, and then given to the second function.
    (-|) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c)
    (-|) f s g = \ x -> let  fx = f x
                        in   g fx `demanding` s fx

    -- | Parallel inverse function composition,
    -- for those who read their programs from left to right.
    -- The result of the first function is evaluated using the
    -- given strategy, in parallel with the application of the
    -- second function.
    (-||) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c)
    (-||) f s g = \ x -> let  fx = f x
                         in   g fx `sparking` s fx

    ------------------------------------------------------------------------------
    --			Marking a Strategy
    ------------------------------------------------------------------------------

    {-
    Marking a strategy.

    Actually, @markStrat@  sticks a label @n@  into the sparkname  field of the
    thread executing strategy @s@. Together with a runtime-system that supports
    propagation of sparknames to the children this means that this strategy and
    all its children have  the sparkname @n@ (if the  static sparkname field in
    the @parGlobal@ annotation contains the value 1). Note, that the @SN@ field
    of starting the marked strategy itself contains the sparkname of the parent
    thread. The END event contains @n@ as sparkname.
    -}

    #if 0
    markStrat :: Int -> Strategy a -> Strategy a
    markStrat n s x = unsafePerformPrimIO (
         _casm_ ``%r = set_sparkname(CurrentTSO, %0);'' n `thenPrimIO` \ z ->
         returnPrimIO (s x))
    #endif

    -----------------------------------------------------------------------------
    --			Strategy Instances and Functions
    -----------------------------------------------------------------------------

    -----------------------------------------------------------------------------
    -- *	                Tuples
    -----------------------------------------------------------------------------

    {-
    We currently support up to 9-tuples. If you need longer tuples you have to
    add the instance explicitly to your program.
    -}

    instance (NFData a, NFData b) => NFData (a,b) where
      rnf (x,y) = rnf x `seq` rnf y

    instance (NFData a, NFData b, NFData c) => NFData (a,b,c) where
      rnf (x,y,z) = rnf x `seq` rnf y `seq` rnf z

    instance (NFData a, NFData b, NFData c, NFData d) => NFData (a,b,c,d) where
      rnf (x1,x2,x3,x4) = rnf x1 `seq`
    		        rnf x2 `seq`
    		        rnf x3 `seq`
    		        rnf x4

    instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5) =>
             NFData (a1, a2, a3, a4, a5) where
      rnf (x1, x2, x3, x4, x5) =
                      rnf x1 `seq`
                      rnf x2 `seq`
                      rnf x3 `seq`
                      rnf x4 `seq`
                      rnf x5

    instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6) =>
             NFData (a1, a2, a3, a4, a5, a6) where
      rnf (x1, x2, x3, x4, x5, x6) =
                      rnf x1 `seq`
                      rnf x2 `seq`
                      rnf x3 `seq`
                      rnf x4 `seq`
                      rnf x5 `seq`
                      rnf x6

    instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) =>
             NFData (a1, a2, a3, a4, a5, a6, a7) where
      rnf (x1, x2, x3, x4, x5, x6, x7) =
                      rnf x1 `seq`
                      rnf x2 `seq`
                      rnf x3 `seq`
                      rnf x4 `seq`
                      rnf x5 `seq`
                      rnf x6 `seq`
                      rnf x7

    instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8) =>
             NFData (a1, a2, a3, a4, a5, a6, a7, a8) where
      rnf (x1, x2, x3, x4, x5, x6, x7, x8) =
                      rnf x1 `seq`
                      rnf x2 `seq`
                      rnf x3 `seq`
                      rnf x4 `seq`
                      rnf x5 `seq`
                      rnf x6 `seq`
                      rnf x7 `seq`
                      rnf x8

    instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8, NFData a9) =>
             NFData (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
      rnf (x1, x2, x3, x4, x5, x6, x7, x8, x9) =
                      rnf x1 `seq`
                      rnf x2 `seq`
                      rnf x3 `seq`
                      rnf x4 `seq`
                      rnf x5 `seq`
                      rnf x6 `seq`
                      rnf x7 `seq`
                      rnf x8 `seq`
                      rnf x9

    -- | Apply two strategies to the elements of a pair sequentially
    --   from left to right.
    seqPair :: Strategy a -> Strategy b -> Strategy (a,b)
    seqPair strata stratb (x,y) = strata x `seq` stratb y

    -- | Apply two strategies to the elements of a pair in parallel.
    parPair :: Strategy a -> Strategy b -> Strategy (a,b)
    parPair strata stratb (x,y) = strata x `par` stratb y `par` ()
    -- The reason for the last 'par' is so that the strategy terminates
    -- quickly. This is important if the strategy is used as the 1st
    -- argument of a seq

    -- | Apply three strategies to the elements of a triple in sequentially
    --   from left to right.
    seqTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
    seqTriple strata stratb stratc p@(x,y,z) =
      strata x `seq`
      stratb y `seq`
      stratc z

    -- | Apply three strategies to the elements of a triple in parallel.
    parTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
    parTriple strata stratb stratc (x,y,z) =
      strata x `par`
      stratb y `par`
      stratc z `par`
      ()

    -----------------------------------------------------------------------------
    -- 			Atomic types
    -----------------------------------------------------------------------------

    {-
    Weak head normal form and normal form are identical for integers, so the
    default rnf is sufficient.
    -}
    instance NFData Int
    instance NFData Integer
    instance NFData Float
    instance NFData Double

    instance NFData Int8
    instance NFData Int16
    instance NFData Int32
    instance NFData Int64

    instance NFData Word8
    instance NFData Word16
    instance NFData Word32
    instance NFData Word64

    instance NFDataIntegral Int
    instance NFDataOrd Int

    --Rational and complex numbers.

    instance (Integral a, NFData a) => NFData (Ratio a) where
      rnf (x:%y) = rnf x `seq`
                   rnf y `seq`
                   ()

    instance (RealFloat a, NFData a) => NFData (Complex a) where
      rnf (x:+y) = rnf x `seq`
    	         rnf y `seq`
                   ()

    instance NFData Char
    instance NFData Bool
    instance NFData ()

    -----------------------------------------------------------------------------
    -- 			Various library types
    -----------------------------------------------------------------------------

    instance NFData a => NFData (Maybe a) where
        rnf Nothing  = ()
        rnf (Just x) = rnf x

    instance (NFData a, NFData b) => NFData (Either a b) where
        rnf (Left x)  = rnf x
        rnf (Right y) = rnf y

    instance (NFData k, NFData a) => NFData (Data.Map.Map k a) where
        rnf = rnf . Data.Map.toList

    instance NFData a => NFData (Data.Set.Set a) where
        rnf = rnf . Data.Set.toList

    instance NFData a => NFData (Data.Tree.Tree a) where
        rnf (Data.Tree.Node r f) = rnf r `seq` rnf f

    instance NFData a => NFData (Data.IntMap.IntMap a) where
        rnf = rnf . Data.IntMap.toList

    instance NFData Data.IntSet.IntSet where
        rnf = rnf . Data.IntSet.toList

    -----------------------------------------------------------------------------
    -- 			Lists
    -----------------------------------------------------------------------------

    instance NFData a => NFData [a] where
      rnf [] = ()
      rnf (x:xs) = rnf x `seq` rnf xs

    ----------------------------------------------------------------------------
    -- *                   Lists: Parallel Strategies
    ----------------------------------------------------------------------------

    -- | Applies a strategy to every element of a list in parallel.
    parList :: Strategy a -> Strategy [a]
    parList strat []     = ()
    parList strat (x:xs) = strat x `par` (parList strat xs)

    -- | Applies a strategy to the first @n@ elements of a list in parallel.
    parListN :: (Integral b) => b -> Strategy a -> Strategy [a]
    parListN n strat []     = ()
    parListN 0 strat xs     = ()
    parListN n strat (x:xs) = strat x `par` (parListN (n-1) strat xs)

    -- | Evaluates @n@ elements of the spine of the argument list and applies
    -- the given strategy to the @n@th element (if there is one) in parallel with
    -- the result. E.g. @parListNth 2 [e1, e2, e3]@ evaluates @e3@.
    parListNth :: Int -> Strategy a -> Strategy [a]
    parListNth n strat xs
      | null rest = ()
      | otherwise = strat (head rest) `par` ()
      where
        rest = drop n xs

    -- | Splits a list into chunks (sub-sequences) of length @n@,
    -- and applies a strategy sequentially to the elements in each
    -- chunk. The chunks are evaluated in parallel.
    -- This is useful for increasing the grain size.
    parListChunk :: Int -> Strategy a -> Strategy [a]
    parListChunk n strat [] = ()
    parListChunk n strat xs = seqListN n strat xs `par`
    			    parListChunk n strat (drop n xs)

    -- | Applies a function to each element of a list and
    -- and evaluates the result list in parallel,
    -- using the given strategy for each element.
    parMap :: Strategy b -> (a -> b) -> [a] -> [b]
    parMap strat f xs = map f xs `using` parList strat

    -- | Uses 'parMap' to apply a list-valued function to each
    -- element of a list in parallel, and concatenates the results.
    parFlatMap :: Strategy [b] -> (a -> [b]) -> [a] -> [b]
    parFlatMap strat f xs = concat (parMap strat f xs)

    -- | Zips together two lists using a function,
    -- and evaluates the result list in parallel.
    parZipWith :: Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c]
    parZipWith strat z as bs =
      zipWith z as bs `using` parList strat

    ----------------------------------------------------------------------------
    -- *                     Lists: Sequential Strategies
    ----------------------------------------------------------------------------

    -- | Sequentially applies a strategy to each element of a list.
    seqList :: Strategy a -> Strategy [a]
    seqList strat []     = ()
    seqList strat (x:xs) = strat x `seq` (seqList strat xs)

    -- | Sequentially applies a strategy to the first n elements of a list.
    seqListN :: (Integral a) => a -> Strategy b -> Strategy [b]
    seqListN n strat []     = ()
    seqListN 0 strat xs     = ()
    seqListN n strat (x:xs) = strat x `seq` (seqListN (n-1) strat xs)

    -- | Applies a strategy to the @n@th element of a list
    --  (if there is one) before returning the result.
    --  E.g. @seqListNth 2 [e1, e2, e3]@ evaluates @e3@.
    seqListNth :: Int -> Strategy b -> Strategy [b]
    seqListNth n strat xs
      | null rest = ()
      | otherwise = strat (head rest)
      where
        rest = drop n xs

    -- | Parallel n-buffer function added for the revised version of the strategies
    -- paper. 'parBuffer' supersedes the older @fringeList@. It has the same
    -- semantics.
    parBuffer :: Int -> Strategy a -> [a] -> [a]
    parBuffer n s xs =
      return xs (start n xs)
      where
        return (x:xs) (y:ys) = (x:return xs ys) `sparking` s y
        return xs     []     = xs

        start n []     = []
        start 0 ys     = ys
        start n (y:ys) = start (n-1) ys `sparking` s y

    {-
     'fringeList' implements a `rolling buffer' of length n, i.e.applies a
     strategy to the nth element of list when the head is demanded. More
     precisely:

       semantics:         fringeList n s = id :: [b] -> [b]
       dynamic behaviour: evalutates the nth element of the list when the
    		      head is demanded.

     The idea is to provide a `rolling buffer' of length n.
    fringeList :: (Integral a) => a -> Strategy b -> [b] -> [b]
    fringeList n strat [] = []
    fringeList n strat (r:rs) =
      seqListNth n strat rs `par`
      r:fringeList n strat rs
    -}

    ------------------------------------------------------------------------------
    -- *			Arrays
    ------------------------------------------------------------------------------
    instance (Ix a, NFData a, NFData b) => NFData (Array a b) where
      rnf x = rnf (bounds x) `seq` seqList rnf (elems x) `seq` ()

    -- | Apply a strategy to all elements of an array sequentially.
    seqArr :: (Ix b) => Strategy a -> Strategy (Array b a)
    seqArr s arr = seqList s (elems arr)

    -- | Apply a strategy to all elements of an array in parallel.
    parArr :: (Ix b) => Strategy a -> Strategy (Array b a)
    parArr s arr = parList s (elems arr)

    {-# DEPRECATED Assoc "Does not belong in Control.Parallel.Strategies" #-}
    data  Assoc a b =  a := b  deriving ()

    instance (NFData a, NFData b) => NFData (Assoc a b) where
      rnf (x := y) = rnf x `seq` rnf y `seq` ()

    ------------------------------------------------------------------------------
    -- *	                Some strategies specific for Lolita
    ------------------------------------------------------------------------------

    {-# DEPRECATED fstPairFstList "This was just an example. Write your own." #-}
    fstPairFstList :: (NFData a) => Strategy [(a,b)]
    fstPairFstList = seqListN 1 (seqPair rwhnf r0)

    -- Some HACKs for Lolita. AFAIK force is just another name for our rnf and
    -- sforce is a shortcut (definition here is identical to the one in Force.lhs)

    {-# DEPRECATED force, sforce "Lolita-specific hacks." #-}
    force :: (NFData a) => a -> a
    sforce :: (NFData a) => a -> b -> b

    force = id $| rnf
    sforce x y = force x `seq` y