X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Frunghc%2Frunghc.hs;h=f8330b5721363fb540cced05355d274dda3c69cb;hb=50bc39808cd5b483a048a4d387f937963bd0e00f;hp=a79f411fcb28f0694f45a0ec68ba07bfd0d14570;hpb=c1f0366b19ddba81a0e35c4204502432286d77d9;p=ghc-hetmet.git

diff --git a/ghc/utils/runghc/runghc.hs b/ghc/utils/runghc/runghc.hs
index a79f411..f8330b5 100644
--- a/ghc/utils/runghc/runghc.hs
+++ b/ghc/utils/runghc/runghc.hs
@@ -1,5 +1,9 @@
-{-# OPTIONS -cpp #-}
+{-# OPTIONS -cpp -fffi #-}
+#if __GLASGOW_HASKELL__ < 603
 #include "config.h"
+#else
+#include "ghcconfig.h"
+#endif
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow, 2004
@@ -20,60 +24,43 @@ module Main where
 
 import System.Environment
 import System.IO
-import System.Cmd
 import Data.List
-import System.Directory
 import System.Exit
 import Data.Char
 
+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..."
+    ('-':'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
 
-doIt ghc filename args = do
-  res <- rawSystem ghc ["-e","System.Environment.withArgs ["
-			++ concat (intersperse "," (map show args))
-			++ "] Main.main", filename]
-  exitWith res
+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
 
-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)
+notArg ('-':_) = False
+notArg _       = True
 
 dieProg :: String -> IO a
-dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg)
-
+dieProg msg = do
+  p <- getProgName
+  hPutStrLn stderr (p ++ ": " ++ msg)
+  exitWith (ExitFailure 1)