[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