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 -- -----------------------------------------------------------------------------
23 module Main (main) where
25 import System.Environment
32 import Compat.RawSystem ( rawSystem )
33 import Compat.Directory ( findExecutable )
35 import System.Cmd ( rawSystem )
36 import System.Directory ( findExecutable )
42 case getGhcLoc args of
43 (Just ghc, args') -> doIt ghc args'
44 (Nothing, args') -> do
45 mb_ghc <- findExecutable "ghc"
47 Nothing -> dieProg ("cannot find ghc")
48 Just ghc -> doIt ghc args'
50 getGhcLoc :: [String] -> (Maybe FilePath, [String])
51 getGhcLoc ("-f" : ghc : args) = (Just ghc, args)
52 getGhcLoc (('-' : 'f' : ghc) : args) = (Just ghc, args)
53 -- If you need the first GHC flag to be a -f flag then you can pass --
55 getGhcLoc ("--" : args) = (Nothing, args)
56 getGhcLoc args = (Nothing, args)
58 doIt :: String -> [String] -> IO ()
60 let (ghc_args, rest) = getGhcArgs args
63 filename : prog_args -> do
64 let expr = "System.Environment.withProgName " ++ show filename ++
65 " (System.Environment.withArgs " ++ show prog_args ++
66 " (GHC.TopHandler.runIOFastExit" ++
67 " (Main.main Prelude.>> Prelude.return ())))"
68 res <- rawSystem ghc (["-ignore-dot-ghci"] ++ ghc_args ++
69 [ "-e", expr, filename])
70 -- runIOFastExit: makes exceptions raised by Main.main
71 -- behave in the same way as for a compiled program.
72 -- The "fast exit" part just calls exit() directly
73 -- instead of doing an orderly runtime shutdown,
74 -- otherwise the main GHCi thread will complain about
77 -- Why (main >> return ()) rather than just main? Because
78 -- otherwise GHCi by default tries to evaluate the result
79 -- of the IO in order to show it (see #1200).
82 getGhcArgs :: [String] -> ([String], [String])
83 getGhcArgs args = case break pastArgs args of
84 (xs, "--":ys) -> (xs, ys)
87 pastArgs :: String -> Bool
88 -- You can use -- to mark the end of the flags, in caes you need to use
89 -- a file called -foo.hs for some reason. You almost certainly shouldn't,
92 pastArgs ('-':_) = False
95 dieProg :: String -> IO a
98 hPutStrLn stderr (p ++ ": " ++ msg)
99 exitWith (ExitFailure 1)
102 usage = "syntax: runghc [-f GHC-PATH | --] [GHC-ARGS] [--] FILE ARG..."