1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
{-# 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 p = Par $ \c -> Fork (runCont p (\_ -> Done)) (c ())
-- --------------------------------------------------------------------------------
-- -- Standard instances:
-- <boilerplate>
spawn :: NFData a => Par a -> Par (IVar a)
spawn p = do r <- new; fork (p >>= put r); return r
spawn_ :: Par a -> Par (IVar a)
spawn_ p = do r <- new; fork (p >>= put_ r); return r
-- </boilerplate>>
spawnP :: NFData a => a -> Par (IVar a)
spawnP a = spawn (return a)
instance PC.ParFuture IVar Par where
get = get
spawn = spawn
spawn_ = spawn_
spawnP = spawnP
instance PC.ParIVar IVar Par where
fork = fork
new = new
put = put
put_ = put_
newFull = newFull
newFull_ = 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
|
