X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Frunghc%2Frunghc.hs;h=55e622a5a832b7e889bff45898e180bee1f0a7ed;hb=3d5dd8dec20890b6141f108586d5f388334ffba1;hp=be04cdf64093fcaad9977d657a66693275c3c541;hpb=428d3450363d94b7a0dc3829aad40c966d455961;p=ghc-hetmet.git diff --git a/ghc/utils/runghc/runghc.hs b/ghc/utils/runghc/runghc.hs index be04cdf..55e622a 100644 --- a/ghc/utils/runghc/runghc.hs +++ b/ghc/utils/runghc/runghc.hs @@ -25,16 +25,11 @@ module Main where import System.Environment import System.IO import Data.List -import System.Directory import System.Exit import Data.Char -#if __GLASGOW_HASKELL__ < 603 -import Foreign ( withMany, withArray0, nullPtr, Ptr ) -import Foreign.C ( CString, withCString, throwErrnoIfMinus1 ) -#else -import System.Cmd ( rawSystem ) -#endif +import Compat.RawSystem ( rawSystem ) +import Compat.Directory ( findExecutable ) main = do args <- getArgs @@ -42,9 +37,10 @@ main = do ('-':'f' : ghc) : filename : args -> do doIt (dropWhile isSpace ghc) filename args filename : args -> do - path <- getEnv "PATH" `catch` \e -> return "." - ghc <- findBinary "ghc" - doIt ghc filename args + mb_ghc <- findExecutable "ghc" + case mb_ghc of + Nothing -> dieProg ("cannot find ghc") + Just ghc -> doIt ghc filename args _other -> do dieProg "syntax: runghc [-f GHCPATH] FILE ARG..." @@ -54,39 +50,8 @@ doIt ghc filename args = do ++ "] Main.main", filename] exitWith res -findBinary :: String -> IO FilePath -findBinary binary = do - path <- getEnv "PATH" - search (parsePath path) - where - search :: [FilePath] -> IO FilePath - search [] = dieProg ("cannot find " ++ binary) - search (d:ds) = do - let path = d ++ '/':binary - b <- doesFileExist path - if b then return path else search ds - -parsePath :: String -> [FilePath] -parsePath path = split pathSep path - where -#ifdef mingw32_TARGET_OS - pathSep = ';' -#else - pathSep = ':' -#endif - -split :: Char -> String -> [String] -split c s = case rest of - [] -> [chunk] - _:rest -> chunk : split c rest - where (chunk, rest) = break (==c) s - -die :: String -> IO a -die msg = do hPutStr stderr msg; exitWith (ExitFailure 1) - dieProg :: String -> IO a -dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg) - -#if __GLASGOW_HASKELL__ < 603 -#include "../../../libraries/base/System/RawSystem.hs-inc" -#endif +dieProg msg = do + p <- getProgName + hPutStr stderr (p ++ ": " ++ msg) + exitWith (ExitFailure 1)