X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Futils%2FUtil.lhs;h=7057d321a13956a3f94868301a2e67cb92c9539d;hb=9412e62942ebab0599c7fb0b358a9d4869647b67;hp=1d11b90a557945d1cc449efb4ba744e6df9634e8;hpb=30c122df62ec75f9ed7f392f24c2925675bf1d06;p=ghc-hetmet.git diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 1d11b90..7057d32 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -6,7 +6,8 @@ \begin{code} module Util ( - debugIsOn, + ghciSupported, debugIsOn, ghciTablesNextToCode, picIsOn, + isWindowsHost, isWindowsTarget, isDarwinTarget, -- general list processing zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal, @@ -93,7 +94,7 @@ import FastTypes #endif import Control.Monad ( unless ) -import SYSTEM_IO_ERROR as IO ( catch, isDoesNotExistError ) +import System.IO.Error as IO ( catch, isDoesNotExistError ) import System.Directory ( doesDirectoryExist, createDirectory, getModificationTime ) import System.FilePath hiding ( searchPathSeparator ) @@ -106,17 +107,59 @@ infixr 9 `thenCmp` %************************************************************************ %* * -\subsection{-DDEBUG} +\subsection{Is DEBUG on, are we on Windows, etc?} %* * %************************************************************************ \begin{code} +ghciSupported :: Bool +#ifdef GHCI +ghciSupported = True +#else +ghciSupported = False +#endif + debugIsOn :: Bool #ifdef DEBUG debugIsOn = True #else debugIsOn = False #endif + +ghciTablesNextToCode :: Bool +#ifdef GHCI_TABLES_NEXT_TO_CODE +ghciTablesNextToCode = True +#else +ghciTablesNextToCode = False +#endif + +picIsOn :: Bool +#ifdef __PIC__ +picIsOn = True +#else +picIsOn = False +#endif + +isWindowsHost :: Bool +#ifdef mingw32_HOST_OS +isWindowsHost = True +#else +isWindowsHost = False +#endif + +isWindowsTarget :: Bool +#ifdef mingw32_TARGET_OS +isWindowsTarget = True +#else +isWindowsTarget = False +#endif + +isDarwinTarget :: Bool +#ifdef darwin_TARGET_OS +isDarwinTarget = True +#else +isDarwinTarget = False +#endif \end{code} %************************************************************************ @@ -202,7 +245,12 @@ zipWith4Equal msg _ _ _ _ _ = panic ("zipWith4Equal: unequal lists:"++msg) zipLazy :: [a] -> [b] -> [(a,b)] zipLazy [] _ = [] -zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys +-- We want to write this, but with GHC 6.4 we get a warning, so it +-- doesn't validate: +-- zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys +-- so we write this instead: +zipLazy (x:xs) zs = let y : ys = zs + in (x,y) : zipLazy xs ys \end{code} @@ -364,16 +412,6 @@ isn'tIn msg x ys # endif /* DEBUG */ \end{code} -foldl1' was added in GHC 6.4 - -\begin{code} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 604 -foldl1' :: (a -> a -> a) -> [a] -> a -foldl1' f (x:xs) = foldl' f x xs -foldl1' _ [] = panic "foldl1'" -#endif -\end{code} - %************************************************************************ %* * \subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}