Repository : http://darcs.haskell.org/ghc.git/
On branch : ghc-lwc2 https://github.com/ghc/ghc/commit/cf532354713f8ff6313ab58fb0122cc2944616e0 >--------------------------------------------------------------- commit cf532354713f8ff6313ab58fb0122cc2944616e0 Author: KC Sivaramakrishnan <chand...@cs.purdue.edu> Date: Wed Apr 24 22:12:16 2013 -0400 Simplifying MVar implementaiton for chameneos >--------------------------------------------------------------- tests/Benchmarks/ChameneosRedux/MVarList.hs | 40 ++++++++++++++++------ .../ChameneosRedux/chameneos-redux-lwc.hs | 7 ++-- 2 files changed, 32 insertions(+), 15 deletions(-) diff --git a/tests/Benchmarks/ChameneosRedux/MVarList.hs b/tests/Benchmarks/ChameneosRedux/MVarList.hs index 76f398a..e738bf5 100644 --- a/tests/Benchmarks/ChameneosRedux/MVarList.hs +++ b/tests/Benchmarks/ChameneosRedux/MVarList.hs @@ -39,24 +39,42 @@ import GHC.IORef #include "profile.h" -data Queue a = Queue ![a] ![a] +-- data Queue a = Queue ![a] ![a] +-- +-- _INL_(emptyQueue) +-- emptyQueue :: Queue a +-- emptyQueue = Queue [] [] +-- +-- _INL_(enque) +-- enque :: Queue a -> a -> Queue a +-- enque (Queue front back) e = Queue front $ e:back +-- +-- _INL_(deque) +-- deque :: Queue a -> (Queue a, Maybe a) +-- deque (Queue !front !back) = +-- case front of +-- [] -> (case reverse back of +-- [] -> (emptyQueue, Nothing) +-- x:tl -> (Queue tl [], Just x)) +-- x:tl -> (Queue tl back, Just x) + +-- NOTE KC: Even a list seems to work just as well as a queue. +newtype Queue a = Queue [a] _INL_(emptyQueue) emptyQueue :: Queue a -emptyQueue = Queue [] [] +emptyQueue = Queue [] _INL_(enque) enque :: Queue a -> a -> Queue a -enque (Queue front back) e = Queue front $ e:back +enque (Queue q) e = Queue $! e:q _INL_(deque) deque :: Queue a -> (Queue a, Maybe a) -deque (Queue !front !back) = - case front of - [] -> (case reverse back of - [] -> (emptyQueue, Nothing) - x:tl -> (Queue tl [], Just x)) - x:tl -> (Queue tl back, Just x) +deque (Queue q) = + case q of + [] -> (emptyQueue, Nothing) + x:tl -> (Queue tl, Just x) newtype MVar a = MVar (PVar (MVPState a)) deriving (Eq) data MVPState a = Full !a (Queue (a, PTM())) @@ -67,13 +85,13 @@ _INL_(newMVar) newMVar :: a -> IO (MVar a) newMVar x = do ref <- newPVarIO $! Full x emptyQueue - return $ MVar ref + return $! MVar ref _INL_(newEmptyMVar) newEmptyMVar :: IO (MVar a) newEmptyMVar = do ref <- newPVarIO $! Empty emptyQueue - return $ MVar ref + return $! MVar ref _INL_(asyncPutMVar) diff --git a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs index d49cc41..b772be5 100644 --- a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs +++ b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs @@ -49,10 +49,9 @@ arrive !mpv !finish !ch = do go !t !b = do w <- takeMVarWithHole mpv hole1 tk case w of - Nobody 0 - -> do - putMVar mpv w tk - putMVar finish (t, b) tk + Nobody 0 -> do + putMVar mpv w tk + putMVar finish (t, b) tk Nobody q -> do putMVar mpv (Somebody q ch waker) tk ch' <- takeMVarWithHole waker hole2 tk _______________________________________________ ghc-commits mailing list ghc-commits@haskell.org http://www.haskell.org/mailman/listinfo/ghc-commits
