[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 (file)
--- a/ghc/docs/users_guide/utils.sgml
+++ b/ghc/docs/users_guide/utils.sgml
@@ -184,6 +184,14 @@ tags:
 
       <variablelist>
        <varlistentry>
+         <term><literal>-o FILE</literal> or
+         <literal>&ndash;&ndash;output=FILE</literal></term>
+         <listitem>
+           <para>Name of the Haskell file.</para>
+         </listitem>
+       </varlistentry>
+
+       <varlistentry>
          <term><literal>-t FILE</literal> or
          <literal>&ndash;&ndash;template=FILE</literal></term>
          <listitem>
@@ -251,33 +259,25 @@ tags:
        </varlistentry>
 
        <varlistentry>
-         <term><literal>-o FILE</literal> or
-         <literal>&ndash;&ndash;output=FILE</literal></term>
-         <listitem>
-           <para>Name of the Haskell file.</para>
-         </listitem>
-       </varlistentry>
-
-       <varlistentry>
-         <term><literal>&ndash;&ndash;help</literal></term>
+         <term><literal>&ndash;&ndash;no-compile</literal></term>
          <listitem>
-           <para>Display a summary of the available flags.</para>
+           <para>Stop after writing out the intermediate C program to disk.
+           The file name for the intermediate C program is the input file name
+           with <literal>.hsc</literal> replaced with <literal>_hsc_make.c</literal>.</para>
          </listitem>
        </varlistentry>
 
        <varlistentry>
-         <term><literal>&ndash;&ndash;version</literal></term>
+         <term><literal>-?</literal> or <literal>&ndash;&ndash;help</literal></term>
          <listitem>
-           <para>Output version information.</para>
+           <para>Display a summary of the available flags and exit successfully.</para>
          </listitem>
        </varlistentry>
 
        <varlistentry>
-         <term><literal>&ndash;&ndash;no-compile</literal></term>
+         <term><literal>-V</literal> or <literal>&ndash;&ndash;version</literal></term>
          <listitem>
-           <para>Stop after writing out the intermediate C program to disk.
-           The file name for the intermediate C program is the input file name
-           with <literal>.hsc</literal> replaced with <literal>_hsc_make.c</literal>.</para>
+           <para>Output version information and exit successfully.</para>
          </listitem>
        </varlistentry>
       </variablelist>

diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs
index 4456ae7..b95c8cb 100644 (file)
--- 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"