X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Frunghc%2Frunghc.hs;h=5baaeff4b9ee261c912d8e4c534a37777f189a2c;hb=46f8e0092cacff4b2430296772218db7cfb3d123;hp=911d0f8f9de8558b36215079876f846a1302e9bc;hpb=1aa4db5e6883b4ffa6ea0f9c3450c0c15e40f543;p=ghc-hetmet.git diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs index 911d0f8..5baaeff 100644 --- a/utils/runghc/runghc.hs +++ b/utils/runghc/runghc.hs @@ -57,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 @@ -76,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"] ++