[commit: ghc] ghc-lwc2: Simplifying MVar implementaiton for chameneos (cf53235)

[Sivaramakrishnan Krishnamoorthy Chandrasekaran]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : ghc-lwc2

https://github.com/ghc/ghc/commit/cf532354713f8ff6313ab58fb0122cc2944616e0

>---------------------------------------------------------------

commit cf532354713f8ff6313ab58fb0122cc2944616e0
Author: KC Sivaramakrishnan <chandras at 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