X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=c5a826a4829a9353edc423f3952ba9e0291be861;hb=e9f9ec1e57d53b9302a395ce0d02c0fa59e28341;hp=db6f96a206d92315186ca3f777268bcf5edb83fe;hpb=af37b3001b086f39cbf1fe3ea2aa5c37f4f9a34f;p=ghc-hetmet.git

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index db6f96a..c5a826a 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -7,7 +7,7 @@
 -- | Highly random utility functions
 module Util (
         -- * Flags dependent on the compiler build
-        ghciSupported, debugIsOn, ghciTablesNextToCode, picIsOn,
+        ghciSupported, debugIsOn, ghciTablesNextToCode, isDynamicGhcLib,
         isWindowsHost, isWindowsTarget, isDarwinTarget,
 
         -- * General list processing
@@ -30,8 +30,12 @@ module Util (
 
         isIn, isn'tIn,
 
+        -- * Tuples
+        fstOf3, sndOf3, thirdOf3,
+
         -- * List operations controlled by another list
         takeList, dropList, splitAtList, split,
+        dropTail,
 
         -- * For loop
         nTimes,
@@ -41,7 +45,7 @@ module Util (
 
         -- * Comparisons
         isEqual, eqListBy,
-        thenCmp, cmpList, maybePrefixMatch,
+        thenCmp, cmpList,
         removeSpaces,
 
         -- * Transitive closures
@@ -64,7 +68,7 @@ module Util (
         doesDirNameExist,
         modificationTimeIfExists,
 
-        global, consIORef,
+        global, consIORef, globalMVar, globalEmptyMVar,
 
         -- * Filenames and paths
         Suffix,
@@ -78,14 +82,12 @@ 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 )
 
-import qualified Data.List as List ( elem )
 #ifdef DEBUG
-import qualified Data.List as List ( notElem )
 import FastTypes
 #endif
 
@@ -138,11 +140,11 @@ ghciTablesNextToCode = True
 ghciTablesNextToCode = False
 #endif
 
-picIsOn :: Bool
-#ifdef __PIC__
-picIsOn = True
+isDynamicGhcLib :: Bool
+#ifdef DYNAMIC
+isDynamicGhcLib = True
 #else
-picIsOn = False
+isDynamicGhcLib = False
 #endif
 
 isWindowsHost :: Bool
@@ -181,6 +183,15 @@ nTimes 1 f = f
 nTimes n f = f . nTimes (n-1) f
 \end{code}
 
+\begin{code}
+fstOf3   :: (a,b,c) -> a    
+sndOf3   :: (a,b,c) -> b    
+thirdOf3 :: (a,b,c) -> c    
+fstOf3      (a,_,_) =  a
+sndOf3      (_,b,_) =  b
+thirdOf3    (_,_,c) =  c
+\end{code}
+
 %************************************************************************
 %*                                                                      *
 \subsection[Utils-lists]{General list processing}
@@ -386,36 +397,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 +524,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}
@@ -608,6 +610,10 @@ splitAtList (_:xs) (y:ys) = (y:ys', ys'')
     where
       (ys', ys'') = splitAtList xs ys
 
+-- drop from the end of a list
+dropTail :: Int -> [a] -> [a]
+dropTail n = reverse . drop n . reverse
+
 snocView :: [a] -> Maybe ([a],a)
         -- Split off the last element
 snocView [] = Nothing
@@ -660,15 +666,6 @@ cmpList cmp (a:as) (b:bs)
 \end{code}
 
 \begin{code}
--- This (with a more general type) is Data.List.stripPrefix from GHC 6.8.
--- This definition can be removed once we require at least 6.8 to build.
-maybePrefixMatch :: String -> String -> Maybe String
-maybePrefixMatch []    rest = Just rest
-maybePrefixMatch (_:_) []   = Nothing
-maybePrefixMatch (p:pat) (r:rest)
-  | p == r    = maybePrefixMatch pat rest
-  | otherwise = Nothing
-
 removeSpaces :: String -> String
 removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
 \end{code}
@@ -700,8 +697,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: