{-# LANGUAGE RecursiveDo #-} {-# OPTIONS -fno-warn-orphans #-} ---------------------------------------------------------------------- -- | -- Module : Data.Future -- Copyright : (c) Conal Elliott 2007 -- License : BSD3 -- -- Maintainer : conal@conal.net -- Stability : experimental -- -- A /future value/ is a value that will become knowable only later. This -- module gives a way to manipulate them functionally. For instance, -- @a+b@ becomes knowable when the later of @a@ and @b@ becomes knowable. -- See <http://en.wikipedia.org/wiki/Futures_and_promises>. -- -- Primitive futures can be things like /the value of the next key you -- press/, or /the value of LambdaPix stock at noon next Monday/. -- -- Composition is via standard type classes: 'Functor', 'Applicative', -- 'Monad', and 'Monoid'. Some comments on the 'Future' instances of -- these classes: -- -- * Monoid: 'mempty' is a future that never becomes knowable. -- @a `mappend` b@ is whichever of @a@ and @b@ is knowable first. -- -- * 'Functor': apply a function to a future. The result is knowable when -- the given future is knowable. -- -- * 'Applicative': 'pure' gives value knowable since the beginning of -- time. '(\<*\>)' applies a future function to a future argument. -- Result available when /both/ are available, i.e., it becomes knowable -- when the later of the two futures becomes knowable. -- -- * 'Monad': 'return' is the same as 'pure' (as always). @(>>=)@ cascades -- futures. 'join' resolves a future future into a future. -- -- The current implementation is nondeterministic in 'mappend' for futures -- that become knowable at the same time or nearly the same time. I -- want to make a deterministic implementation. -- -- See "Data.SFuture" for a simple denotational semantics of futures. The -- current implementation /does not/ quite implement this target semantics -- for 'mappend' when futures are available simultaneously or nearly -- simultaneously. I'm still noodling how to implement that semantics. ---------------------------------------------------------------------- module Data.Future ( Future, force, newFuture , future , never, race, race' , runFuture ) where import Control.Concurrent import Data.Monoid (Monoid(..)) import Control.Applicative import Control.Monad (join) import System.IO.Unsafe -- import Foreign (unsafePerformIO) -- TypeCompose import Control.Instances () -- IO monoid -- About determinacy: for @f1 `mappend` f2@, we might get @f2@ instead of -- @f1@ even if they're available simultaneously. It's even possible to -- get the later of the two if they're nearly simultaneous. -- -- What will it take to get deterministic semantics for @f1 `mappend` f2@? -- Idea: make an "event occurrence" type, which is a future with a time -- and a value. (The time is useful for snapshotting continuous -- behaviors.) When one occurrence happens with a time @t@, query whether -- the other one occurs by the same time. What does it take to support -- this query operation? -- -- Another idea: speculative execution. When one event occurs, continue -- to compute consequences. If it turns out that an earlier occurrence -- arrives later, do some kind of 'retry'. -- The implementation is very like IVars. Each future contains an MVar -- reader. 'force' blocks until the MVar is written. -- | Value available in the future. newtype Future a = Future { force :: IO a -- ^ Get a future value. Blocks until the value is -- available. No side-effect. } -- | Make a 'Future' and a way to fill it. The filler should be invoked -- only once. Later fillings may block. newFuture :: IO (Future a, a -> IO ()) newFuture = do v <- newEmptyMVar return (Future (readMVar v), putMVar v) -- | Make a 'Future', given a way to compute a (lazy) value. future :: IO a -> Future a future mka = unsafePerformIO $ do (fut,snk) <- newFuture -- let snk' a = putStrLn "sink" >> snk a -- putStrLn "fork" forkIO $ mka >>= snk return fut {-# NOINLINE future #-} instance Functor Future where fmap f (Future get) = future (fmap f get) instance Applicative Future where pure a = Future (pure a) Future getf <*> Future getx = future (getf <*> getx) -- Note Applicative's pure uses 'Future' as an optimization over -- 'future'. No thread or MVar. instance Monad Future where return = pure Future geta >>= h = future (geta >>= force . h) instance Monoid (Future a) where mempty = never mappend = race' -- | A future that will never happen never :: Future a never = fst (unsafePerformIO newFuture) {-# NOINLINE never #-} -- | A future equal to the earlier available of two given futures. See also 'race\''. race :: Future a -> Future a -> Future a Future geta `race` Future getb = unsafePerformIO $ do (w,snk) <- newFuture let run get = forkIO $ get >>= snk run geta run getb return w {-# NOINLINE race #-} -- | Like 'race', but the winner kills the loser's thread. race' :: Future a -> Future a -> Future a Future geta `race'` Future getb = unsafePerformIO $ do (w,snk) <- newFuture let run get tid = forkIO $ do a <- get killThread tid snk a mdo ta <- run geta tb tb <- run getb ta return () return w {-# NOINLINE race' #-} -- TODO: make race & race' deterministic, using explicit times. Figure -- out how one thread can inquire whether the other whether it is -- available by a given time, and if so, what time. -- | Run an 'IO'-action-valued 'Future'. runFuture :: Future (IO ()) -> IO () runFuture = join . force