X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=d8b61f898d6d491a8fd0220a8480fca3c6347c5e;hb=431453c003b867a2fe33d8634ee830d062be5a96;hp=83d7cc8241ce1397b25127373914f4f9eedcb47a;hpb=09c5039866fcd4f58424cb40f67049a373d98055;p=ghc-hetmet.git

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 83d7cc8..d8b61f8 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -32,6 +32,7 @@ module Util (
 
         -- * List operations controlled by another list
         takeList, dropList, splitAtList, split,
+        dropTail,
 
         -- * For loop
         nTimes,
@@ -41,7 +42,7 @@ module Util (
 
         -- * Comparisons
         isEqual, eqListBy,
-        thenCmp, cmpList, maybePrefixMatch,
+        thenCmp, cmpList,
         removeSpaces,
 
         -- * Transitive closures
@@ -64,7 +65,7 @@ module Util (
         doesDirNameExist,
         modificationTimeIfExists,
 
-        global, consIORef,
+        global, consIORef, globalMVar, globalEmptyMVar,
 
         -- * Filenames and paths
         Suffix,
@@ -78,14 +79,13 @@ 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 qualified Data.List as List ( elem, notElem )
 import FastTypes
 #endif
 
@@ -93,7 +93,7 @@ import Control.Monad    ( unless )
 import System.IO.Error as IO ( catch, isDoesNotExistError )
 import System.Directory ( doesDirectoryExist, createDirectory,
                           getModificationTime )
-import System.FilePath hiding ( searchPathSeparator )
+import System.FilePath
 import Data.Char        ( isUpper, isAlphaNum, isSpace, ord, isDigit )
 import Data.Ratio       ( (%) )
 import System.Time      ( ClockTime )
@@ -107,6 +107,15 @@ infixr 9 `thenCmp`
 %*                                                                      *
 %************************************************************************
 
+These booleans are global constants, set by CPP flags.  They allow us to
+recompile a single module (this one) to change whether or not debug output
+appears. They sometimes let us avoid even running CPP elsewhere.
+
+It's important that the flags are literal constants (True/False). Then,
+with -0, tests of the flags in other modules will simplify to the correct
+branch of the conditional, thereby dropping debug code altogether when
+the flags are off.
+
 \begin{code}
 ghciSupported :: Bool
 #ifdef GHCI
@@ -513,7 +522,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}
@@ -599,6 +608,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
@@ -651,15 +664,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}
@@ -691,8 +695,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:
@@ -874,17 +885,7 @@ parseSearchPath path = split path
 #endif
             _                                 -> chunk'
 
-        (chunk', rest') = break (==searchPathSeparator) s
-
--- | A platform-specific character used to separate search path strings in
--- environment variables. The separator is a colon (\":\") on Unix and
--- Macintosh, and a semicolon (\";\") on the Windows operating system.
-searchPathSeparator :: Char
-#if mingw32_HOST_OS || mingw32_TARGET_OS
-searchPathSeparator = ';'
-#else
-searchPathSeparator = ':'
-#endif
+        (chunk', rest') = break isSearchPathSeparator s
 
 data Direction = Forwards | Backwards