X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=c5a826a4829a9353edc423f3952ba9e0291be861;hb=e9f9ec1e57d53b9302a395ce0d02c0fa59e28341;hp=83d7cc8241ce1397b25127373914f4f9eedcb47a;hpb=09c5039866fcd4f58424cb40f67049a373d98055;p=ghc-hetmet.git diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 83d7cc8..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 @@ -93,7 +95,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 +109,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 @@ -129,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 @@ -172,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} @@ -377,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} @@ -513,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} @@ -599,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 @@ -651,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} @@ -691,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: @@ -874,17 +887,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