diff options
Diffstat (limited to 'utils/runghc/runghc.hs')
-rw-r--r-- | utils/runghc/runghc.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs new file mode 100644 index 0000000000..f8330b5721 --- /dev/null +++ b/utils/runghc/runghc.hs @@ -0,0 +1,66 @@ +{-# OPTIONS -cpp -fffi #-} +#if __GLASGOW_HASKELL__ < 603 +#include "config.h" +#else +#include "ghcconfig.h" +#endif +----------------------------------------------------------------------------- +-- +-- (c) The University of Glasgow, 2004 +-- +-- runghc program, for invoking from a #! line in a script. For example: +-- +-- script.lhs: +-- #! /usr/bin/runghc +-- > main = putStrLn "hello!" +-- +-- runghc accepts one flag: +-- +-- -f <path> specify the path +-- +-- ----------------------------------------------------------------------------- + +module Main where + +import System.Environment +import System.IO +import Data.List +import System.Exit +import Data.Char + +import Compat.RawSystem ( rawSystem ) +import Compat.Directory ( findExecutable ) + +main = do + args <- getArgs + case args of + ('-':'f' : ghc) : args -> do + doIt (dropWhile isSpace ghc) args + args -> do + mb_ghc <- findExecutable "ghc" + case mb_ghc of + Nothing -> dieProg ("cannot find ghc") + Just ghc -> doIt ghc args + +doIt ghc args = do + let + (ghc_args, rest) = break notArg args + -- + case rest of + [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..." + filename : prog_args -> do + res <- rawSystem ghc ( + "-ignore-dot-ghci" : ghc_args ++ + [ "-e","System.Environment.withProgName "++show filename++" (System.Environment.withArgs [" + ++ concat (intersperse "," (map show prog_args)) + ++ "] Main.main)", filename]) + exitWith res + +notArg ('-':_) = False +notArg _ = True + +dieProg :: String -> IO a +dieProg msg = do + p <- getProgName + hPutStrLn stderr (p ++ ": " ++ msg) + exitWith (ExitFailure 1) |