From: panne Date: Wed, 27 Aug 2003 14:11:17 +0000 (+0000) Subject: [project @ 2003-08-27 14:11:16 by panne] X-Git-Tag: Approx_11550_changesets_converted~515 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ebeb534bad20646923b4f59085f9cf22ba93fb46;hp=6628972212cd1837f4c6957eec886214325bb1cc;p=ghc-hetmet.git [project @ 2003-08-27 14:11:16 by panne] * Added short option -? for --help and -V for --version. * Small cleanup --- diff --git a/ghc/docs/users_guide/utils.sgml b/ghc/docs/users_guide/utils.sgml index 76a7234..a0769b7 100644 --- a/ghc/docs/users_guide/utils.sgml +++ b/ghc/docs/users_guide/utils.sgml @@ -184,6 +184,14 @@ tags: + -o FILE or + ––output=FILE + + Name of the Haskell file. + + + + -t FILE or ––template=FILE @@ -251,33 +259,25 @@ tags: - -o FILE or - ––output=FILE - - Name of the Haskell file. - - - - - ––help + ––no-compile - Display a summary of the available flags. + Stop after writing out the intermediate C program to disk. + The file name for the intermediate C program is the input file name + with .hsc replaced with _hsc_make.c. - ––version + -? or ––help - Output version information. + Display a summary of the available flags and exit successfully. - ––no-compile + -V or ––version - Stop after writing out the intermediate C program to disk. - The file name for the intermediate C program is the input file name - with .hsc replaced with _hsc_make.c. + Output version information and exit successfully. diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs index 4456ae7..b95c8cb 100644 --- a/ghc/utils/hsc2hs/Main.hs +++ b/ghc/utils/hsc2hs/Main.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------ --- $Id: Main.hs,v 1.47 2003/05/20 11:07:54 stolz Exp $ +-- $Id: Main.hs,v 1.48 2003/08/27 14:11:17 panne Exp $ -- -- Program for converting .hsc files to .hs files, by converting the -- file into a C program which is run to generate the Haskell source. @@ -18,12 +18,12 @@ import GetOpt #endif import Config -import System (getProgName, getArgs, ExitCode(..), exitWith, exitFailure, system) +import System (getProgName, getArgs, ExitCode(..), exitWith, system) import Directory (removeFile,doesFileExist) import Monad (MonadPlus(..), liftM, liftM2, when, unless) import Char (isAlpha, isAlphaNum, isSpace, isDigit, toUpper, intToDigit, ord) -import List (intersperse) -import IO (hPutStrLn,stderr) +import List (intersperse, isSuffixOf) +import IO (hPutStr, hPutStrLn, stderr) #include "../../includes/config.h" @@ -40,7 +40,7 @@ import CString version :: String -version = "hsc2hs-0.65" +version = "hsc2hs version 0.65\n" data Flag = Help @@ -71,26 +71,38 @@ define s = case break (== '=') s of options :: [OptDescr Flag] options = [ - Option "t" ["template"] (ReqArg Template "FILE") "template file", - Option "c" ["cc"] (ReqArg Compiler "PROG") "C compiler to use", - Option "l" ["ld"] (ReqArg Linker "PROG") "linker to use", - Option "C" ["cflag"] (ReqArg CompFlag "FLAG") "flag to pass to the C compiler", - Option "I" [] (ReqArg (CompFlag . ("-I"++)) - "DIR") "passed to the C compiler", - Option "L" ["lflag"] (ReqArg LinkFlag "FLAG") "flag to pass to the linker", - Option "i" ["include"] (ReqArg include "FILE") "as if placed in the source", - Option "D" ["define"] (ReqArg define "NAME[=VALUE]") "as if placed in the source", - Option "o" ["output"] (ReqArg Output "FILE") "name of main output file", - Option "" ["help"] (NoArg Help) "display this help and exit", - Option "v" ["verbose"] (NoArg Verbose) "dump commands to stderr", - Option "" ["version"] (NoArg Version) "output version information and exit", - Option "" ["no-compile"] (NoArg NoCompile) "stop after writing *_hsc_make.c"] + Option ['o'] ["output"] (ReqArg Output "FILE") + "name of main output file", + Option ['t'] ["template"] (ReqArg Template "FILE") + "template file", + Option ['c'] ["cc"] (ReqArg Compiler "PROG") + "C compiler to use", + Option ['l'] ["ld"] (ReqArg Linker "PROG") + "linker to use", + Option ['C'] ["cflag"] (ReqArg CompFlag "FLAG") + "flag to pass to the C compiler", + Option ['I'] [] (ReqArg (CompFlag . ("-I"++)) "DIR") + "passed to the C compiler", + Option ['L'] ["lflag"] (ReqArg LinkFlag "FLAG") + "flag to pass to the linker", + Option ['i'] ["include"] (ReqArg include "FILE") + "as if placed in the source", + Option ['D'] ["define"] (ReqArg define "NAME[=VALUE]") + "as if placed in the source", + Option [] ["no-compile"] (NoArg NoCompile) + "stop after writing *_hsc_make.c", + Option ['v'] ["verbose"] (NoArg Verbose) + "dump commands to stderr", + Option ['?'] ["help"] (NoArg Help) + "display this help and exit", + Option ['V'] ["version"] (NoArg Version) + "output version information and exit" ] main :: IO () main = do - prog <- getProgName - let header = "Usage: "++prog++" [OPTIONS] INPUT.hsc [...]" + prog <- getProgramName + let header = "Usage: "++prog++" [OPTIONS] INPUT.hsc [...]\n" args <- getArgs let (flags, files, errs) = getOpt Permute options args @@ -114,16 +126,25 @@ main = do return (add_opt flags) case (files, errs) of (_, _) - | any isHelp flags_w_tpl -> putStrLn (usageInfo header options) - | any isVersion flags_w_tpl -> putStrLn version + | any isHelp flags_w_tpl -> bye (usageInfo header options) + | any isVersion flags_w_tpl -> bye version where isHelp Help = True; isHelp _ = False isVersion Version = True; isVersion _ = False - ([], []) -> putStrLn (prog++": No input files") - (files, []) -> mapM_ (processFile flags_w_tpl) files - (_, errs) -> do { mapM_ putStrLn errs ; - putStrLn (usageInfo header options) ; - exitFailure } + (files@(_:_), []) -> mapM_ (processFile flags_w_tpl) files + (_, errs) -> die (concat errs ++ usageInfo header options) + +getProgramName :: IO String +getProgramName = liftM (`withoutSuffix` "-bin") getProgName + where str `withoutSuffix` suff + | suff `isSuffixOf` str = take (length str - length suff) str + | otherwise = str + +bye :: String -> IO a +bye s = putStr s >> exitWith ExitSuccess + +die :: String -> IO a +die s = hPutStr stderr s >> exitWith (ExitFailure 1) processFile :: [Flag] -> String -> IO () processFile flags name @@ -132,9 +153,8 @@ processFile flags name case parser of Parser p -> case p (SourcePos file_name 1) s of Success _ _ _ toks -> output flags file_name toks - Failure (SourcePos name' line) msg -> do - putStrLn (name'++":"++show line++": "++msg) - exitFailure + Failure (SourcePos name' line) msg -> + die (name'++":"++show line++": "++msg++"\n") ------------------------------------------------------------------------ -- A deterministic parser which remembers the text which has been parsed. @@ -589,9 +609,7 @@ systemL flg s = do system s onlyOne :: String -> IO a -onlyOne what = do - putStrLn ("Only one "++what++" may be specified") - exitFailure +onlyOne what = die ("Only one "++what++" may be specified\n") outFlagHeaderCProg :: Flag -> String outFlagHeaderCProg (Template t) = "#include \""++t++"\"\n"