{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, DefaultSignatures, TypeOperators, FlexibleContexts #-}

module Parallel
    (NFData, parMap, rdeepseq) where

import Control.Monad
import GHC.Exts
import Control.DeepSeq

infixl 0 `using`


type Strategy a = a -> Eval a

newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))



instance Functor Eval where
  fmap = liftM

instance Applicative Eval where
  pure x = Eval $ \s -> (# s, x #)
  (<*>)  = ap

instance Monad Eval where
  return = pure
  Eval x >>= k = Eval $ \s -> case x s of
                                (# s', a #) -> case k a of
                                                      Eval f -> f s'

rpar :: Strategy a
rpar  x = Eval $ \s -> spark# x s

rparWith :: Strategy a -> Strategy a
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

using :: a -> Strategy a -> a
x `using` strat = runEval (strat x)


rdeepseq :: NFData a => Strategy a
rdeepseq x = do rseq (rnf x); return x

parList :: Strategy a -> Strategy [a]
parList strat = traverse (rparWith strat)

parMap :: Strategy b -> (a -> b) -> [a] -> [b]
parMap strat f = (`using` parList strat) . map f


runEval :: Eval a -> a
runEval (Eval x) = case x realWorld# of (# _, a #) -> a

rseq :: Strategy a
rseq x = Eval $ \s -> seq# x s