{-# OPTIONS -cpp -fffi #-}
+#if __GLASGOW_HASKELL__ < 603
#include "config.h"
+#else
+#include "ghcconfig.h"
+#endif
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow, 2004
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
case args of
- ('-':'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
- _other -> do
- dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
-
-doIt ghc filename args = do
- res <- rawSystem ghc ["-e","System.Environment.withArgs ["
- ++ concat (intersperse "," (map show args))
- ++ "] Main.main", filename]
- exitWith res
+ ('-':'f' : ghc) : args -> do
+ doIt (dropWhile isSpace ghc) args
+ args -> do
+ mb_ghc <- findExecutable "ghc"
+ case mb_ghc of
+ Nothing -> dieProg ("cannot find ghc")
+ Just ghc -> doIt ghc args
-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
+doIt ghc args = do
+ let
+ (ghc_args, rest) = break notArg args
+ --
+ case rest of
+ [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
+ filename : prog_args -> do
+ res <- rawSystem ghc (
+ "-ignore-dot-ghci" : ghc_args ++
+ [ "-e","System.Environment.withProgName "++show filename++" (System.Environment.withArgs ["
+ ++ concat (intersperse "," (map show prog_args))
+ ++ "] Main.main)", filename])
+ exitWith res
-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)
+notArg ('-':_) = False
+notArg _ = True
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
+ hPutStrLn stderr (p ++ ": " ++ msg)
+ exitWith (ExitFailure 1)