Remove some of the old compat stuff now that we assume GHC 6.4

10 files changed, 1 insertions, 367 deletions

diff --git a/compat/Compat/Directory.hs b/compat/Compat/Directory.hs
deleted file mode 100644
index 983f0830c0..0000000000
--- a/compat/Compat/Directory.hs
+++ /dev/null
@@ -1,170 +0,0 @@
-{-# OPTIONS -cpp #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Compat.Directory
--- Copyright   :  (c) The University of Glasgow 2001-2004
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- Functions from System.Directory that aren't present in older versions
--- of that library.
---
------------------------------------------------------------------------------
-
-module Compat.Directory (
-  	getAppUserDataDirectory,
-  	copyFile,
-  	findExecutable,
-  	createDirectoryIfMissing
-  ) where
-
-#include "../../includes/ghcconfig.h"
-
-import System.Environment (getEnv)
-import System.FilePath
-#if __GLASGOW_HASKELL__ > 600
-import Control.Exception	( bracket )
-import Control.Monad		( when )
-import Foreign.Marshal.Alloc	( allocaBytes )
-import System.IO (IOMode(..), openBinaryFile, hGetBuf, hPutBuf, hClose)
-import System.IO.Error		( try )
-import GHC.IOBase ( IOException(..) )
-#if defined(mingw32_HOST_OS)
-import GHC.IOBase ( IOErrorType(..) )
-#endif
-#else
-import System.IO		( try )
-#endif
-#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
-import Foreign
-import Foreign.C
-#endif
-import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
-
-getAppUserDataDirectory :: String -> IO FilePath
-getAppUserDataDirectory appName = do
-#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
-  allocaBytes long_path_size $ \pPath -> do
-     r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
-     when (r<0) (raiseUnsupported "Compat.Directory.getAppUserDataDirectory")
-     s <- peekCString pPath
-     return (s++'\\':appName)
-#else
-  path <- getEnv "HOME"
-  return (path++'/':'.':appName)
-#endif
-
-#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
-foreign import ccall unsafe "directory.h __hscore_getFolderPath"
-            c_SHGetFolderPath :: Ptr () 
-                              -> CInt 
-                              -> Ptr () 
-                              -> CInt 
-                              -> CString 
-                              -> IO CInt
-
--- __compat_long_path_size defined in cbits/directory.c
-foreign import ccall unsafe "directory.h __compat_long_path_size"
-  long_path_size :: Int
-
-foreign import ccall unsafe "directory.h __hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
-
-raiseUnsupported loc = 
-   ioError (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
-#endif
-
-
-copyFile :: FilePath -> FilePath -> IO ()
-copyFile fromFPath toFPath =
-#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
-	do readFile fromFPath >>= writeFile toFPath
-	   try (getPermissions fromFPath >>= setPermissions toFPath)
-	   return ()
-#else
-	(bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
-	 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
-	 allocaBytes bufferSize $ \buffer -> do
-		copyContents hFrom hTo buffer
-		try (getPermissions fromFPath >>= setPermissions toFPath)
-		return ()) `catch` (ioError . changeFunName)
-	where
-		bufferSize = 1024
-		
-		changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
-		
-		copyContents hFrom hTo buffer = do
-			count <- hGetBuf hFrom buffer bufferSize
-			when (count > 0) $ do
-				hPutBuf hTo buffer count
-				copyContents hFrom hTo buffer
-#endif
-
--- | Given an executable file name, searches for such file
--- in the directories listed in system PATH. The returned value 
--- is the path to the found executable or Nothing if there isn't
--- such executable. For example (findExecutable \"ghc\")
--- gives you the path to GHC.
-findExecutable :: String -> IO (Maybe FilePath)
-findExecutable binary =
-#if defined(mingw32_HOST_OS)
-  withCString binary $ \c_binary ->
-  withCString ('.':exeExtension) $ \c_ext ->
-  allocaBytes long_path_size $ \pOutPath ->
-  alloca $ \ppFilePart -> do
-    res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
-    if res > 0 && res < fromIntegral long_path_size
-      then do fpath <- peekCString pOutPath
-              return (Just fpath)
-      else return Nothing
-
-foreign import stdcall unsafe "SearchPathA"
-            c_SearchPath :: CString
-                         -> CString
-                         -> CString
-                         -> CInt
-                         -> CString
-                         -> Ptr CString
-                         -> IO CInt
-#else
- do
-  path <- getEnv "PATH"
-  search (splitSearchPath path)
-  where
-    fileName = binary <.> exeExtension
-
-    search :: [FilePath] -> IO (Maybe FilePath)
-    search [] = return Nothing
-    search (d:ds) = do
-        let path = d </> fileName
-        b <- doesFileExist path
-        if b then return (Just path)
-             else search ds
-#endif
-
--- ToDo: This should be determined via autoconf (AC_EXEEXT)
--- | Extension for executable files
--- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
-exeExtension :: String
-#ifdef mingw32_HOST_OS
-exeExtension = "exe"
-#else
-exeExtension = ""
-#endif
-
--- | @'createDirectoryIfMissing' parents dir@ creates a new directory 
--- @dir@ if it doesn\'t exist. If the first argument is 'True'
--- the function will also create all parent directories if they are missing.
-createDirectoryIfMissing :: Bool     -- ^ Create its parents too?
-		         -> FilePath -- ^ The path to the directory you want to make
-		         -> IO ()
-createDirectoryIfMissing parents file = do
-  b <- doesDirectoryExist file
-  case (b,parents, file) of
-    (_,     _, "") -> return ()
-    (True,  _,  _) -> return ()
-    (_,  True,  _) -> mapM_ (createDirectoryIfMissing False) $ mkParents file
-    (_, False,  _) -> createDirectory file
- where mkParents = scanl1 (</>) . splitDirectories . normalise
diff --git a/compat/Compat/RawSystem.hs b/compat/Compat/RawSystem.hs
deleted file mode 100644
index f0f8aa3ac7..0000000000
--- a/compat/Compat/RawSystem.hs
+++ /dev/null
@@ -1,156 +0,0 @@
-{-# OPTIONS -cpp #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Compat.RawSystem
--- Copyright   :  (c) The University of Glasgow 2001-2004
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- This is an implementation of rawSystem for use on older versions of GHC
--- which had missing or buggy implementations of this function.
---
------------------------------------------------------------------------------
-
-module Compat.RawSystem (rawSystem) where
-
-#include "../../includes/ghcconfig.h"
-
-#if __GLASGOW_HASKELL__ >= 603
-
-import System.Cmd (rawSystem)
-
-#else /* to end of file */
-
-import System.Exit
-import Foreign
-import Foreign.C
-
-{- | 
-The computation @'rawSystem' cmd args@ runs the operating system command
-whose file name is @cmd@, passing it the arguments @args@.  It
-bypasses the shell, so that @cmd@ should see precisely the argument
-strings @args@, with no funny escaping or shell meta-syntax expansion.
-(Unix users will recognise this behaviour 
-as @execvp@, and indeed that's how it's implemented.)
-It will therefore behave more portably between operating systems than 'system'.
-
-The return codes are the same as for 'system'.
--}
-
-rawSystem :: FilePath -> [String] -> IO ExitCode
-
-{- -------------------------------------------------------------------------
- 	IMPORTANT IMPLEMENTATION NOTES
-   (see also libraries/base/cbits/rawSystem.c)
-
-On Unix, rawSystem is easy to implement: use execvp.
-
-On Windows it's more tricky.  We use CreateProcess, passing a single
-command-line string (lpCommandLine) as its argument.  (CreateProcess
-is well documented on http://msdn.microsoft/com.)
-
-  - It parses the beginning of the string to find the command. If the
-	file name has embedded spaces, it must be quoted, using double
-	quotes thus 
-		"foo\this that\cmd" arg1 arg2
-
-  - The invoked command can in turn access the entire lpCommandLine string,
-	and the C runtime does indeed do so, parsing it to generate the 
-	traditional argument vector argv[0], argv[1], etc.  It does this
-	using a complex and arcane set of rules which are described here:
-	
-	   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
-
-	(if this URL stops working, you might be able to find it by
-	searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
-	the code in the Microsoft C runtime that does this translation
-	is shipped with VC++).
-
-
-Our goal in rawSystem is to take a command filename and list of
-arguments, and construct a string which inverts the translatsions
-described above, such that the program at the other end sees exactly
-the same arguments in its argv[] that we passed to rawSystem.
-
-This inverse translation is implemented by 'translate' below.
-
-Here are some pages that give informations on Windows-related 
-limitations and deviations from Unix conventions:
-
-    http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
-    Command lines and environment variables effectively limited to 8191 
-    characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
-
-    http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
-    Command-line substitution under Windows XP. IIRC these facilities (or at 
-    least a large subset of them) are available on Win NT and 2000. Some 
-    might be available on Win 9x.
-
-    http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
-    How CMD.EXE processes command lines.
-
-
-Note: CreateProcess does have a separate argument (lpApplicationName)
-with which you can specify the command, but we have to slap the
-command into lpCommandLine anyway, so that argv[0] is what a C program
-expects (namely the application name).  So it seems simpler to just
-use lpCommandLine alone, which CreateProcess supports.
-
------------------------------------------------------------------------------ -}
-
-#ifndef mingw32_HOST_OS
-
-rawSystem cmd args =
-  withCString cmd $ \pcmd ->
-    withMany withCString (cmd:args) $ \cstrs ->
-      withArray0 nullPtr cstrs $ \arr -> do
-	status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
-        case status of
-            0  -> return ExitSuccess
-            n  -> return (ExitFailure n)
-
-foreign import ccall unsafe "rawSystem"
-  c_rawSystem :: CString -> Ptr CString -> IO Int
-
-#else
-
--- On Windows, the command line is passed to the operating system as
--- a single string.  Command-line parsing is done by the executable
--- itself.
-rawSystem cmd args = do
-	-- NOTE: 'cmd' is assumed to contain the application to run _only_,
-	-- as it'll be quoted surrounded in quotes here.
-  let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
-  withCString cmdline $ \pcmdline -> do
-    status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
-    case status of
-       0  -> return ExitSuccess
-       n  -> return (ExitFailure n)
-
-translate :: String -> String
-translate str@('"':_) = str -- already escaped.
-	-- ToDo: this case is wrong.  It is only here because we
-	-- abuse the system in GHC's SysTools by putting arguments into
-	-- the command name; at some point we should fix it up and remove
-	-- the case above.
-translate str = '"' : snd (foldr escape (True,"\"") str)
-  where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
-        escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
-        escape '\\' (False, str) = (False, '\\' : str)
-	escape c    (b,     str) = (False, c : str)
-	-- See long comment above for what this function is trying to do.
-	--
-	-- The Bool passed back along the string is True iff the
-	-- rest of the string is a sequence of backslashes followed by
-	-- a double quote.
-
-foreign import ccall unsafe "rawSystem"
-  c_rawSystem :: CString -> IO Int
-
-#endif
-
-#endif
-
diff --git a/compat/compat.mk b/compat/compat.mk
index 474051074d..8101021f86 100644
--- a/compat/compat.mk
+++ b/compat/compat.mk
@@ -36,8 +36,6 @@ endif
 # This is horrible.  We ought to be able to omit the entire directory
 # from mkDependHS.
 SRC_MKDEPENDHS_OPTS += \
-	-optdep--exclude-module=Compat.RawSystem \
-	-optdep--exclude-module=Compat.Directory \
 	-optdep--exclude-module=Compat.Unicode \
 	-optdep--exclude-module=Distribution.Compat.FilePath \
 	-optdep--exclude-module=Distribution.Compat.ReadP \
@@ -52,7 +50,6 @@ SRC_MKDEPENDHS_OPTS += \
 	-optdep--exclude-module=System.FilePath \
 	-optdep--exclude-module=System.FilePath.Posix \
 	-optdep--exclude-module=System.FilePath.Windows \
-	-optdep--exclude-module=System.Directory.Internals \
 	-optdep--exclude-module=Trace.Hpc.Mix \
 	-optdep--exclude-module=Trace.Hpc.Tix \
 	-optdep--exclude-module=Trace.Hpc.Util
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index e97ab4252c..6d6f1f044b 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -29,11 +29,7 @@ import FiniteMap
 
 import Data.Array
 import System.IO   (FilePath)
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
-import Compat.Directory ( createDirectoryIfMissing )
-#else
 import System.Directory ( createDirectoryIfMissing )
-#endif
 
 import Trace.Hpc.Mix
 import Trace.Hpc.Util
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index ad841b258e..d1feff77f7 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -54,10 +54,6 @@ import Maybes		( expectJust, MaybeErr(..) )
 import Panic
 import Outputable
 
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
-import Compat.Directory	( getAppUserDataDirectory )
-#endif
-
 import System.Environment ( getEnv )
 import Distribution.InstalledPackageInfo
 import Distribution.Package
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 6aa04b1459..484e9e20a2 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -72,17 +72,10 @@ import Foreign
 import CString		( CString, peekCString )
 #endif
 
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
--- rawSystem comes from libghccompat.a in stage1
-import Compat.RawSystem ( rawSystem )
-import System.Cmd       ( system )
-import GHC.IOBase       ( IOErrorType(..) ) 
-#else
 import System.Process	( runInteractiveProcess, getProcessExitCode )
 import Control.Concurrent( forkIO, newChan, readChan, writeChan )
 import FastString       ( mkFastString )
 import SrcLoc           ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
-#endif
 \end{code}
 
 
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 866c9fe1cd..ae85fbccc5 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -22,14 +22,8 @@ import Distribution.ParseUtils
 import Distribution.Package
 import Distribution.Version
 import System.FilePath
-
-#ifdef USING_COMPAT
-import Compat.Directory ( getAppUserDataDirectory, createDirectoryIfMissing )
-import Compat.RawSystem ( rawSystem )
-#else
-import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing )
 import System.Cmd       ( rawSystem )
-#endif
+import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing )
 
 import Prelude
 
diff --git a/utils/hsc2hs/Main.hs b/utils/hsc2hs/Main.hs
index a5bd774387..a939f319d1 100644
--- a/utils/hsc2hs/Main.hs
+++ b/utils/hsc2hs/Main.hs
@@ -42,11 +42,7 @@ import System.IO                ( openFile, IOMode(..), hClose )
 #endif
 
 #if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC)
-#ifdef USING_COMPAT
-import Compat.RawSystem ( rawSystem )
-#else
 import System.Cmd       ( rawSystem )
-#endif
 #define HAVE_rawSystem
 #elif __NHC__ >= 117
 import System.Cmd	 	( rawSystem )
diff --git a/utils/runghc/Makefile b/utils/runghc/Makefile
index 16e9724f60..a7303f97d7 100644
--- a/utils/runghc/Makefile
+++ b/utils/runghc/Makefile
@@ -7,13 +7,6 @@ INSTALL_PROGS   += $(HS_PROG)
 UseGhcForCc = YES
 SRC_MKDEPENDC_OPTS += -I$(GHC_INCLUDE_DIR)
 
-# This causes libghccompat.a to be used:
-include $(GHC_COMPAT_DIR)/compat.mk
-
-# This is required because libghccompat.a must be built with
-# $(GhcHcOpts) because it is linked to the compiler, and hence
-# we must also build with $(GhcHcOpts) here:
-SRC_HC_OPTS += $(GhcHcOpts) $(GhcStage1HcOpts)
 SRC_HC_OPTS += -Wall
 
 RUNHASKELL_PROG = runhaskell$(exeext)
diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs
index 458861ea65..e2cea31231 100644
--- a/utils/runghc/runghc.hs
+++ b/utils/runghc/runghc.hs
@@ -30,12 +30,7 @@ import Data.Char
 import System.Directory ( removeFile )
 import Control.Exception  ( bracket )
 import System.Directory ( findExecutable, getTemporaryDirectory )
-
-#ifdef USING_COMPAT
-import Compat.RawSystem ( rawSystem )
-#else
 import System.Cmd       ( rawSystem )
-#endif
 
 main :: IO ()
 main = do