{-# LANGUAGE RecursiveDo #-} -- For ghc-6.6 compatibility -- {-# OPTIONS_GHC -fglasgow-exts #-} ---------------------------------------------------------------------- -- | -- 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 , runFuture ) where import Control.Concurrent import Data.Monoid (Monoid(..)) import Control.Applicative import Control.Monad (join,forever) 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. data Future a = -- | Future that may arrive. The 'IO' blocks until available. No side-effect. Future (IO a) -- | Future that never arrives. | Never -- Why not simply use @a@ (plain-old lazy value) in place of @IO a@ in -- 'Future'? Several of the definitions below get simpler, and many -- examples work. See NewFuture.hs. But sometimes that implementation -- mysteriously crashes or just doesn't update. Odd. -- | Access a future value. Blocks until available. force :: Future a -> IO a force (Future io) = io force Never = hang -- | Block forever hang :: IO a hang = do -- putStrLn "warning: blocking forever." -- Any never-terminating computation goes here -- This one can yield an exception "thread blocked indefinitely" -- newEmptyMVar >>= takeMVar -- sjanssen suggests this alternative: forever $ threadDelay maxBound -- forever's return type is (), though it could be fully -- polymorphic. Until it's fixed, I need the following line. return undefined -- | Make a 'Future' and a way to fill it. The filler should be invoked -- only once. 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 value. future :: IO a -> Future a future mka = unsafePerformIO $ do (fut,sink) <- newFuture forkIO $ mka >>= sink return fut {-# NOINLINE future #-} instance Functor Future where fmap f (Future get) = future (fmap f get) fmap _ Never = Never instance Applicative Future where pure a = Future (pure a) Future getf <*> Future getx = future (getf <*> getx) _ <*> _ = Never -- 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) Never >>= _ = Never instance Monoid (Future a) where mempty = Never mappend = race -- | Race to extract a value. race :: Future a -> Future a -> Future a Never `race` b = b a `race` Never = a a `race` b = unsafePerformIO $ do (c,sink) <- newFuture lock <- newEmptyMVar -- to avoid double-kill let run fut tid = forkIO $ do x <- force fut putMVar lock () killThread tid sink x mdo ta <- run a tb tb <- run b ta return () return c {-# NOINLINE race #-} -- TODO: make 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