diff --git a/Control/Concurrent/Speculation.hs b/Control/Concurrent/Speculation.hs new file mode 100644 --- /dev/null +++ b/Control/Concurrent/Speculation.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE BangPatterns #-} +module Control.Concurrent.Speculation + ( spec + , evaluated + , specFoldr + , specFoldl +-- , specFoldl' +-- , specFoldr' + , Speculative(..) + ) where + +import Prelude hiding (foldl, foldl1, foldr, foldr1) +import Data.Array +import Data.Ix () +import Data.Foldable +import Data.IntMap (IntMap) +import Data.Map (Map) +import Data.Set (Set) +import Data.Sequence (Seq) +import Control.Parallel (par) + +import Data.Bits +import Foreign +import Unsafe.Coerce + +data Box a = Box a + +-- | Inspect the dynamic pointer tagging bits of a closure +tag :: a -> Int +tag a = unsafeCoerce (Box a) .&. (sizeOf (undefined :: Int) - 1) + +-- | Returns a guess as to whether or not a value has been evaluated. This is an impure function +-- that relies on GHC internals and will return false negatives, but (hopefully) no false positives. +evaluated :: a -> Bool +evaluated a = tag a /= 0 + +-- | Evaluate a function using a cheap guess at the argument in parallel with forcing the argument. +-- +-- This is one way to induce parallelism in an otherwise sequential task. +-- If the argument has already been evaluated, we avoid sparking the parallel computation. +spec :: Eq a => a -> (a -> b) -> a -> b +spec guess f a + | evaluated a = f a + | otherwise = + speculation `par` + if guess == a + then speculation + else f a + where + speculation = f guess + + +specFoldr :: (Speculative f, Eq b) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b +specFoldr = specFoldrN 0 + +specFoldl :: (Speculative f, Eq b) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b +specFoldl = specFoldlN 0 + +class Foldable f => Speculative f where + -- | Compute a right biased fold. the estimator function is a guess at the value of the suffix + specFoldr1 :: Eq a => (Int -> a) -> (a -> a -> a) -> f a -> a + specFoldrN :: Eq b => Int -> (Int -> b) -> (a -> b -> b) -> b -> f a -> b + + -- | Compute a left biased fold. the estimator function is a guess at the value of the prefix + specFoldl1 :: Eq a => (Int -> a) -> (a -> a -> a) -> f a -> a + specFoldlN :: Eq b => Int -> (Int -> b) -> (b -> a -> b) -> b -> f a -> b + + specFoldr1 g f = specFoldr1 g f . toList + specFoldrN n g f z = specFoldrN n g f z . toList + + specFoldl1 g f = specFoldl1 g f . toList + specFoldlN n g f z = specFoldlN n g f z . toList + +errorEmptyStructure :: String -> a +errorEmptyStructure f = error $ f ++ ": error empty structure" + +instance Speculative [] where + specFoldr1 g f = go 0 + where + go _ [] = errorEmptyStructure "specFoldr1" + go !n (x:xs) = n' `seq` spec (g n') (f x) (go n' xs) + where + n' = n + 1 + + specFoldrN _ _ _ z [] = z + specFoldrN !n g f z (x:xs) = n' `seq` spec (g n') (f x) (specFoldrN n' g f z xs) + where + n' = n + 1 + + specFoldl1 _ _ [] = errorEmptyStructure "specFoldl1" + specFoldl1 g f (x:xs) = specFoldlN 1 g f x xs + specFoldlN _ _ _ z [] = z + specFoldlN !n g f z (x:xs) = n' `seq` spec (g n') (\z' -> specFoldlN n' g f z' xs) (f z x) + where + n' = n + 1 + +-- speculation never helps with at most one element +instance Speculative Maybe where + specFoldr1 _ = foldr1 + specFoldrN _ _ = foldr + specFoldl1 _ = foldl1 + specFoldlN _ _ = foldl + +instance Ix i => Speculative (Array i) +instance Speculative Set +instance Speculative (Map a) +instance Speculative IntMap +instance Speculative Seq + +-- specFoldl' :: (Speculative f, Eq a) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b +-- specFoldl' g f z0 xs = specFoldr g' f' id xs z0 where +-- f' x k z = k $! f z x +-- g' = undefined -- n z = f (g n) z + +-- specFoldr' :: (Speculative f, Eq a) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b +-- specFoldr' g f z0 xs = specFoldl g' f' id xs z0 where +-- f' x k z = k $! f x z +-- g' = undefined -- n z = f (g n) z diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2010, Edward Kmett + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Edward Kmett nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,35 @@ +speculation +=========== + +Speculative evaluation primitives for Haskell, very loosely based on the paper "Safe Programmable Speculative Parallelism" by +Prabhu, Ramalingam, and Vaswani. + +spec +---- + + spec :: Eq a => a -> (a -> b) -> a -> b + +`spec` takes three arguments: An initial guess as to what the argument to the function will be when it is evaluated, a function to evaluate, and the actual argument to the function. + +Spec checks to see if its actual argument has been evaluated, if so it just applies the function to the argument. + +Otherwise, it begins evaluating the function with the guessed argument in parallel with evaluating the argument. + +If you guessed right, then the result of applying the function to your guess is returned. + +Otherwise, it then evaluates the function with the correct argument. + +If a good guess is available, this permits us to increase parallelism in the resulting program. + +It is subject to the following identity: + + spec a f a = a `seq` f a + +speculative folds +----------------- + +A number of speculative folds are also provided via the Speculative class. + +These take an extra argument which is a function that guesses the result of of the fold up to a given point. + +A minimal definition for Speculative can be derived automatically for any Foldable container. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/speculation.cabal b/speculation.cabal new file mode 100644 --- /dev/null +++ b/speculation.cabal @@ -0,0 +1,29 @@ +name: speculation +version: 0.0.0 +license: BSD3 +license-file: LICENSE +author: Edward A. Kmett +maintainer: Edward A. Kmett +stability: experimental +homepage: http://comonad.com/reader +category: Concurrency +synopsis: A framework for safe, programmable, speculative parallelism +description: A framework for safe, programmable, speculative parallelism, loosely based on + +copyright: (c) 2010 Edward A. Kmett +build-type: Simple +cabal-version: >=1.2 +tested-with: GHC==6.12.1 +extra-source-files: README.markdown + +library + ghc-options: -Wall + + build-depends: + base >= 4 && < 6, + containers >= 0.2.0.1, + array >= 0.2 && < 0.4, + parallel >= 2.2 && < 2.3 + + exposed-modules: + Control.Concurrent.Speculation