    {-# LANGUAGE RankNTypes, NamedFieldPuns, BangPatterns,
                 ExistentialQuantification, MultiParamTypeClasses, CPP #-}
    {- OPTIONS_GHC -Wall -fno-warn-name-shadowing -fwarn-unused-imports -}

    {-# LANGUAGE TypeFamilies #-}

    {- | 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, runParIO, fork,
        IVar, new, newFull, newFull_, get, put, put_,
        spawn, spawn_, spawnP, fixPar, FixParException (..)
      ) 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)

    #ifdef NEW_GENERIC
    import qualified       Control.Par.Class as PN
    import qualified       Control.Par.Class.Unsafe as PU
    #endif

    -- -----------------------------------------------------------------------------

    -- Not in 6.12: {- INLINABLE fork -}
    {-# INLINE fork #-}
    fork :: Par () -> Par ()
    fork :: Par () -> Par ()
    fork Par ()
    p = ((() -> Trace) -> Trace) -> Par ()
    forall a. ((a -> Trace) -> Trace) -> Par a
    Par (((() -> Trace) -> Trace) -> Par ())
    -> ((() -> Trace) -> Trace) -> Par ()
    forall a b. (a -> b) -> a -> b
    $ \() -> Trace
    c -> Trace -> Trace -> Trace
    Fork (Par () -> (() -> Trace) -> Trace
    forall a. Par a -> (a -> Trace) -> Trace
    runCont Par ()
    p (\()
    _ -> Trace
    Done)) (() -> Trace
    c ())

    -- --------------------------------------------------------------------------------
    -- -- Standard instances:

    -- <boilerplate>
    spawn :: NFData a => Par a -> Par (IVar a)
    spawn :: forall a. NFData a => Par a -> Par (IVar a)
    spawn Par a
    p  = do IVar a
    r <- Par (IVar a)
    forall a. Par (IVar a)
    new;  Par () -> Par ()
    fork (Par a
    p Par a -> (a -> Par ()) -> Par ()
    forall a b. Par a -> (a -> Par b) -> Par b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IVar a -> a -> Par ()
    forall a. NFData a => IVar a -> a -> Par ()
    put IVar a
    r);   IVar a -> Par (IVar a)
    forall a. a -> Par a
    forall (m :: * -> *) a. Monad m => a -> m a
    return IVar a
    r
    spawn_ :: Par a -> Par (IVar a)
    spawn_ :: forall a. Par a -> Par (IVar a)
    spawn_ Par a
    p = do IVar a
    r <- Par (IVar a)
    forall a. Par (IVar a)
    new;  Par () -> Par ()
    fork (Par a
    p Par a -> (a -> Par ()) -> Par ()
    forall a b. Par a -> (a -> Par b) -> Par b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IVar a -> a -> Par ()
    forall a. IVar a -> a -> Par ()
    put_ IVar a
    r);  IVar a -> Par (IVar a)
    forall a. a -> Par a
    forall (m :: * -> *) a. Monad m => a -> m a
    return IVar a
    r
    -- </boilerplate>>

    spawnP :: NFData a => a -> Par (IVar a)
    spawnP :: forall a. NFData a => a -> Par (IVar a)
    spawnP a
    a = Par a -> Par (IVar a)
    forall a. NFData a => Par a -> Par (IVar a)
    spawn (a -> Par a
    forall a. a -> Par a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a)

    instance PC.ParFuture IVar Par  where
      get :: forall a. IVar a -> Par a
    get    = IVar a -> Par a
    forall a. IVar a -> Par a
    get
      spawn :: forall a. NFData a => Par a -> Par (IVar a)
    spawn  = Par a -> Par (IVar a)
    forall a. NFData a => Par a -> Par (IVar a)
    spawn
      spawn_ :: forall a. Par a -> Par (IVar a)
    spawn_ = Par a -> Par (IVar a)
    forall a. Par a -> Par (IVar a)
    spawn_
      spawnP :: forall a. NFData a => a -> Par (IVar a)
    spawnP = a -> Par (IVar a)
    forall a. NFData a => a -> Par (IVar a)
    spawnP

    instance PC.ParIVar IVar Par  where
      fork :: Par () -> Par ()
    fork = Par () -> Par ()
    fork
      new :: forall a. Par (IVar a)
    new  = Par (IVar a)
    forall a. Par (IVar a)
    new
      put :: forall a. NFData a => IVar a -> a -> Par ()
    put  = IVar a -> a -> Par ()
    forall a. NFData a => IVar a -> a -> Par ()
    put
      put_ :: forall a. IVar a -> a -> Par ()
    put_ = IVar a -> a -> Par ()
    forall a. IVar a -> a -> Par ()
    put_
      newFull :: forall a. NFData a => a -> Par (IVar a)
    newFull  = a -> Par (IVar a)
    forall a. NFData a => a -> Par (IVar a)
    newFull
      newFull_ :: forall a. a -> Par (IVar a)
    newFull_ = a -> Par (IVar a)
    forall a. a -> Par (IVar a)
    newFull_
    --  yield = yield

    #ifdef NEW_GENERIC
    instance PU.ParMonad Par where
      fork = fork
      internalLiftIO io = Par (LiftIO io)

    instance PU.ParThreadSafe Par where
      unsafeParIO io = Par (LiftIO io)

    instance PN.ParFuture Par where
      type Future Par = IVar
      type FutContents Par a = ()
      get    = get
      spawn  = spawn
      spawn_ = spawn_
      spawnP = spawnP

    instance PN.ParIVar Par  where
      new  = new
      put_ = put_
      newFull = newFull
      newFull_ = newFull_
    #endif