1 {-# OPTIONS -cpp -fffi #-}
2 #if __GLASGOW_HASKELL__ < 603
7 -----------------------------------------------------------------------------
9 -- (c) The University of Glasgow, 2004
11 -- runghc program, for invoking from a #! line in a script. For example:
15 -- > main = putStrLn "hello!"
17 -- runghc accepts one flag:
19 -- -f <path> specify the path
21 -- -----------------------------------------------------------------------------
25 import System.Environment
28 import System.Directory
32 #if __GLASGOW_HASKELL__ < 603
33 import Foreign ( withMany, withArray0, nullPtr, Ptr )
34 import Foreign.C ( CString, withCString, throwErrnoIfMinus1 )
36 import System.Cmd ( rawSystem )
42 ('-':'f' : ghc) : filename : args -> do
43 doIt (dropWhile isSpace ghc) filename args
45 path <- getEnv "PATH" `catch` \e -> return "."
46 ghc <- findBinary "ghc"
47 doIt ghc filename args
49 dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
51 doIt ghc filename args = do
52 res <- rawSystem ghc ["-e","System.Environment.withArgs ["
53 ++ concat (intersperse "," (map show args))
54 ++ "] Main.main", filename]
57 findBinary :: String -> IO FilePath
58 findBinary binary = do
60 search (parsePath path)
62 search :: [FilePath] -> IO FilePath
63 search [] = dieProg ("cannot find " ++ binary)
65 let path = d ++ '/':binary
66 b <- doesFileExist path
67 if b then return path else search ds
69 parsePath :: String -> [FilePath]
70 parsePath path = split pathSep path
72 #ifdef mingw32_TARGET_OS
78 split :: Char -> String -> [String]
79 split c s = case rest of
81 _:rest -> chunk : split c rest
82 where (chunk, rest) = break (==c) s
85 die msg = do hPutStr stderr msg; exitWith (ExitFailure 1)
87 dieProg :: String -> IO a
88 dieProg msg = do p <- getProgName; die (p ++ ": " ++ msg)
90 #if __GLASGOW_HASKELL__ < 603
91 #include "../../../libraries/base/System/RawSystem.hs-inc"