Control/Parallel/Strategies.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Parallel.Strategies
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- Parallel strategy combinators
  12 --
  13 -----------------------------------------------------------------------------
  14 module Control.Parallel.Strategies where
  15
  16 -- based on hslibs/concurrent/Strategies.lhs; see it for more detailed
  17 -- code comments. Original authors:
  18 --
  19 --      Phil Trinder, Hans-Wolfgang Loidl, Kevin Hammond et al.
  20 --
  21
  22 #ifdef __HADDOCK__
  23 import Prelude
  24 #endif
  25
  26 import Control.Parallel as Parallel
  27 import Data.Ix
  28 import Data.Array
  29 import Data.Complex
  30 import Data.Ratio
  31
  32 -- not a terribly portable way of getting at Ratio rep.
  33 #ifdef __GLASGOW_HASKELL__
  34 import GHC.Real (Ratio(..))     -- The basic defns for Ratio
  35 #endif
  36
  37 #ifdef __HUGS__
  38 import Hugs.Prelude(Ratio(..) )
  39 #endif
  40
  41 #ifdef __NHC__
  42 import Ratio (Ratio(..) )
  43 #endif
  44
  45 infixl 0 `using`,`demanding`,`sparking`              -- weakest precedence!
  46
  47 infixr 2 >||                -- another name for par
  48 infixr 3 >|                 -- another name for seq
  49 infixl 6 $||, $|            -- strategic function application (seq and par)
  50 infixl 9 .|, .||, -|, -||   -- strategic (inverse) function composition
  51
  52 ------------------------------------------------------------------------------
  53 --                      Strategy Type, Application and Semantics
  54 ------------------------------------------------------------------------------
  55 type Done = ()
  56 type Strategy a = a -> Done
  57
  58 {-
  59 A strategy takes a value and returns a dummy `done' value to indicate that
  60 the specifed evaluation has been performed.
  61
  62 The basic combinators for strategies are @par@ and @seq@ but with types that
  63 indicate that they only combine the results of a strategy application.
  64
  65 NB: This version can be used with Haskell 1.4 (GHC 2.05 and beyond), *but*
  66     you won't get strategy checking on seq (only on par)!
  67
  68 The infix fcts >| and >|| are alternative names for `seq` and `par`.
  69 With the introduction of a Prelude function `seq` separating the Prelude
  70 function from the Strategy function becomes a pain. The notation also matches
  71 the notation for strategic function application.
  72 -}
  73
  74 {-
  75 par and seq have the same types as before; >| and >|| are more specific
  76 and can only be used when composing strategies.
  77 -}
  78
  79 (>|), (>||) :: Done -> Done -> Done
  80 {-# INLINE (>|) #-}
  81 {-# INLINE (>||) #-}
  82 (>|) = Prelude.seq
  83 (>||) = Parallel.par
  84
  85 using :: a -> Strategy a -> a
  86 using x s = s x `seq` x
  87
  88 {-
  89 using takes a strategy and a value, and applies the strategy to the
  90 value before returning the value. Used to express data-oriented parallelism
  91
  92 x `using` s is a projection on x, i.e. both
  93
  94   a retraction: x `using` s [ x
  95                             -
  96   and idempotent: (x `using` s) `using` s = x `using` s
  97
  98 demanding and sparking are used to express control-oriented
  99 parallelism. Their second argument is usually a sequence of strategy
 100 applications combined `par` and `seq`. Sparking should only be used
 101 with a singleton sequence as it is not necessarily excuted
 102 -}
 103
 104 demanding, sparking :: a -> Done -> a
 105 demanding = flip Parallel.seq
 106 sparking  = flip Parallel.par
 107
 108 {-
 109 sPar and sSeq have been superceded by sparking and demanding: replace
 110   e `using` sPar x      with    e `sparking`  x
 111   e `using` sSeq x      with    e `demanding` x
 112
 113 sPar is a strategy corresponding to par. i.e. x `par` e <=> e `using` sPar x
 114 -}
 115
 116 sPar :: a -> Strategy b
 117 sPar x y = x `par` ()
 118
 119 {-
 120 sSeq is a strategy corresponding to seq. i.e. x `seq` e <=> e `using` sSeq x
 121 -}
 122 sSeq :: a -> Strategy b
 123 sSeq x y = x `seq` ()
 124
 125 -----------------------------------------------------------------------------
 126 --                      Basic Strategies
 127 -----------------------------------------------------------------------------
 128
 129 -- r0 performs *no* evaluation on its argument.
 130 r0 :: Strategy a
 131 r0 x = ()
 132
 133 --rwhnf reduces its argument to weak head normal form.
 134 rwhnf :: Strategy a
 135 rwhnf x = x `seq` ()
 136
 137 class NFData a where
 138   -- rnf reduces its argument to (head) normal form
 139   rnf :: Strategy a
 140   -- Default method. Useful for base types. A specific method is necessay for
 141   -- constructed types
 142   rnf = rwhnf
 143
 144 class (NFData a, Integral a) => NFDataIntegral a
 145 class (NFData a, Ord a) => NFDataOrd a
 146
 147 ------------------------------------------------------------------------------
 148 --                      Strategic Function Application
 149 ------------------------------------------------------------------------------
 150
 151 {-
 152 The two  infix functions @$|@   and @$||@  perform sequential and  parallel
 153 function application, respectively. They  are parameterised with a strategy
 154 that is applied to the argument of the  function application.  This is very
 155 handy when  writing  pipeline parallelism  as  a sequence of  @$@, @$|@ and
 156 @$||@'s. There is no  need of naming intermediate values  in this case. The
 157 separation  of algorithm from strategy  is  achieved by allowing strategies
 158 only as second arguments to @$|@ and @$||@.
 159 -}
 160
 161 ($|), ($||) :: (a -> b) -> Strategy a -> a -> b
 162
 163 f $| s  = \ x -> f x `demanding` s x
 164 f $|| s = \ x -> f x `sparking`  s x
 165
 166 {-
 167 The same thing for function composition (.| and .||) and inverse function
 168 composition (-| and -||) for those who read their programs from left to
 169 right.
 170 -}
 171
 172 (.|), (.||) :: (b -> c) -> Strategy b -> (a -> b) -> (a -> c)
 173 (-|), (-||) :: (a -> b) -> Strategy b -> (b -> c) -> (a -> c)
 174
 175 (.|) f s g = \ x -> let  gx = g x
 176                     in   f gx `demanding` s gx
 177 (.||) f s g = \ x -> let  gx = g x
 178                      in   f gx `sparking` s gx
 179
 180 (-|) f s g = \ x -> let  fx = f x
 181                     in   g fx `demanding` s fx
 182 (-||) f s g = \ x -> let  fx = f x
 183                      in   g fx `sparking` s fx
 184
 185 ------------------------------------------------------------------------------
 186 --                      Marking a Strategy
 187 ------------------------------------------------------------------------------
 188
 189 {-
 190 Marking a strategy.
 191
 192 Actually, @markStrat@  sticks a label @n@  into the sparkname  field of the
 193 thread executing strategy @s@. Together with a runtime-system that supports
 194 propagation of sparknames to the children this means that this strategy and
 195 all its children have  the sparkname @n@ (if the  static sparkname field in
 196 the @parGlobal@ annotation contains the value 1). Note, that the @SN@ field
 197 of starting the marked strategy itself contains the sparkname of the parent
 198 thread. The END event contains @n@ as sparkname.
 199 -}
 200
 201 #if 0
 202 markStrat :: Int -> Strategy a -> Strategy a
 203 markStrat n s x = unsafePerformPrimIO (
 204      _casm_ ``%r = set_sparkname(CurrentTSO, %0);'' n `thenPrimIO` \ z ->
 205      returnPrimIO (s x))
 206 #endif
 207
 208 -----------------------------------------------------------------------------
 209 --                      Strategy Instances and Functions
 210 -----------------------------------------------------------------------------
 211
 212 -----------------------------------------------------------------------------
 213 --                      Tuples
 214 -----------------------------------------------------------------------------
 215
 216 {-
 217 We currently support up to 9-tuples. If you need longer tuples you have to
 218 add the instance explicitly to your program.
 219 -}
 220
 221 instance (NFData a, NFData b) => NFData (a,b) where
 222   rnf (x,y) = rnf x `seq` rnf y
 223
 224 instance (NFData a, NFData b, NFData c) => NFData (a,b,c) where
 225   rnf (x,y,z) = rnf x `seq` rnf y `seq` rnf z
 226
 227 instance (NFData a, NFData b, NFData c, NFData d) => NFData (a,b,c,d) where
 228   rnf (x1,x2,x3,x4) = rnf x1 `seq`
 229                         rnf x2 `seq`
 230                         rnf x3 `seq`
 231                         rnf x4
 232
 233 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5) =>
 234          NFData (a1, a2, a3, a4, a5) where
 235   rnf (x1, x2, x3, x4, x5) =
 236                   rnf x1 `seq`
 237                   rnf x2 `seq`
 238                   rnf x3 `seq`
 239                   rnf x4 `seq`
 240                   rnf x5
 241
 242 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6) =>
 243          NFData (a1, a2, a3, a4, a5, a6) where
 244   rnf (x1, x2, x3, x4, x5, x6) =
 245                   rnf x1 `seq`
 246                   rnf x2 `seq`
 247                   rnf x3 `seq`
 248                   rnf x4 `seq`
 249                   rnf x5 `seq`
 250                   rnf x6
 251
 252 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) =>
 253          NFData (a1, a2, a3, a4, a5, a6, a7) where
 254   rnf (x1, x2, x3, x4, x5, x6, x7) =
 255                   rnf x1 `seq`
 256                   rnf x2 `seq`
 257                   rnf x3 `seq`
 258                   rnf x4 `seq`
 259                   rnf x5 `seq`
 260                   rnf x6 `seq`
 261                   rnf x7
 262
 263 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8) =>
 264          NFData (a1, a2, a3, a4, a5, a6, a7, a8) where
 265   rnf (x1, x2, x3, x4, x5, x6, x7, x8) =
 266                   rnf x1 `seq`
 267                   rnf x2 `seq`
 268                   rnf x3 `seq`
 269                   rnf x4 `seq`
 270                   rnf x5 `seq`
 271                   rnf x6 `seq`
 272                   rnf x7 `seq`
 273                   rnf x8
 274
 275 instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8, NFData a9) =>
 276          NFData (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
 277   rnf (x1, x2, x3, x4, x5, x6, x7, x8, x9) =
 278                   rnf x1 `seq`
 279                   rnf x2 `seq`
 280                   rnf x3 `seq`
 281                   rnf x4 `seq`
 282                   rnf x5 `seq`
 283                   rnf x6 `seq`
 284                   rnf x7 `seq`
 285                   rnf x8 `seq`
 286                   rnf x9
 287
 288
 289 seqPair :: Strategy a -> Strategy b -> Strategy (a,b)
 290 seqPair strata stratb (x,y) = strata x `seq` stratb y
 291
 292 parPair :: Strategy a -> Strategy b -> Strategy (a,b)
 293 parPair strata stratb (x,y) = strata x `par` stratb y `par` ()
 294
 295 {-
 296 The reason for the  second `par` is so that the strategy terminates
 297 quickly. This is important if the strategy is used as the 1st argument of a seq
 298 -}
 299
 300 seqTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
 301 seqTriple strata stratb stratc p@(x,y,z) =
 302   strata x `seq`
 303   stratb y `seq`
 304   stratc z
 305
 306 parTriple :: Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)
 307 parTriple strata stratb stratc (x,y,z) =
 308   strata x `par`
 309   stratb y `par`
 310   stratc z `par`
 311   ()
 312
 313 {-
 314 Weak head normal form and normal form are identical for integers, so the
 315 default rnf is sufficient.
 316 -}
 317 instance NFData Int
 318 instance NFData Integer
 319 instance NFData Float
 320 instance NFData Double
 321
 322 instance NFDataIntegral Int
 323 instance NFDataOrd Int
 324
 325 --Rational and complex numbers.
 326
 327 instance (Integral a, NFData a) => NFData (Ratio a) where
 328   rnf (x:%y) = rnf x `seq`
 329                rnf y `seq`
 330                ()
 331
 332 instance (RealFloat a, NFData a) => NFData (Complex a) where
 333   rnf (x:+y) = rnf x `seq`
 334                  rnf y `seq`
 335                ()
 336
 337 instance NFData Char
 338 instance NFData Bool
 339 instance NFData ()
 340
 341 -----------------------------------------------------------------------------
 342 --                      Lists
 343 ----------------------------------------------------------------------------
 344
 345 instance NFData a => NFData [a] where
 346   rnf [] = ()
 347   rnf (x:xs) = rnf x `seq` rnf xs
 348
 349 ----------------------------------------------------------------------------
 350 --                        Lists: Parallel Strategies
 351 ----------------------------------------------------------------------------
 352
 353 -- | Applies a strategy to every element of a list in parallel
 354 parList :: Strategy a -> Strategy [a]
 355 parList strat []     = ()
 356 parList strat (x:xs) = strat x `par` (parList strat xs)
 357
 358 -- | Applies a strategy to the first  n elements of a list  in parallel
 359 parListN :: (Integral b) => b -> Strategy a -> Strategy [a]
 360 parListN n strat []     = ()
 361 parListN 0 strat xs     = ()
 362 parListN n strat (x:xs) = strat x `par` (parListN (n-1) strat xs)
 363
 364 -- | Evaluates N elements of the spine of the argument list and applies
 365 -- the given strategy to the Nth element (if there is one) in parallel with
 366 -- the result. e.g. parListNth 2 [e1, e2, e3] evaluates e2
 367 parListNth :: Int -> Strategy a -> Strategy [a]
 368 parListNth n strat xs
 369   | null rest = ()
 370   | otherwise = strat (head rest) `par` ()
 371   where
 372     rest = drop n xs
 373
 374 -- | 'parListChunk' sequentially applies a strategy to chunks
 375 -- (sub-sequences) of a list in parallel. Useful to increase grain size
 376 parListChunk :: Int -> Strategy a -> Strategy [a]
 377 parListChunk n strat [] = ()
 378 parListChunk n strat xs = seqListN n strat xs `par`
 379                             parListChunk n strat (drop n xs)
 380
 381 -- | 'parMap' applies a function to each element of the argument list in
 382 -- parallel.  The result of the function is evaluated using the given
 383 -- strategy.
 384 parMap :: Strategy b -> (a -> b) -> [a] -> [b]
 385 parMap strat f xs       = map f xs `using` parList strat
 386
 387 -- | 'parFlatMap' uses 'parMap' to apply a list-valued function to each
 388 -- element of the argument list in parallel.  The result of the function
 389 -- is evaluated using the given strategy.
 390 parFlatMap :: Strategy [b] -> (a -> [b]) -> [a] -> [b]
 391 parFlatMap strat f xs = concat (parMap strat f xs)
 392
 393 -- | 'parZipWith' zips together two lists with a function z in parallel
 394 parZipWith :: Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c]
 395 parZipWith strat z as bs =
 396   zipWith z as bs `using` parList strat
 397
 398 ----------------------------------------------------------------------------
 399 --                        Lists: Sequential Strategies
 400 ----------------------------------------------------------------------------
 401
 402 -- | Sequentially applies a strategy to each element of a list
 403 seqList :: Strategy a -> Strategy [a]
 404 seqList strat []     = ()
 405 seqList strat (x:xs) = strat x `seq` (seqList strat xs)
 406
 407 -- | Sequentially applies a strategy to the first  n elements of a list
 408 seqListN :: (Integral a) => a -> Strategy b -> Strategy [b]
 409 seqListN n strat []     = ()
 410 seqListN 0 strat xs     = ()
 411 seqListN n strat (x:xs) = strat x `seq` (seqListN (n-1) strat xs)
 412
 413 -- | 'seqListNth' applies a strategy to the Nth element of it's argument
 414 -- (if there is one) before returning the result. e.g. seqListNth 2 [e1,
 415 -- e2, e3] evaluates e2
 416 seqListNth :: Int -> Strategy b -> Strategy [b]
 417 seqListNth n strat xs
 418   | null rest = ()
 419   | otherwise = strat (head rest)
 420   where
 421     rest = drop n xs
 422
 423 -- | Parallel n-buffer function added for the revised version of the strategies
 424 -- paper. 'parBuffer' supersedes the older @fringeList@. It has the same
 425 -- semantics.
 426 parBuffer :: Int -> Strategy a -> [a] -> [a]
 427 parBuffer n s xs =
 428   return xs (start n xs)
 429   where
 430     return (x:xs) (y:ys) = (x:return xs ys) `sparking` s y
 431     return xs     []     = xs
 432
 433     start n []     = []
 434     start 0 ys     = ys
 435     start n (y:ys) = start (n-1) ys `sparking` s y
 436
 437 {-
 438  'fringeList' implements a `rolling buffer' of length n, i.e.applies a
 439  strategy to the nth element of list when the head is demanded. More
 440  precisely:
 441
 442    semantics:         fringeList n s = id :: [b] -> [b]
 443    dynamic behaviour: evalutates the nth element of the list when the
 444                       head is demanded.
 445
 446  The idea is to provide a `rolling buffer' of length n.
 447 fringeList :: (Integral a) => a -> Strategy b -> [b] -> [b]
 448 fringeList n strat [] = []
 449 fringeList n strat (r:rs) =
 450   seqListNth n strat rs `par`
 451   r:fringeList n strat rs
 452 -}
 453
 454 ------------------------------------------------------------------------------
 455 --                      Arrays
 456 ------------------------------------------------------------------------------
 457 instance (Ix a, NFData a, NFData b) => NFData (Array a b) where
 458   rnf x = rnf (bounds x) `seq` seqList rnf (elems x) `seq` ()
 459
 460 -- | Apply a strategy to all elements of an array in parallel. This can be done
 461 -- either in sequentially or in parallel (same as with lists, really).
 462 seqArr :: (Ix b) => Strategy a -> Strategy (Array b a)
 463 seqArr s arr = seqList s (elems arr)
 464
 465 parArr :: (Ix b) => Strategy a -> Strategy (Array b a)
 466 parArr s arr = parList s (elems arr)
 467
 468 -- Associations maybe useful even without mentioning Arrays.
 469
 470 data  Assoc a b =  a := b  deriving ()
 471
 472 instance (NFData a, NFData b) => NFData (Assoc a b) where
 473   rnf (x := y) = rnf x `seq` rnf y `seq` ()
 474
 475 ------------------------------------------------------------------------------
 476 --                      Some strategies specific for Lolita
 477 ------------------------------------------------------------------------------
 478
 479 fstPairFstList :: (NFData a) => Strategy [(a,b)]
 480 fstPairFstList = seqListN 1 (seqPair rwhnf r0)
 481
 482 -- Some HACKs for Lolita. AFAIK force is just another name for our rnf and
 483 -- sforce is a shortcut (definition here is identical to the one in Force.lhs)
 484
 485 force :: (NFData a) => a -> a
 486 sforce :: (NFData a) => a -> b -> b
 487
 488 force = id $| rnf
 489 sforce x y = force x `seq` y