AVar (empty) → 0.0.1
raw patch · 4 files changed
+214/−0 lines, 4 filesdep +basesetup-changed
Dependencies added: base
Files
- AVar.cabal +17/−0
- Data/AVar.hs +183/−0
- LICENSE.txt +10/−0
- Setup.lhs +4/−0
+ AVar.cabal view
@@ -0,0 +1,17 @@+Name: AVar+Version: 0.0.1+Category: Concurrency+Synopsis: Mutable variables with Exception handling and concurrency support.+Description: AVars emulate mutable variables, by providing a queue based interface to interacting with the variable. Each variable runs a 'handler' function, which reads requests from a queue and processes them one by one. They can be used in concurrent systems safely, and should handle exceptions thrown by modifying functions gracefully.+License: BSD3+License-file: LICENSE.txt+Author: Alex Mason+Maintainer: Alex Mason <axman6@gmail.com>+build-type: Simple+Cabal-Version: >= 1.2++Library+ Build-Depends:+ base >= 4.0.0.0+ Exposed-modules:+ Data.AVar
+ Data/AVar.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables, GADTs #-}+--+-- Copyright (c) 2009 Alex Mason - http://axman6.homeip.net/blog/+-- BSD licence - http://www.opensource.org/licenses/bsd-license.php+--++-- |AVars are a form of transactional variables. They internally use a tail+-- recursive function to carry the 'state' of the variable, and allow for+-- use in concurrent systems, where actions are quaranteed to happen. They+-- are designed to cope with exceptions thrown by any modifying functions.+module Data.AVar (+ -- * Types+ AVar,+ Transaction(..),+ -- * functions on AVars+ newAVar,+ putMVar,+ modAVar,+ modAVar',+ getAVar,+ condModAVar,+ swapAVar) where+import Control.Concurrent+import Control.Concurrent.MVar+import Control.Concurrent.Chan+import qualified Control.Exception as E+import System++-- * Types++-- |A 'Transaction' describes what should happen to a variable.+-- They are only used internally, and are here just for reference.+data Transaction a =+ Put a+ -- ^puts the a into the variable+ | Get (MVar a)+ -- ^reads the variable+ | Mod (a -> a) (MVar (Maybe E.SomeException))+ -- ^modifies the variable+ | forall b. Mod' (a -> (a,b)) (MVar (Either E.SomeException b))+ -- ^ modifies the variable, returning the b result to the caller+ | Atom (a -> Bool) (a -> a) (a -> a) (MVar (Either E.SomeException Bool))+ -- ^conditionally modifies a variable++ --Swap a (MVar a)++-- |'AVar's are the means through communication with the variable are conducted.+-- They contain a Chan that is 'connected' to the variable, and is read by the+-- variable's 'handler' function.+data AVar a = AVar (Chan (Transaction a)) ++-- * Functions on AVars++-- |'newAVar' creates a new variable. It forks off the 'handler' that does the+-- work for the variable itself and creates a new AVar.+newAVar :: a -> IO (AVar a)+newAVar x = do+ E.evaluate x+ chan <- newChan :: IO (Chan (Transaction a))+ forkIO (handler chan x)+ return (AVar chan)++-- |'handler' stores the state of the variable in an accumulatin parameter.+-- It reads the chan it was forked with, and takes action depending on the+-- Transaction is recieves. Handler is not something to be used outside of+-- an AVar, and is not exported.+handler :: Chan (Transaction a) -> a -> IO b +handler chan !x = do+ req <- readChan chan+ case req of+ Put a -> handler chan a+ Get mvar -> do+ putMVar mvar x+ handler chan x+ + Mod f mvar -> do+ let x' = f x+ p <- E.catch (E.evaluate x' >> return Nothing)+ (\e -> return (Just e))+ putMVar mvar p+ case p of+ Nothing -> handler chan x'+ _ -> handler chan x+ + Mod' f mvar -> do+ let y@(a,b) = f x+ p <- E.try (E.evaluate a >> E.evaluate b)+ case p of+ Right _ -> do+ putMVar mvar (Right b)+ handler chan a+ (Left e) -> do+ putMVar mvar (Left e)+ handler chan x+ + Atom test y n res -> do+ let t' = test x+ y' = y x+ n' = n x+ tres <- E.try (E.evaluate t')+ case tres of+ rT@(Right True) -> do+ run <- E.try (E.evaluate y')+ case run of+ Right x' -> putMVar res rT >> handler chan x'+ Left e -> putMVar res (Left e) >> handler chan x+ rF@(Right False) -> do+ run <- E.try (E.evaluate n')+ case run of + Right x' -> putMVar res rF >> handler chan x'+ Left e -> putMVar res (Left e) >> handler chan x+ Left e -> putMVar res (Left e) >> handler chan x+ -- if test x+ -- then do+ -- putMVar res True+ -- handler chan (y x)+ -- else do+ -- putMVar res False+ -- handler chan (n x)++-- |'putAVar' replaces the currect value in the variable with the given x+putAVar :: AVar a -> a -> IO ()+putAVar (AVar chan) x = writeChan chan (Put x)++-- |'modAVar' takes a function from a to a, and returns Nothing if nothing went+-- wrong, or Just e, where e is an exception thrown by the function.+modAVar :: AVar a -> (a -> a) -> IO (Maybe E.SomeException)+modAVar (AVar chan) f = do+ res <- newEmptyMVar+ writeChan chan (Mod f res)+ takeMVar res++-- |'modAVar'' is like modAVar, but it modifies the variable, along with+-- returning a result of type b, within an Either e b.+modAVar' :: AVar a -> (a -> (a,b)) -> IO (Either E.SomeException b)+modAVar' (AVar chan) f = do+ res <- newEmptyMVar+ writeChan chan (Mod' f res)+ takeMVar res++-- |'getAVar' reads the current value inside the AVar.+getAVar :: AVar a -> IO a+getAVar (AVar chan) = do+ res <- newEmptyMVar+ writeChan chan (Get res)+ takeMVar res++-- |'condModAVar' applies the first finction to the current value in the+-- AVar, and if true will modify the value using the second function if+-- it results in True, or the third function if it results in Fasle.+condModAVar :: AVar a+ -> (a -> Bool)+ -> (a -> a)+ -> (a -> a)+ -> IO (Either E.SomeException Bool)+condModAVar (AVar chan) p t f = do+ res <- newEmptyMVar+ writeChan chan (Atom p t f res)+ takeMVar res++-- |'swapAVar' takes a new value, puts it into the AVar, and returns the old value.+swapAVar :: (AVar a) -> a -> IO (Either E.SomeException a)+swapAVar (AVar chan) new = do+ res <- newEmptyMVar+ writeChan chan (Mod' (\old -> (new, old)) res)+ takeMVar res++main = do+ n <- getArgs >>= \xs -> if null xs then return 1000000 else (readIO.head) xs+ var <- newAVar (0 :: Int)+ m <- newEmptyMVar+ forkIO $ test n var m+ takeMVar m+ where test 0 _ m = putMVar m ()+ test n var m = do+ res <- getAVar var+ putAVar var (res + 1)+ test (n-1) var m +++++
+ LICENSE.txt view
@@ -0,0 +1,10 @@+Copyright (c) 2009, Alex Mason+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 the Alex Mason nor the names of its 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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain