X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=16a1628d3520864d047eb28e7f4f50ecb3c890d3;hb=f4b727487a65e6b611bbaafbd2207bd63a8df706;hp=3de52b6737860f2d0756a3bc7b35182802bf8def;hpb=46bef1c09f499c5b34a00b650614bebfa1d6ba4b;p=ghc-hetmet.git

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 3de52b6..16a1628 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -65,7 +65,7 @@ module Util (
         doesDirNameExist,
         modificationTimeIfExists,
 
-        global, consIORef,
+        global, consIORef, globalMVar, globalEmptyMVar,
 
         -- * Filenames and paths
         Suffix,
@@ -79,10 +79,10 @@ module Util (
 
 import Panic
 
-import Data.IORef       ( IORef, newIORef )
+import Data.IORef       ( IORef, newIORef, atomicModifyIORef )
 import System.IO.Unsafe ( unsafePerformIO )
-import Data.IORef       ( readIORef, writeIORef )
 import Data.List        hiding (group)
+import Control.Concurrent.MVar ( MVar, newMVar, newEmptyMVar )
 
 #ifdef DEBUG
 import qualified Data.List as List ( elem, notElem )
@@ -386,36 +386,27 @@ Debugging/specialising versions of \tr{elem} and \tr{notElem}
 isIn, isn'tIn :: Eq a => String -> a -> [a] -> Bool
 
 # ifndef DEBUG
-isIn    _msg x ys = elem__    x ys
-isn'tIn _msg x ys = notElem__ x ys
-
---these are here to be SPECIALIZEd (automagically)
-elem__ :: Eq a => a -> [a] -> Bool
-elem__ _ []     = False
-elem__ x (y:ys) = x == y || elem__ x ys
-
-notElem__ :: Eq a => a -> [a] -> Bool
-notElem__ _ []     = True
-notElem__ x (y:ys) = x /= y && notElem__ x ys
+isIn    _msg x ys = x `elem` ys
+isn'tIn _msg x ys = x `notElem` ys
 
 # else /* DEBUG */
 isIn msg x ys
-  = elem (_ILIT(0)) x ys
+  = elem100 (_ILIT(0)) x ys
   where
-    elem _ _ []        = False
-    elem i x (y:ys)
+    elem100 _ _ []        = False
+    elem100 i x (y:ys)
       | i ># _ILIT(100) = trace ("Over-long elem in " ++ msg)
-                                (x `List.elem` (y:ys))
-      | otherwise       = x == y || elem (i +# _ILIT(1)) x ys
+                                (x `elem` (y:ys))
+      | otherwise       = x == y || elem100 (i +# _ILIT(1)) x ys
 
 isn'tIn msg x ys
-  = notElem (_ILIT(0)) x ys
+  = notElem100 (_ILIT(0)) x ys
   where
-    notElem _ _ [] =  True
-    notElem i x (y:ys)
+    notElem100 _ _ [] =  True
+    notElem100 i x (y:ys)
       | i ># _ILIT(100) = trace ("Over-long notElem in " ++ msg)
-                                (x `List.notElem` (y:ys))
-      | otherwise      =  x /= y && notElem (i +# _ILIT(1)) x ys
+                                (x `notElem` (y:ys))
+      | otherwise      =  x /= y && notElem100 (i +# _ILIT(1)) x ys
 # endif /* DEBUG */
 \end{code}
 
@@ -522,7 +513,7 @@ sortWith get_key xs = sortLe le xs
   where
     x `le` y = get_key x < get_key y
 
-on :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
+on :: (a -> a -> c) -> (b -> a) -> b -> b -> c
 on cmp sel = \x y -> sel x `cmp` sel y
 
 \end{code}
@@ -695,8 +686,15 @@ global a = unsafePerformIO (newIORef a)
 \begin{code}
 consIORef :: IORef [a] -> a -> IO ()
 consIORef var x = do
-  xs <- readIORef var
-  writeIORef var (x:xs)
+  atomicModifyIORef var (\xs -> (x:xs,()))
+\end{code}
+
+\begin{code}
+globalMVar :: a -> MVar a
+globalMVar a = unsafePerformIO (newMVar a)
+
+globalEmptyMVar :: MVar a
+globalEmptyMVar = unsafePerformIO newEmptyMVar
 \end{code}
 
 Module names: