[project @ 2001-05-23 09:59:18 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / DriverUtil.hs

diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs
index 91fd3ca..0a25f76 100644 (file)
--- a/ghc/compiler/main/DriverUtil.hs
+++ b/ghc/compiler/main/DriverUtil.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.16 2000/12/20 15:44:01 rrt Exp $
+-- $Id: DriverUtil.hs,v 1.21 2001/05/08 10:58:48 simonmar Exp $
 --
 -- Utils for the driver
 --
@@ -20,9 +20,9 @@ import Exception
 import Dynamic
 import RegexString
 
+import Directory       ( getDirectoryContents )
 import IO
 import System
-import Directory ( removeFile )
 import List
 import Char
 import Monad
@@ -67,6 +67,17 @@ getOptionsFromSource file
 optionRegex = mkRegex "\\{-#[ \t]+OPTIONS[ \t]+(.*)#-\\}"   -- -}
 
 -----------------------------------------------------------------------------
+-- A version of getDirectoryContents that is non-fatal if the
+-- directory doesn't exist.
+
+softGetDirectoryContents d
+   = IO.catch (getDirectoryContents d)
+         (\_ -> do hPutStr stderr 
+                         ("WARNING: error while reading directory " ++ d)
+                   return []
+         )
+
+-----------------------------------------------------------------------------
 -- Utils
 
 unknownFlagErr :: String -> a
@@ -114,6 +125,9 @@ addNoDups var x = do
 splitFilename :: String -> (String,String)
 splitFilename f = split_longest_prefix f '.'
 
+getFileSuffix :: String -> String
+getFileSuffix f = drop_longest_prefix f '.'
+
 -- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
 splitFilename3 :: String -> (String,String,String)
 splitFilename3 str
@@ -161,23 +175,3 @@ newdir dir s = dir ++ '/':drop_longest_prefix s '/'
 remove_spaces :: String -> String
 remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
 
-
--- system that works feasibly under Windows (i.e. passes the command line to sh,
--- because system() under Windows doesn't look at SHELL, and always uses CMD.EXE)
-kludgedSystem cmd phase_name
- = do
-#ifndef mingw32_TARGET_OS
-   exit_code <- system cmd `catchAllIO` 
-                  (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
-#else
-   pid <- myGetProcessID
-   let tmp = "/tmp/sh" ++ show pid
-   h <- openFile tmp WriteMode
-   hPutStrLn h cmd
-   hClose h
-   exit_code <- system ("sh - " ++ tmp) `catchAllIO` 
-                  (\_ -> removeFile tmp >>
-                          throwDyn (PhaseFailed phase_name (ExitFailure 1)))
-   removeFile tmp
-#endif
-   return exit_code