X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Frunghc%2Frunghc.hs;h=5baaeff4b9ee261c912d8e4c534a37777f189a2c;hb=46f8e0092cacff4b2430296772218db7cfb3d123;hp=5053858b20b0ceb724cb483c143b0cff72d19749;hpb=c0909f1e26589478f44650e16cbf8c0ffdbf2112;p=ghc-hetmet.git diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs index 5053858..5baaeff 100644 --- a/utils/runghc/runghc.hs +++ b/utils/runghc/runghc.hs @@ -32,6 +32,12 @@ import System.Exit import System.FilePath import System.IO +#if defined(mingw32_HOST_OS) +import Control.Monad +import Foreign +import Foreign.C.String +#endif + main :: IO () main = do args <- getArgs @@ -51,8 +57,8 @@ getGhcLoc args = case args of ('-' : 'f' : ghc) : args' -> f ghc args' -- If you need the first GHC flag to be a -f flag then -- you can pass -- first - "--" : args -> (Nothing, args) - args -> (Nothing, args) + "--" : args' -> (Nothing, args') + _ -> (Nothing, args) where f ghc args' = -- If there is another -f flag later on then -- that overrules the one that we've already -- found @@ -70,15 +76,22 @@ doIt ghc args = do tmpdir <- getTemporaryDirectory bracket (openTempFile tmpdir "runghcXXXX.hs") - (\(filename,_) -> removeFile filename) + (\(filename,h) -> do hClose h; removeFile filename) $ \(filename,h) -> do getContents >>= hPutStr h hClose h doIt ghc (ghc_args ++ [filename]) filename : prog_args -> do - let xflag = if takeExtension filename == ".lhs" - then [] - else ["-x", "hs"] + -- If the file exists, and is not a .lhs file, then we + -- want to treat it as a .hs file. + -- + -- If the file doesn't exist then GHC is going to look for + -- filename.hs and filename.lhs, and use the appropriate + -- type. + exists <- doesFileExist filename + let xflag = if exists && (takeExtension filename /= ".lhs") + then ["-x", "hs"] + else [] c1 = ":set prog " ++ show filename c2 = ":main " ++ show prog_args res <- rawSystem ghc (["-ignore-dot-ghci"] ++