[commit: ghc] ghc-lwc2: Cleaning up ChameneosRedux (c8b7918)

git at git.haskell.org git at git.haskell.org
Fri Sep 27 20:13:17 CEST 2013


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-lwc2
Link       : http://ghc.haskell.org/trac/ghc/changeset/c8b7918e9c405a6f2122bf9232129272488ff843/ghc

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

commit c8b7918e9c405a6f2122bf9232129272488ff843
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date:   Mon May 13 17:32:51 2013 -0400

    Cleaning up ChameneosRedux


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

c8b7918e9c405a6f2122bf9232129272488ff843
 tests/Benchmarks/ChameneosRedux/MVarList.hs        |   59 ++++++++++++--------
 .../ChameneosRedux/chameneos-redux-lwc.hs          |   20 ++++++-
 2 files changed, 53 insertions(+), 26 deletions(-)

diff --git a/tests/Benchmarks/ChameneosRedux/MVarList.hs b/tests/Benchmarks/ChameneosRedux/MVarList.hs
index 15a2e61..1262e50 100644
--- a/tests/Benchmarks/ChameneosRedux/MVarList.hs
+++ b/tests/Benchmarks/ChameneosRedux/MVarList.hs
@@ -39,24 +39,35 @@ import GHC.IORef
 
 #include "profile.h"
 
--- 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)
+#define ONE_LIST_Q
+-- #define TWO_LIST_Q
+
+#ifdef ONE_LIST_Q
+#undef TWO_LIST_Q
+#endif
+
+#ifdef TWO_LIST_Q
+
+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)
+
+#else
 
 -- NOTE KC: Even a list seems to work just as well as a queue.
 data Queue a = Queue [a]
@@ -72,13 +83,15 @@ enque (Queue q) e = Queue $! e:q
 _INL_(deque)
 deque :: Queue a -> (Queue a, Maybe a)
 deque (Queue q) =
-  case q of
-    [] -> (emptyQueue, Nothing)
-    x:tl -> (Queue tl, Just x)
+   case q of
+     [] -> (emptyQueue, Nothing)
+     x:tl -> (Queue tl, Just x)
+
+#endif
 
 newtype MVar a = MVar (PVar (MVPState a)) deriving (Eq)
-data MVPState a = Full !a (Queue (a, PTM()))
-                | Empty (Queue (IORef a, PTM()))
+data MVPState a = Full !a {-# UNPACK #-} !(Queue (a, PTM()))
+                | Empty {-# UNPACK #-} !(Queue (IORef a, PTM()))
 
 
 _INL_(newMVar)
diff --git a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
index 7bcf25d..ffbedd6 100644
--- a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
+++ b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
@@ -15,16 +15,30 @@
    -}
 
 import LwConc.Substrate
-import FairShare
+
+-------------------------------------------------------------------------------
+-- Schedulers
+-------------------------------------------------------------------------------
+-- import FairShare
 -- import LwConc.RunQueue
--- import ConcurrentList
+import ConcurrentList
+-------------------------------------------------------------------------------
+
+
+-------------------------------------------------------------------------------
+-- MVars
+-------------------------------------------------------------------------------
 import MVarList
+-- import LwConc.MVarList
+-- import LwConc.MVar
+-------------------------------------------------------------------------------
+
+
 import Control.Monad
 import Data.Char
 import Data.IORef
 import System.Environment
 import System.IO
--- import GHC.Conc
 import Foreign hiding (complement)
 
 newtype Color = C Int deriving (Storable,Enum)




More information about the ghc-commits mailing list