promises 0.2 → 0.3
raw patch · 4 files changed
+61/−47 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.markdown +12/−2
- README.markdown +1/−1
- promises.cabal +3/−3
- src/Data/Promise.hs +45/−41
CHANGELOG.markdown view
@@ -1,7 +1,17 @@-## 0+## 0.3 -* Repository initialized+* Support `base` 4.6 +## 0.2++* Switched from `monad-st` to `primitive`+ ## 0.1 * Added `runLazyIO` and `runLazyIO_`.+++## 0++* Repository initialized+
README.markdown view
@@ -1,7 +1,7 @@ promises ======== -[](http://travis-ci.org/ekmett/promises)+[](https://hackage.haskell.org/package/promises) [](http://travis-ci.org/ekmett/promises) Lazy demand-driven promises
promises.cabal view
@@ -1,6 +1,6 @@ name: promises category: Lazy, Concurrent-version: 0.2+version: 0.3 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -11,7 +11,7 @@ bug-reports: http://github.com/ekmett/promises/issues copyright: Copyright (C) 2015 Edward A. Kmett build-type: Simple-tested-with: GHC == 7.8.4, GHC == 7.10.1, GHC == 7.11.20150615+tested-with: GHC == 7.8.4, GHC == 7.10.1, GHC == 7.11.20150615, GHC == 8.0.1 synopsis: Lazy demand-driven promises description: Lazy demand-driven promises @@ -34,5 +34,5 @@ Data.Promise build-depends:- base >= 4.7 && < 5,+ base >= 4.6 && < 5, primitive >= 0.6 && < 1
src/Data/Promise.hs view
@@ -3,7 +3,9 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-}+#if MIN_VERSION_base(4,7,0) {-# LANGUAGE RoleAnnotations #-}+#endif {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}@@ -51,47 +53,6 @@ instance Exception BrokenPromise ----------------------------------------------------------------------------------- * Internals-----------------------------------------------------------------------------------meq :: MVar a -> MVar b -> Bool-meq a b = a == unsafeCoerce b--data K s a where- Pure :: a -> K s a- Fulfilled :: MVar x -> IO (K s a) -> K s a--instance Functor (K s) where- fmap f (Pure a) = Pure (f a)- fmap f (Fulfilled m k) = Fulfilled m (fmap (fmap f) k)--pump :: a -> IO (K s x) -> MVar a -> IO (Maybe (IO (K s x)))-pump d m v = m >>= \case- Pure _ -> return Nothing- Fulfilled u n- | meq u v -> return (Just n)- | otherwise -> pump d n v--drive :: a -> MVar (Maybe (IO (K s x))) -> MVar a -> a-drive d mv v = unsafePerformIO $ tryTakeMVar v >>= \case- Just a -> return a -- if we're satisfied give the answer- Nothing -> takeMVar mv >>= \case -- grab the lock on this computation- Nothing -> do -- it has nothing left to do, so we fail to the default answer- putMVar mv Nothing- return d- Just k -> tryTakeMVar v >>= \case -- ok, check to make sure we haven't been satisfied in the meantime- Just a -> do- putMVar mv (Just k) -- if so, restore the continuation, and return the answer- return a- Nothing -> do- mk <- pump d k v- putMVar mv mk- case mk of- Nothing -> return d- Just _ -> takeMVar v-{-# NOINLINE drive #-}---------------------------------------------------------------------------------- -- * Demand driven computations -------------------------------------------------------------------------------- @@ -99,7 +60,9 @@ newtype Lazy s a = Lazy { getLazy :: forall x. MVar (Maybe (IO (K s x))) -> IO (K s a) } deriving Typeable +#if MIN_VERSION_base(4,7,0) type role Lazy nominal representational+#endif instance Functor (Lazy s) where fmap f (Lazy m) = Lazy $ \mv -> fmap go (m mv) where@@ -206,3 +169,44 @@ -- @ runLazy_ :: (forall s. Promise s a -> Lazy s b) -> a runLazy_ k = runLazy k $ throw BrokenPromise++--------------------------------------------------------------------------------+-- * Internals+--------------------------------------------------------------------------------++meq :: MVar a -> MVar b -> Bool+meq a b = a == unsafeCoerce b++data K s a where+ Pure :: a -> K s a+ Fulfilled :: MVar x -> IO (K s a) -> K s a++instance Functor (K s) where+ fmap f (Pure a) = Pure (f a)+ fmap f (Fulfilled m k) = Fulfilled m (fmap (fmap f) k)++pump :: a -> IO (K s x) -> MVar a -> IO (Maybe (IO (K s x)))+pump d m v = m >>= \case+ Pure _ -> return Nothing+ Fulfilled u n+ | meq u v -> return (Just n)+ | otherwise -> pump d n v++drive :: a -> MVar (Maybe (IO (K s x))) -> MVar a -> a+drive d mv v = unsafePerformIO $ tryTakeMVar v >>= \case+ Just a -> return a -- if we're satisfied give the answer+ Nothing -> takeMVar mv >>= \case -- grab the lock on this computation+ Nothing -> do -- it has nothing left to do, so we fail to the default answer+ putMVar mv Nothing+ return d+ Just k -> tryTakeMVar v >>= \case -- ok, check to make sure we haven't been satisfied in the meantime+ Just a -> do+ putMVar mv (Just k) -- if so, restore the continuation, and return the answer+ return a+ Nothing -> do+ mk <- pump d k v+ putMVar mv mk+ case mk of+ Nothing -> return d+ Just _ -> takeMVar v+{-# NOINLINE drive #-}