From: simonmar <unknown>
Date: Thu, 8 Mar 2001 09:50:18 +0000 (+0000)
Subject: [project @ 2001-03-08 09:50:18 by simonmar]
X-Git-Tag: Approximately_9120_patches~2452
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=68de0081f3581b9b15640cac598d980abe9ca424;p=ghc-hetmet.git

[project @ 2001-03-08 09:50:18 by simonmar]
rearrange slightly to make this compile again.
---

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 2a79c91..64f6df5 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.46 2001/03/05 10:05:58 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.47 2001/03/08 09:50:18 simonmar Exp $
 --
 -- Driver flags
 --
@@ -23,7 +23,7 @@ module DriverFlags (
 import PackageMaintenance
 import DriverState
 import DriverUtil
-import TmpFiles 	( v_TmpDir )
+import TmpFiles 	( v_TmpDir, kludgedSystem )
 import CmdLineOpts
 import Config
 import Util
diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs
index 3c255ce..9c282f6 100644
--- a/ghc/compiler/main/DriverUtil.hs
+++ b/ghc/compiler/main/DriverUtil.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.18 2001/03/07 10:28:40 rrt Exp $
+-- $Id: DriverUtil.hs,v 1.19 2001/03/08 09:50:18 simonmar Exp $
 --
 -- Utils for the driver
 --
@@ -14,7 +14,6 @@ module DriverUtil where
 
 import Util
 import Panic
-import TmpFiles ( v_TmpDir )
 
 import IOExts
 import Exception
@@ -23,7 +22,6 @@ import RegexString
 
 import IO
 import System
-import Directory ( removeFile )
 import List
 import Char
 import Monad
@@ -162,24 +160,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
-   tmp_dir <- readIORef v_TmpDir
-   let tmp = tmp_dir++"/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
diff --git a/ghc/compiler/main/PackageMaintenance.hs b/ghc/compiler/main/PackageMaintenance.hs
index 1722ea5..a233057 100644
--- a/ghc/compiler/main/PackageMaintenance.hs
+++ b/ghc/compiler/main/PackageMaintenance.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: PackageMaintenance.hs,v 1.7 2001/03/06 11:23:46 simonmar Exp $
+-- $Id: PackageMaintenance.hs,v 1.8 2001/03/08 09:50:18 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -14,6 +14,7 @@ module PackageMaintenance
 import CmStaticInfo
 import DriverState
 import DriverUtil
+import DriverFlags	( runSomething )
 import Panic
 
 import Exception
@@ -83,7 +84,7 @@ maybeRestoreOldConfig conf_file io
         hPutStr stdout "\nWARNING: an error was encountered while the new \n\ 
         	       \configuration was being written.  Attempting to \n\ 
         	       \restore the old configuration... "
-        kludgedSystem ("cp " ++ conf_file ++ ".old " ++ conf_file) "Restoring old configuration"
+        runSomething ("cp " ++ conf_file ++ ".old " ++ conf_file) "Restoring old configuration"
         hPutStrLn stdout "done."
 	throw e
     )
@@ -103,7 +104,7 @@ savePackageConfig conf_file = do
     -- mv rather than cp because we've already done an hGetContents
     -- on this file so we won't be able to open it for writing
     -- unless we move the old one out of the way...
-  kludgedSystem ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") "Saving package configuration"
+  runSomething ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") "Saving package configuration"
   hPutStrLn stdout "done."
 
 -----------------------------------------------------------------------------
diff --git a/ghc/compiler/main/TmpFiles.hs b/ghc/compiler/main/TmpFiles.hs
index 2a6eb7f..c90a22f 100644
--- a/ghc/compiler/main/TmpFiles.hs
+++ b/ghc/compiler/main/TmpFiles.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.15 2001/02/12 13:33:47 simonmar Exp $
+-- $Id: TmpFiles.hs,v 1.16 2001/03/08 09:50:18 simonmar Exp $
 --
 -- Temporary file management
 --
@@ -15,13 +15,15 @@ module TmpFiles (
    newTempName,		 -- :: Suffix -> IO FilePath
    addFilesToClean,	 -- :: [FilePath] -> IO ()
    removeTmpFiles,	 -- :: Int -> [FilePath] -> IO ()
-   v_TmpDir
+   v_TmpDir,
+   kludgedSystem
  ) where
 
 -- main
+import DriverUtil
 import Config
+import Panic
 import Util
-import DriverUtil
 
 -- hslibs
 import Exception
@@ -90,3 +92,25 @@ removeTmpFiles verb fs = do
 	   (\_ -> when verbose (hPutStrLn stderr 
 				("Warning: can't remove tmp file " ++ f)))
   mapM_ blowAway fs
+
+
+-- 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
+   tmp_dir <- readIORef v_TmpDir
+   let tmp = tmp_dir++"/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