[project @ 2004-11-11 09:46:54 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / SysTools.lhs

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index fcd62de..06850ef 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -69,7 +69,7 @@ import DriverPhases     ( isHaskellUserSrcFilename )
 import Config
 import Outputable
 import Panic           ( GhcException(..) )
-import Util            ( global, notNull, toArgs )
+import Util            ( global, notNull )
 import CmdLineOpts     ( dynFlag, verbosity )
 
 import EXCEPTION       ( throwDyn )
@@ -106,8 +106,8 @@ import CString              ( CString, peekCString )
 #endif
 
 #if __GLASGOW_HASKELL__ < 603
-import Foreign         ( withMany, withArray0, nullPtr, Ptr )
-import CForeign                ( CString, withCString, throwErrnoIfMinus1 )
+-- rawSystem comes from libghccompat.a in stage1
+import Compat.RawSystem        ( rawSystem )
 #else
 import System.Cmd      ( rawSystem )
 #endif
@@ -423,7 +423,7 @@ initSysTools minusB_args
        }
 
 #if defined(mingw32_HOST_OS)
-foreign import stdcall "GetTempPathA" unsafe getTempPath :: Int -> CString -> IO Int32
+foreign import stdcall unsafe "GetTempPathA" getTempPath :: Int -> CString -> IO Int32
 #endif
 \end{code}
 
@@ -741,9 +741,18 @@ runSomething phase_name pgm args = do
   let real_args = filter notNull (map showOpt args)
   traceCmd phase_name (unwords (pgm:real_args)) $ do
   exit_code <- rawSystem pgm real_args
-  if (exit_code /= ExitSuccess)
-       then throwDyn (PhaseFailed phase_name exit_code)
-       else return ()
+  case exit_code of
+     ExitSuccess -> 
+       return ()
+     -- rawSystem returns (ExitFailure 127) if the exec failed for any
+     -- reason (eg. the program doesn't exist).  This is the only clue
+     -- we have, but we need to report something to the user because in
+     -- the case of a missing program there will otherwise be no output
+     -- at all.
+     ExitFailure 127 -> 
+       throwDyn (InstallationError ("could not execute: " ++ pgm))
+     ExitFailure _other ->
+       throwDyn (PhaseFailed phase_name exit_code)
 
 traceCmd :: String -> String -> IO () -> IO ()
 -- a) trace the command (at two levels of verbosity)
@@ -765,18 +774,6 @@ traceCmd phase_name cmd_line action
     handle_exn verb exn = do { when (verb >= 2) (hPutStr   stderr "\n")
                             ; when (verb >= 3) (hPutStrLn stderr ("Failed: " ++ cmd_line ++ (show exn)))
                             ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
-
--- -----------------------------------------------------------------------------
--- rawSystem: run an external command
---
--- In GHC 6.2.1 there's a correct implementation of rawSystem in the
--- library System.Cmd.  If we are compiling with an earlier version of
--- GHC than this, we'd better have a copy of the correct implementation
--- right here.
-
-#if __GLASGOW_HASKELL__ < 603
-#include "../../libraries/base/System/RawSystem.hs-inc"
-#endif
 \end{code}
 
 
@@ -860,14 +857,14 @@ getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
   where
     rootDir s = reverse (dropList "/bin/ghc.exe" (reverse (normalisePath s)))
 
-foreign import stdcall "GetModuleFileNameA" unsafe
+foreign import stdcall unsafe "GetModuleFileNameA"
   getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
 #else
 getBaseDir :: IO (Maybe String) = do return Nothing
 #endif
 
 #ifdef mingw32_HOST_OS
-foreign import ccall "_getpid" unsafe getProcessID :: IO Int -- relies on Int == Int32 on Windows
+foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
 #elif __GLASGOW_HASKELL__ > 504
 getProcessID :: IO Int
 getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral