X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Frunghc%2Frunghc.hs;h=707dc62be13d767986ba16f40c741fe5f481655b;hb=0b9530245a33b8206ca38b9de6dfb01e056fd8dc;hp=9346390e30499ae7f8ca9b8151b648e571a24885;hpb=0a066666b10008aca3a875f5c7499c21c59efc0c;p=ghc-hetmet.git

diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs
index 9346390..707dc62 100644
--- a/utils/runghc/runghc.hs
+++ b/utils/runghc/runghc.hs
@@ -39,22 +39,27 @@ import System.Directory ( findExecutable )
 main :: IO ()
 main = do
     args <- getArgs
-    case args of
-        ("-f" : ghc : args) -> do
-            doIt ghc args
-        ('-' : 'f' : ghc) : args -> do
-            doIt (dropWhile isSpace ghc) args
-        _ -> do
+    case getGhcLoc args of
+        (Just ghc, args') -> doIt ghc args'
+        (Nothing, args') -> do
             mb_ghc <- findExecutable "ghc"
             case mb_ghc of
                 Nothing  -> dieProg ("cannot find ghc")
-                Just ghc -> doIt ghc args
+                Just ghc -> doIt ghc args'
+
+getGhcLoc :: [String] -> (Maybe FilePath, [String])
+getGhcLoc ("-f" : ghc : args) = (Just ghc, args)
+getGhcLoc (('-' : 'f' : ghc) : args) = (Just ghc, args)
+-- If you need the first GHC flag to be a -f flag then you can pass --
+-- first
+getGhcLoc ("--" : args) = (Nothing, args)
+getGhcLoc args = (Nothing, args)
 
 doIt :: String -> [String] -> IO ()
 doIt ghc args = do
-    let (ghc_args, rest) = break notArg args
+    let (ghc_args, rest) = getGhcArgs args
     case rest of
-        [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
+        [] -> dieProg usage
         filename : prog_args -> do
             let expr = "System.Environment.withProgName " ++ show filename ++
                        " (System.Environment.withArgs " ++ show prog_args ++
@@ -74,9 +79,18 @@ doIt ghc args = do
                -- of the IO in order to show it (see #1200).
             exitWith res
 
-notArg :: String -> Bool
-notArg ('-':_) = False
-notArg _       = True
+getGhcArgs :: [String] -> ([String], [String])
+getGhcArgs args = case break pastArgs args of
+                      (xs, "--":ys) -> (xs, ys)
+                      (xs, ys)      -> (xs, ys)
+
+pastArgs :: String -> Bool
+-- You can use -- to mark the end of the flags, in caes you need to use
+-- a file called -foo.hs for some reason. You almost certainly shouldn't,
+-- though.
+pastArgs "--" = True
+pastArgs ('-':_) = False
+pastArgs _       = True
 
 dieProg :: String -> IO a
 dieProg msg = do
@@ -84,3 +98,6 @@ dieProg msg = do
     hPutStrLn stderr (p ++ ": " ++ msg)
     exitWith (ExitFailure 1)
 
+usage :: String
+usage = "syntax: runghc [-f GHC-PATH | --] [GHC-ARGS] [--] FILE ARG..."
+