949a3300e81dff19ebd45090b1ac69016bb215f6
[ghc-hetmet.git] / ghc / utils / runghc / runghc.hs
1 {-# OPTIONS -cpp -fffi #-}
2 #if __GLASGOW_HASKELL__ < 603
3 #include "config.h"
4 #else
5 #include "ghcconfig.h"
6 #endif
7 -----------------------------------------------------------------------------
8 --
9 -- (c) The University of Glasgow, 2004
10 --
11 -- runghc program, for invoking from a #! line in a script.  For example:
12 --
13 --   script.lhs:
14 --      #! /usr/bin/runghc
15 --      > main = putStrLn "hello!"
16 --
17 -- runghc accepts one flag:
18 --
19 --      -f <path>    specify the path
20 --
21 -- -----------------------------------------------------------------------------
22
23 module Main where
24
25 import System.Environment
26 import System.IO
27 import Data.List
28 import System.Exit
29 import Data.Char
30
31 import Compat.RawSystem         ( rawSystem )
32 import Compat.Directory         ( findExecutable )
33
34 main = do 
35   args <- getArgs
36   case args of
37     ('-':'f' : ghc) : filename : args -> do
38         doIt (dropWhile isSpace ghc) filename args
39     filename : args -> do
40         mb_ghc <- findExecutable "ghc"
41         case mb_ghc of
42           Nothing  -> dieProg ("cannot find ghc")
43           Just ghc -> doIt ghc filename args
44     _other -> do
45         dieProg "syntax: runghc [-f GHCPATH] FILE ARG..."
46
47 doIt ghc filename args = do
48   res <- rawSystem ghc ["-ignore-dot-ghci", 
49                         "-e","System.Environment.withProgName "++show filename++" (System.Environment.withArgs ["
50                         ++ concat (intersperse "," (map show args))
51                         ++ "] Main.main)", filename]
52   exitWith res
53
54 dieProg :: String -> IO a
55 dieProg msg = do
56   p <- getProgName
57   hPutStr stderr (p ++ ": " ++ msg)
58   exitWith (ExitFailure 1)