1 {-# OPTIONS -cpp -fffi #-}
3 -----------------------------------------------------------------------------
5 -- (c) The University of Glasgow, 2004
7 -- runghc program, for invoking from a #! line in a script. For example:
11 -- > main = putStrLn "hello!"
13 -- runghc accepts one flag:
15 -- -f <path> specify the path
17 -- -----------------------------------------------------------------------------
21 import System.Environment
24 import System.Directory
28 #if __GLASGOW_HASKELL__ < 603
29 import Foreign ( withMany, withArray0, nullPtr, Ptr )
30 import Foreign.C ( CString, withCString, throwErrnoIfMinus1 )
32 import System.Cmd ( rawSystem )
38 ('-':'f' : ghc) : filename : args -> do
39 doIt (dropWhile isSpace ghc) filename args
41 path <- getEnv "PATH" `catch` \e -> return "."
42 ghc <- findBinary "ghc"
43 doIt ghc filename args
45 dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
47 doIt ghc filename args = do
48 res <- rawSystem ghc ["-e","System.Environment.withArgs ["
49 ++ concat (intersperse "," (map show args))
50 ++ "] Main.main", filename]
53 findBinary :: String -> IO FilePath
54 findBinary binary = do
56 search (parsePath path)
58 search :: [FilePath] -> IO FilePath
59 search [] = dieProg ("cannot find " ++ binary)
61 let path = d ++ '/':binary
62 b <- doesFileExist path
63 if b then return path else search ds
65 parsePath :: String -> [FilePath]
66 parsePath path = split pathSep path
68 #ifdef mingw32_TARGET_OS
74 split :: Char -> String -> [String]
75 split c s = case rest of
77 _:rest -> chunk : split c rest
78 where (chunk, rest) = break (==c) s
81 die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
83 dieProg :: String -> IO a
84 dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg)
86 #if __GLASGOW_HASKELL__ < 603
87 #include "../../../libraries/base/System/RawSystem.hs-inc"