[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>
 
       <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>
          <term><literal>-t FILE</literal> or
          <literal>&ndash;&ndash;template=FILE</literal></term>
          <listitem>

@@ -251,33 +259,25 @@ tags:
        </varlistentry>
 
        <varlistentry>
        </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>
          <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>
          </listitem>
        </varlistentry>
 
        <varlistentry>

-         <term><literal>&ndash;&ndash;version</literal></term>
+         <term><literal>-?</literal> or <literal>&ndash;&ndash;help</literal></term>

          <listitem>
          <listitem>

-           <para>Output version information.</para>
+           <para>Display a summary of the available flags and exit successfully.</para>

          </listitem>
        </varlistentry>
 
        <varlistentry>
          </listitem>
        </varlistentry>
 
        <varlistentry>

-         <term><literal>&ndash;&ndash;no-compile</literal></term>
+         <term><literal>-V</literal> or <literal>&ndash;&ndash;version</literal></term>

          <listitem>
          <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>
          </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 #-}
 
 ------------------------------------------------------------------------
 {-# 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.
 --
 -- 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
 #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 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"
 
 
 #include "../../includes/config.h"
 

@@ -40,7 +40,7 @@ import CString
 
 
 version :: String
 
 
 version :: String

-version = "hsc2hs-0.65"
+version = "hsc2hs version 0.65\n"

 
 data Flag
     = Help
 
 data Flag
     = Help

@@ -71,26 +71,38 @@ define s = case break (== '=') s of
 
 options :: [OptDescr Flag]
 options = [
 
 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
     
 
 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
 
     args <- getArgs
     let (flags, files, errs) = getOpt Permute options args
 

@@ -114,16 +126,25 @@ main = do
                           return (add_opt flags) 
     case (files, errs) of
         (_, _)
                           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
             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 
 
 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
        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.
 
 ------------------------------------------------------------------------
 -- 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
   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"
 
 outFlagHeaderCProg :: Flag -> String
 outFlagHeaderCProg (Template t)          = "#include \""++t++"\"\n"