unamb 0.2.2 → 0.2.3
raw patch · 3 files changed
+102/−43 lines, 3 filesdep +tag-bits
Dependencies added: tag-bits
Files
- src/Data/Unamb.hs +94/−40
- unamb.cabal +4/−3
- wikipage.tw +4/−0
src/Data/Unamb.hs view
@@ -1,20 +1,20 @@-{-# LANGUAGE ScopedTypeVariables, RecursiveDo, CPP, DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables, CPP, DeriveDataTypeable #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- | -- Module : Data.Unamb -- Copyright : (c) Conal Elliott 2008 -- License : BSD3--- +-- -- Maintainer : conal@conal.net -- Stability : experimental--- +-- -- Unambiguous choice--- +-- -- For non-flat types (where values may be partially defined, rather than -- necessarily bottom or fully defined) and information merging, see the -- lub package, <http://haskell.org/haskellwiki/Lub>.--- +-- -- See unamb.cabal for the list of contributors. ---------------------------------------------------------------------- @@ -23,13 +23,14 @@ module Data.Unamb ( -- * Purely functional unambiguous choice- unamb+ unamb, unamb' -- * Some useful special applications of 'unamb' , unambs, assuming, asAgree- , parCommute, parIdentity, parAnnihilator+ , parCommute, parCommuteShortCircuit+ , parAnnihilator, parIdentity, parAnnihilatorIdentity , por, pand, pmin, pmax, pmult -- * Some related imperative tools- , amb, race+ , amb, amb', race -- * Exception thrown if neither value evaluates , BothBottom ) where@@ -40,6 +41,7 @@ import Control.Concurrent import Control.Exception import Data.Typeable+import Data.TagBits (unsafeIsEvaluated) -- import Data.IsEvaluated @@ -60,8 +62,17 @@ -- If anything kills unamb while it is evaluating (like nested unambs), it can -- be retried later but, unlike most functions, work may be lost. unamb :: a -> a -> a-unamb = (fmap.fmap) restartingUnsafePerformIO amb+unamb a b+ | unsafeIsEvaluated a = a+ | unsafeIsEvaluated b = b+ | otherwise = unamb' a b+{-# INLINE unamb #-} +-- | For use when we already know that neither argument is already evaluated+unamb' :: a -> a -> a+unamb' = (fmap.fmap) restartingUnsafePerformIO amb'+{-# INLINE unamb' #-}+ -- unamb a b = restartingUnsafePerformIO (amb a b) restartingUnsafePerformIO :: IO a -> a@@ -102,12 +113,12 @@ -- Ensuring that the code doesn't execute the retry before the exception -- is propagated, throwTo doesn't return until the exception has been -- handled.- -- + -- -- Incidentally, all exception handlers run inside an implicit block, and -- blocking operations contain an implicit unblock. This ensures that any -- further pending exceptions won't mess this scheme up, as they can't be -- delivered until after throwTo has been called.- -- + -- retry :: IO a -> IO a retry act = act `catch` \ (SomeException e) -> do@@ -118,22 +129,26 @@ -- | n-ary 'unamb' unambs :: [a] -> a unambs [] = undefined-unambs xs = foldr1 unamb xs+unambs xs = foldr1 unamb' xs `unamb'` foldr findEvaluated undefined xs+ where+ findEvaluated a b | unsafeIsEvaluated a = a+ | otherwise = b -- | Ambiguous choice operator. Yield either value. Evaluates in -- separate threads and picks whichever finishes first. See also -- 'unamb' and 'race'. amb :: a -> a -> IO a-amb a b = do - -- First, check whether one of the values already is evaluated- -- #ifdef this out for non-GHC code.- a' <- return False --isEvaluated a- b' <- return False --isEvaluated b- case (a',b') of- (True,_) -> return a- (_,True) -> return b- _ -> race (evaluate a) (evaluate b)+amb a b+ | unsafeIsEvaluated a = return a+ | unsafeIsEvaluated b = return b+ | otherwise = amb' a b+{-# INLINE amb #-} +-- | For use when we already know that neither argument is already evaluated+amb' :: a -> a -> IO a+amb' a b = race (evaluate a) (evaluate b)+{-# INLINE amb' #-}+ -- | Race two actions against each other in separate threads, and pick -- whichever finishes first. See also 'amb'. race :: IO a -> IO a -> IO a@@ -190,8 +205,8 @@ case x of Nothing -> loop (t-1) Just x' -> return x' unblock (loop (2 :: Int) `finally` cleanup)- + -- A thread can bottom-out efficiently by throwing that exception. -- Before a thread bails out for any reason, it informs race of its bailing out. @@ -217,31 +232,46 @@ assuming :: Bool -> a -> a assuming True a = a assuming False _ = undefined+{-# INLINE assuming #-} -- | The value of agreeing values (or undefined/bottom) asAgree :: Eq a => a -> a -> a a `asAgree` b = assuming (a == b) a-+{-# INLINE asAgree #-} {-------------------------------------------------------------------- Some useful special applications of 'unamb' --------------------------------------------------------------------} --- | Turn a binary commutative operation into that tries both orders in+-- | Turn a binary commutative operation into one that tries both orders in -- parallel. Useful when there are special cases that don't require -- evaluating both arguments. For non-flat types and information merging, -- see @parCommute@ in the @lub@ package. parCommute :: (a -> a -> b) -> (a -> a -> b) parCommute op x y = (x `op` y) `unamb` (y `op` x)+{-# INLINE parCommute #-} +-- | Turn a binary commutative operation into one that may try both orders.+-- unlike parCommute, if one argument is already evaluated, the function is+-- tried *only* with that as its first argument and not in both orders. When+-- in doubt, use 'parCommute'.++parCommuteShortCircuit :: (a -> a -> b) -> (a -> a -> b)+parCommuteShortCircuit op x y+ | unsafeIsEvaluated x = x `op` y+ | unsafeIsEvaluated y = y `op` x+ | otherwise = parCommute op x y+{-# INLINE parCommuteShortCircuit #-}+ -- | Parallel or por :: Bool -> Bool -> Bool-por = parCommute (||)+por = parCommuteShortCircuit (||)+{-# INLINE por #-} -- | Parallel and pand :: Bool -> Bool -> Bool-pand = parCommute (&&)-+pand = parCommuteShortCircuit (&&)+{-# INLINE pand #-} -- parAnnihilator op ann = parCommute op' -- where@@ -261,32 +291,56 @@ -- (&&) & 'False', (||) & 'True', 'min' & 'minBound', 'max' & 'maxBound'. -- Tests either argument as annihilator, in parallel. parAnnihilator :: Eq a => (a -> a -> a) -> a -> (a -> a -> a)-parAnnihilator op ann x y =- assuming (x == ann) ann `unamb`- assuming (y == ann) ann `unamb`+parAnnihilator op ann x y+ | unsafeIsEvaluated x && x == ann = ann+ | unsafeIsEvaluated y && y == ann = ann+ | otherwise =+ assuming (x == ann) ann `unamb'`+ assuming (y == ann) ann `unamb'` (x `op` y) -- | Binary operation with left & right identity element. For instance, (*) & 1, -- (&&) & 'True', (||) & 'False', 'min' & 'maxBound', 'max' & 'minBound'. -- Tests either argument as identity, in parallel. parIdentity :: (Eq a) => (a -> a -> a) -> a -> a -> a -> a-parIdentity op ident x y =- assuming (x == ident) y `unamb`- assuming (y == ident) x `unamb`+parIdentity op ident x y+ | unsafeIsEvaluated x && x == ident = y+ | unsafeIsEvaluated y && y == ident = x+ | otherwise =+ assuming (x == ident) y `unamb'`+ assuming (y == ident) x `unamb'` (x `op` y) +parAnnihilatorIdentity :: Eq a => (a -> a -> a) -> a -> a -> a -> a -> a+parAnnihilatorIdentity op ann ident x y+ | knownX && x == ann = ann+ | knownX && x == ident = y+ | knownY && y == ann = ann+ | knownY && y == ident = y+ | otherwise =+ assuming (x == ident) y `unamb'`+ assuming (x == ann) ann `unamb'`+ assuming (y == ident) x `unamb'`+ assuming (y == ann) ann `unamb'`+ (x `op` y)+ where+ knownX = unsafeIsEvaluated x+ knownY = unsafeIsEvaluated y --- | Parallel min with minBound short-circuit+-- | Parallel min with minBound short-circuit and maxBound identity pmin :: (Ord a, Bounded a) => a -> a -> a-pmin = parAnnihilator min minBound+pmin = parAnnihilatorIdentity min minBound maxBound+{-# INLINE pmin #-} --- | Parallel max with maxBound short-circuit+-- | Parallel max with maxBound short-circuit and minBound identity pmax :: (Ord a, Bounded a) => a -> a -> a-pmax = parAnnihilator max maxBound+pmax = parAnnihilatorIdentity max maxBound minBound+{-# INLINE pmax #-} --- | Parallel multiplication with 0 short-circuit+-- | Parallel multiplication with 0 short-circuit, and 1 identity pmult :: Num a => a -> a -> a-pmult = parAnnihilator (*) 0+pmult = parAnnihilatorIdentity (*) 0 1+{-# INLINE pmult #-} {- @@ -305,7 +359,7 @@ undefined `pmin` LT test :: Int -> Int-test x = f (f x) +test x = f (f x) where f v = (x `unamb` v) `seq` v main = do mapM_ (print . test) [0..]
unamb.cabal view
@@ -1,5 +1,5 @@ Name: unamb-Version: 0.2.2+Version: 0.2.3 Cabal-Version: >= 1.2 Synopsis: Unambiguous choice Category: Concurrency, Data, Other@@ -14,7 +14,7 @@ © 2008 by Conal Elliott; BSD3 license. . Contributions from: Luke Palmer, Spencer Janssen, Sterling Clover,- Bertram Felgenhauer, Peter Verswyvelen, and Svein Ove Aas.+ Bertram Felgenhauer, Peter Verswyvelen, Svein Ove Aas, and Edward Kmett. Please let me know if I've forgotten to list you. Author: Conal Elliott Maintainer: conal@conal.net@@ -32,7 +32,8 @@ Library hs-Source-Dirs: src Extensions:- Build-Depends: base >= 4 && < 5+ Build-Depends: base >= 4 && < 5,+ tag-bits >= 0.1 && < 0.2 Exposed-Modules: Data.Unamb ghc-options: -Wall
wikipage.tw view
@@ -23,6 +23,8 @@ == Issues == +Although semantically very simple, unamb has been quite tricky to implement correctly and efficiently.+ As of version 0.1.1, unamb requires ghc 6.10 or better. As of version 0.1.6, unamb correctly handles recursive termination of sub-efforts and automatic restarting, but only with the GHC RTS fixes that first appeared (stably, by my testing) in GHC HEAD version 6.11.20090115.@@ -30,3 +32,5 @@ * Email thread: ''[http://n2.nabble.com/problem-with-unamb----doesn%27t-kill-enough-threads-tt1674917.html Problem with unamb -- doesn't kill enough threads]'' * Blog post: ''[http://conal.net/blog/posts/smarter-termination-for-thread-racing/ Smarter termination for thread racing]'' * Email thread: ''[http://n2.nabble.com/Re%3A-black-hole-detection-and-concurrency-td2016290.htm Black hole detection and concurrency]''++unamb seems to be working well in version 0.2.2, under GHC 6.10.3.