Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

reshuffled module hierarchy

  • Loading branch information...
commit a0196b232a0b86dda97c625c0cdd016ee2d84605 1 parent 711e744
Edward Kmett authored January 19, 2011
53  Control/Concurrent/Speculation.hs → Data/Speculation.hs
... ...
@@ -1,5 +1,5 @@
1 1
 {-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, MagicHash #-}
2  
-module Control.Concurrent.Speculation
  2
+module Data.Speculation
3 3
     (
4 4
     -- * Speculative application
5 5
       spec
@@ -18,15 +18,15 @@ module Control.Concurrent.Speculation
18 18
     ) where
19 19
 
20 20
 import Control.Concurrent.STM
21  
-import Control.Concurrent.Speculation.Internal (returning)
  21
+import Data.Speculation.Internal (returning)
22 22
 import Data.TagBits (unsafeIsEvaluated)
23  
-import Control.Parallel (par)
24 23
 import Control.Monad (liftM2, unless)
25 24
 import Data.Function (on)
  25
+import GHC.Conc
26 26
 
27 27
 -- * Basic speculation
28 28
 
29  
--- | @'spec' g f a@ evaluates @f g@ while forcing @a@, if @g == a@ then @f g@ is returned, otherwise @f a@ is evaluated and returned. Furthermore, if the argument has already been evaluated, we skip the @f g@ computation entirely. If a good guess at the value of @a@ is available, this is one way to induce parallelism in an otherwise sequential task. However, if the guess isn\'t available more cheaply than the actual answer, then this saves no work and if the guess is wrong, you risk evaluating the function twice. Under high load, since 'f g' is computed via the spark queue, the speculation will be skipped and you will obtain the same answer as 'f $! a'.
  29
+-- | @'spec' g f a@ evaluates @f g@ while forcing @a@, if @g == a@ then @f g@ is returned, otherwise @f a@ is evaluated and returned. Furthermore, if the argument has already been evaluated or are not running on the threaded runtime, we skip the @f g@ computation entirely. If a good guess at the value of @a@ is available, this is one way to induce parallelism in an otherwise sequential task. However, if the guess isn\'t available more cheaply than the actual answer, then this saves no work and if the guess is wrong, you risk evaluating the function twice. Under high load or in a runtime with access to a single capability, since 'f g' is computed via the spark queue, the speculation will be skipped and you will obtain the same answer as 'f $! a'.
30 30
 --
31 31
 --The best-case timeline looks like:
32 32
 --
@@ -84,13 +84,13 @@ specBy cmp guess f a
84 84
 
85 85
 -- | 'spec'' with a user defined comparison function
86 86
 specBy' :: (a -> a -> Bool) -> a -> (a -> b) -> a -> b
87  
-specBy' cmp guess f a =
88  
-    speculation `par`
89  
-        if cmp guess a
90  
-        then speculation
91  
-        else f a
92  
-    where
93  
-        speculation = f guess
  87
+specBy' cmp guess f a
  88
+  | numCapabilities == 1 = f $! a
  89
+  | otherwise = speculation `par` 
  90
+    if cmp guess a
  91
+    then speculation
  92
+    else f a
  93
+  where speculation = f guess
94 94
 {-# INLINE specBy' #-}
95 95
 
96 96
 -- | 'spec' comparing by projection onto another type
@@ -105,9 +105,9 @@ specOn' = specBy' . on (==)
105 105
 
106 106
 -- * STM-based speculation
107 107
 
108  
--- | @'specSTM' g f a@ evaluates @fg = do g' <- g; f g'@, while forcing @a@, then if @g' == a@ then @fg@ is returned. Otherwise the side-effects of @fg@ are rolled back and @f a@ is evaluated. @g@ is allowed to be a monadic action, so that we can kickstart the computation of @a@ earlier.
  108
+-- | @'specSTM' g f a@ evaluates @fg = do g' <- g; f g'@, while forcing @a@, then if @g' == a@ then @fg@ is returned. Otherwise the side-effects of @fg@ are rolled back and @f a@ is evaluated. @g@ is allowed to be a monadic action, so that we can kickstart the computation of @a@ earlier. Under high load, or when we are not using the parallel runtime, the speculation is avoided, to enable this to more closely approximate the runtime profile of spec.
109 109
 --
110  
--- If the argument @a@ is already evaluated, we don\'t bother to perform @fg@ at all.
  110
+-- If the argument @a@ is already evaluated, we don\'t bother to perform @f g@ at all.
111 111
 --
112 112
 -- If a good guess at the value of @a@ is available, this is one way to induce parallelism in an otherwise sequential task.
113 113
 --
@@ -162,17 +162,26 @@ specBySTM cmp guess f a
162 162
     | otherwise   = specBySTM' cmp guess f a
163 163
 {-# INLINE specBySTM #-}
164 164
 
  165
+#ifndef HAS_NUM_SPARKS
  166
+numSparks :: IO Int
  167
+numSparks = return 0
  168
+#endif
  169
+
165 170
 -- | 'specSTM'' using a user defined comparison function
166 171
 specBySTM' :: (a -> a -> STM Bool) -> STM a -> (a -> STM b) -> a -> STM b
167  
-specBySTM' cmp mguess f a = a `par` do
168  
-    guess <- mguess
169  
-    result <- f guess
170  
-    -- rendezvous with a
171  
-    matching <- cmp guess a
172  
-    unless matching retry
173  
-    return result
174  
-  `orElse`
175  
-    f a
  172
+specBySTM' cmp mguess f a = do
  173
+  sparks <- unsafeIOToSTM numSparks
  174
+  if sparks < numCapabilities 
  175
+    then a `par` do
  176
+      guess <- mguess
  177
+      result <- f guess
  178
+      -- rendezvous with a
  179
+      matching <- cmp guess a
  180
+      unless matching retry
  181
+      return result
  182
+     `orElse`
  183
+      f a
  184
+    else f $! a 
176 185
 {-# INLINE specBySTM' #-}
177 186
 
178 187
 -- | @'specBySTM' . 'on' (==)@
70  Data/Speculation/Cont.hs
... ...
@@ -0,0 +1,70 @@
  1
+-----------------------------------------------------------------------------
  2
+-- |
  3
+-- Module      :  Data.Speculation.Cont
  4
+-- Copyright   :  (C) 2011 Edward Kmett, Jake McArthur
  5
+-- License     :  BSD-style (see the file LICENSE)
  6
+--
  7
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
  8
+-- Stability   :  provisional
  9
+-- Portability :  portable
  10
+--
  11
+-- Versions of the combinators from the 'speculation' package
  12
+-- with the signature rearranged to enable them to be used
  13
+-- directly as actions in the 'Cont' and 'ContT' monads.
  14
+----------------------------------------------------------------------------
  15
+module Data.Speculation.Cont where
  16
+
  17
+import Control.Monad.Trans.Cont
  18
+import qualified Data.Speculation as Prim
  19
+import Control.Concurrent.STM
  20
+
  21
+-- * Basic speculation
  22
+
  23
+-- | When a is unevaluated, @'spec' g a@ evaluates the current continuation 
  24
+-- with @g@ while testing if @g@ '==' @a@, if they differ, it re-evalutes the
  25
+-- continuation with @a@. If @a@ was already evaluated, the continuation is
  26
+-- just directly applied to @a@ instead.
  27
+spec :: Eq a => a -> a -> ContT r m a
  28
+spec g a = ContT $ \k -> Prim.spec g k a 
  29
+
  30
+-- | As per 'spec', without the check for whether or not the second argument
  31
+-- is already evaluated.
  32
+spec' :: Eq a => a -> a -> ContT r m a
  33
+spec' g a = ContT $ \k -> Prim.spec' g k a
  34
+
  35
+-- | @spec@ with a user supplied comparison function
  36
+specBy :: (a -> a -> Bool) -> a -> a -> ContT r m a
  37
+specBy f g a = ContT $ \k -> Prim.specBy f g k a
  38
+
  39
+-- | @spec'@ with a user supplied comparison function
  40
+specBy' :: (a -> a -> Bool) -> a -> a -> ContT r m a
  41
+specBy' f g a = ContT $ \k -> Prim.specBy' f g k a
  42
+
  43
+-- | @spec'@ with a user supplied comparison function
  44
+specOn :: Eq c => (a -> c) -> a -> a -> ContT r m a
  45
+specOn f g a = ContT $ \k -> Prim.specOn f g k a
  46
+
  47
+-- | @spec'@ with a user supplied comparison function
  48
+specOn' :: Eq c => (a -> c) -> a -> a -> ContT r m a
  49
+specOn' f g a = ContT $ \k -> Prim.specOn' f g k a
  50
+
  51
+-- * STM-based speculation
  52
+
  53
+specSTM :: Eq a => STM a -> a -> ContT r STM a
  54
+specSTM g a = ContT $ \k -> Prim.specSTM g k a 
  55
+
  56
+specSTM' :: Eq a => STM a -> a -> ContT r STM a
  57
+specSTM' g a = ContT $ \k -> Prim.specSTM' g k a 
  58
+
  59
+specOnSTM :: Eq c => (a -> STM c) -> STM a -> a -> ContT r STM a
  60
+specOnSTM f g a = ContT $ \k -> Prim.specOnSTM f g k a 
  61
+
  62
+specOnSTM' :: Eq c => (a -> STM c) -> STM a -> a -> ContT r STM a
  63
+specOnSTM' f g a = ContT $ \k -> Prim.specOnSTM' f g k a 
  64
+
  65
+specBySTM :: (a -> a -> STM Bool) -> STM a -> a -> ContT r STM a
  66
+specBySTM f g a = ContT $ \k -> Prim.specBySTM f g k a 
  67
+
  68
+specBySTM' :: (a -> a -> STM Bool) -> STM a -> a -> ContT r STM a
  69
+specBySTM' f g a = ContT $ \k -> Prim.specBySTM' f g k a 
  70
+
6  Data/Foldable/Speculation.hs → Data/Speculation/Foldable.hs
... ...
@@ -1,5 +1,5 @@
1 1
 {-# LANGUAGE BangPatterns #-}
2  
-module Data.Foldable.Speculation
  2
+module Data.Speculation.Foldable
3 3
     ( 
4 4
     -- * Speculative folds
5 5
       fold, foldBy
@@ -55,8 +55,8 @@ import Data.Function (on)
55 55
 import Data.Foldable (Foldable)
56 56
 import qualified Data.Foldable as Foldable
57 57
 import Control.Concurrent.STM
58  
-import Control.Concurrent.Speculation
59  
-import Control.Concurrent.Speculation.Internal
  58
+import Data.Speculation
  59
+import Data.Speculation.Internal
60 60
 import Control.Applicative
61 61
 import Control.Monad hiding (mapM_, msum, forM_, sequence_)
62 62
 
2  Control/Concurrent/Speculation/Internal.hs → Data/Speculation/Internal.hs
... ...
@@ -1,4 +1,4 @@
1  
-module Control.Concurrent.Speculation.Internal 
  1
+module Data.Speculation.Internal 
2 2
     ( Acc(..)
3 3
     , extractAcc
4 4
     , MaybeAcc(..)
6  Data/List/Speculation.hs → Data/Speculation/List.hs
... ...
@@ -1,5 +1,5 @@
1 1
 {-# LANGUAGE BangPatterns #-}
2  
-module Data.List.Speculation 
  2
+module Data.Speculation.List
3 3
     ( 
4 4
     -- * Speculative scans
5 5
       scan, scanBy
@@ -29,8 +29,8 @@ import Prelude hiding
29 29
 
30 30
 import Data.Monoid
31 31
 import qualified Data.List as List
32  
-import Control.Concurrent.Speculation
33  
-import Control.Concurrent.Speculation.Internal
  32
+import Data.Speculation
  33
+import Data.Speculation.Internal
34 34
 
35 35
 -- | Given a valid estimator @g@, @'scan' g xs@ converts @xs@ into a list of the prefix sums.
36 36
 -- 
4  Control/Morphism/Speculation.hs → Data/Speculation/Morphism.hs
... ...
@@ -1,12 +1,12 @@
1 1
 {-# LANGUAGE BangPatterns, MagicHash #-}
2  
-module Control.Morphism.Speculation
  2
+module Data.Speculation.Morphism
3 3
     ( hylo
4 4
     ) where
5 5
 
6 6
 import GHC.Prim
7 7
 import GHC.Types
8 8
 
9  
-import Control.Concurrent.Speculation
  9
+import Data.Speculation
10 10
 
11 11
 {-
12 12
 newtype Mu f = In { out :: f (Mu f) } 
6  Data/Traversable/Speculation.hs → Data/Speculation/Traversable.hs
... ...
@@ -1,5 +1,5 @@
1 1
 {-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples, BangPatterns #-}
2  
-module Data.Traversable.Speculation
  2
+module Data.Speculation.Traversable
3 3
     (
4 4
     -- * Traversable
5 5
     -- ** Applicative Traversals
@@ -26,8 +26,8 @@ import Data.Traversable (Traversable)
26 26
 import qualified Data.Traversable as Traversable
27 27
 import Control.Applicative
28 28
 import Control.Concurrent.STM
29  
-import Control.Concurrent.Speculation
30  
-import Control.Concurrent.Speculation.Internal
  29
+import Data.Speculation
  30
+import Data.Speculation.Internal
31 31
 
32 32
 mapAccumL :: (Traversable t, Eq a) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)
33 33
 mapAccumL = mapAccumLBy (==)
2  Test.hs
@@ -8,7 +8,7 @@ import Test.Framework.Providers.HUnit
8 8
 import Test.Framework.Providers.QuickCheck (testProperty)
9 9
 import Test.QuickCheck hiding ((==>))
10 10
 -- import Test.HUnit hiding (Test)
11  
-import Control.Concurrent.Speculation
  11
+import Data.Speculation
12 12
 
13 13
 main :: IO () 
14 14
 main = defaultMain tests
95  speculation.cabal
... ...
@@ -1,5 +1,5 @@
1 1
 name:           speculation
2  
-version:        1.0.0.0
  2
+version:        1.2.0.0
3 3
 license:        BSD3
4 4
 license-file:   LICENSE
5 5
 author:         Edward A. Kmett
@@ -62,7 +62,7 @@ description:
62 62
  > foreground:               [---- f a ----]
63 63
  > orverall:   [---------- f $! a ---------]
64 64
  .
65  
- 'specSTM' provides a similar time table for STM actions, but also rolls back side-effects. The one unfortunate operational distinction is that it is forced to compute 'a' in the background thread and therefore degrades slightly less gracefully under load.
  65
+ 'specSTM' provides a similar time table for STM actions, but also rolls back side-effects. The one unfortunate operational distinction is that it is forced to compute 'a' in the background thread and therefore degrades slightly less gracefully under load, although we mitigate this effect by only enqueuing if the number of sparks for the current capability is lower than the total number of capabilities, to try to avoid wasting time when all computational resources are in use.
66 66
 
67 67
 extra-source-files: 
68 68
     README.markdown
@@ -74,10 +74,10 @@ source-repository head
74 74
   location: http://github.com/ekmett/speculation.git
75 75
   branch:   master
76 76
 
77  
-flag lib
78  
-  description: Build the library. Useful for speeding up the modify-build-test cycle.
79  
-  default:     True
80  
-  manual:      True
  77
+flag HasNumSparks
  78
+  description: RTS provides GHC.Conc.numSparks
  79
+  default: True
  80
+  manual: False
81 81
 
82 82
 flag tests
83 83
   description: Build the tests
@@ -96,28 +96,31 @@ flag hpc
96 96
   default:     True
97 97
 
98 98
 library
99  
-  if !flag(lib)
100  
-    buildable: False
101  
-  else 
102  
-    ghc-options: -Wall
103  
-    if flag(optimize)
104  
-      ghc-options: -funbox-strict-fields -O2 -fspec-constr -fdicts-cheap
  99
+  ghc-options: -Wall
  100
+  if flag(optimize)
  101
+    ghc-options: -funbox-strict-fields -O2 -fspec-constr -fdicts-cheap
  102
+  if flag(HasNumSparks)
  103
+    cpp-options: -DHAS_NUM_SPARKS
  104
+    build-depends: base >= 4.3 && < 6
  105
+  else
  106
+    build-depends: base >= 4 && < 4.3
105 107
 
106  
-    build-depends:
107  
-      base >= 4 && < 6,
108  
-      ghc-prim >= 0.2 && < 0.3,
109  
-      tag-bits >= 0.1 && < 0.2,
110  
-      parallel >= 2.2 && < 2.3,
111  
-      stm >= 2.1 && < 2.2
  108
+  build-depends:
  109
+    ghc-prim >= 0.2 && < 0.3,
  110
+    tag-bits >= 0.1 && < 0.2,
  111
+    parallel >= 2.2 && < 2.3,
  112
+    transformers >= 0.2.2.0 && < 0.3,
  113
+    stm >= 2.1 && < 2.2
112 114
 
113  
-    exposed-modules:
114  
-      Control.Concurrent.Speculation
115  
-      Control.Morphism.Speculation
116  
-      Data.Foldable.Speculation
117  
-      Data.Traversable.Speculation
118  
-      Data.List.Speculation
119  
-    other-modules:
120  
-      Control.Concurrent.Speculation.Internal
  115
+  exposed-modules:
  116
+    Data.Speculation
  117
+    Data.Speculation.Cont
  118
+    Data.Speculation.Morphism
  119
+    Data.Speculation.Foldable
  120
+    Data.Speculation.Traversable
  121
+    Data.Speculation.List
  122
+  other-modules:
  123
+    Data.Speculation.Internal
121 124
 
122 125
 executable test-speculation
123 126
   main-is: Test.hs
@@ -128,12 +131,17 @@ executable test-speculation
128 131
       ghc-options: -fhpc
129 132
       x-hpc: true
130 133
     ghc-options: -Wall
  134
+    if flag(HasNumSparks)
  135
+      cpp-options: -DHAS_NUM_SPARKS
  136
+      build-depends: base >= 4.3 && < 6
  137
+    else
  138
+      build-depends: base >= 4 && < 4.3
131 139
     build-depends:
132  
-      base >= 4 && < 6, 
133 140
       ghc-prim >= 0.2 && < 0.3,
134 141
       tag-bits >= 0.1 && < 0.2,
135 142
       parallel >= 2.2 && < 2.3,
136 143
       stm >= 2.1 && < 2.2,
  144
+      transformers >= 0.2.2.0 && < 0.3,
137 145
       containers >= 0.3.0 && < 0.4,
138 146
       test-framework >= 0.2.4 && < 0.3,
139 147
       test-framework-quickcheck >= 0.2.4 && < 0.3,
@@ -141,12 +149,13 @@ executable test-speculation
141 149
       QuickCheck >= 1.2.0.0 && < 1.3,
142 150
       HUnit >= 1.2.2.1 && < 1.3
143 151
     other-modules:
144  
-      Control.Concurrent.Speculation.Internal
145  
-      Control.Concurrent.Speculation
146  
-      Control.Morphism.Speculation
147  
-      Data.Foldable.Speculation
148  
-      Data.Traversable.Speculation
149  
-      Data.List.Speculation
  152
+      Data.Speculation
  153
+      Data.Speculation.Cont
  154
+      Data.Speculation.Morphism
  155
+      Data.Speculation.Foldable
  156
+      Data.Speculation.Traversable
  157
+      Data.Speculation.List
  158
+      Data.Speculation.Internal
150 159
 
151 160
 executable benchmark-speculation
152 161
   main-is: Benchmark.hs
@@ -156,18 +165,24 @@ executable benchmark-speculation
156 165
     ghc-options: -Wall -threaded
157 166
     if flag(optimize)
158 167
       ghc-options: -O2 -fspec-constr -funbox-strict-fields -fdicts-cheap
  168
+    if flag(HasNumSparks)
  169
+      cpp-options: -DHAS_NUM_SPARKS
  170
+      build-depends: base >= 4.3 && < 6
  171
+    else
  172
+      build-depends: base >= 4 && < 4.3
159 173
     build-depends:
160  
-      base >= 4 && < 6, 
161 174
       ghc-prim >= 0.2 && < 0.3,
  175
+      transformers >= 0.2.2.0 && < 0.3,
162 176
       tag-bits >= 0.1 && < 0.2,
163 177
       parallel >= 2.2 && < 2.3,
164 178
       stm >= 2.1 && < 2.2,
165 179
       containers >= 0.3.0 && < 0.4,
166 180
       criterion >= 0.5 && < 0.6
167 181
     other-modules:
168  
-      Control.Concurrent.Speculation.Internal
169  
-      Control.Concurrent.Speculation
170  
-      Control.Morphism.Speculation
171  
-      Data.Foldable.Speculation
172  
-      Data.Traversable.Speculation
173  
-      Data.List.Speculation
  182
+      Data.Speculation
  183
+      Data.Speculation.Cont
  184
+      Data.Speculation.Morphism
  185
+      Data.Speculation.Foldable
  186
+      Data.Speculation.Traversable
  187
+      Data.Speculation.List
  188
+      Data.Speculation.Internal

0 notes on commit a0196b2

Please sign in to comment.
Something went wrong with that request. Please try again.