Switch to new options handling.

This changes lots of stuff, let me know if it broke anything.

Comments:

- We use a local hacked version of GetOpt that allows long forms of commands to start with a single dash. This breaks other parts of GetOpt. For example, arguments to short options now require a =, and does not allo pace after the option character.

- The new command parsing is currently only used for the program command line, pragmas and the arguments for the 'i' shell command.

- I made a quick hack for the options for showTerm, which currently makes it impossible to use the print style flags for cc. This will be replaced by a facility for parsing command-specific options.

- The verbosity handling is broken in some places. I will fix that in a later patch.

4 files changed, 847 insertions, 374 deletions

diff --git a/src-3.0/GF/Infra/GetOpt.hs b/src-3.0/GF/Infra/GetOpt.hs
new file mode 100644
index 000000000..ede561c90
--- /dev/null
+++ b/src-3.0/GF/Infra/GetOpt.hs
@@ -0,0 +1,381 @@
+-- This is a version of System.Console.GetOpt which has been hacked to
+-- support long options with a single dash. Since we don't want the annoying
+-- clash with short options that start with the same character as a long
+-- one, we don't allow short options to be given together (e.g. -zxf),
+-- nor do we allow options to be given as any unique prefix.
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Console.GetOpt
+-- Copyright   :  (c) Sven Panne 2002-2005
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This library provides facilities for parsing the command-line options
+-- in a standalone program.  It is essentially a Haskell port of the GNU 
+-- @getopt@ library.
+--
+-----------------------------------------------------------------------------
+
+{-
+Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small
+changes Dec. 1997)
+
+Two rather obscure features are missing: The Bash 2.0 non-option hack
+(if you don't already know it, you probably don't want to hear about
+it...) and the recognition of long options with a single dash
+(e.g. '-help' is recognised as '--help', as long as there is no short
+option 'h').
+
+Other differences between GNU's getopt and this implementation:
+
+* To enforce a coherent description of options and arguments, there
+  are explanation fields in the option/argument descriptor.
+
+* Error messages are now more informative, but no longer POSIX
+  compliant... :-(
+
+And a final Haskell advertisement: The GNU C implementation uses well
+over 1100 lines, we need only 195 here, including a 46 line example! 
+:-)
+-}
+
+--module System.Console.GetOpt (
+module GF.Infra.GetOpt (
+   -- * GetOpt
+   getOpt, getOpt',
+   usageInfo,
+   ArgOrder(..),
+   OptDescr(..),
+   ArgDescr(..),
+
+   -- * Examples
+
+   -- |To hopefully illuminate the role of the different data structures,
+   -- here are the command-line options for a (very simple) compiler,
+   -- done in two different ways.
+   -- The difference arises because the type of 'getOpt' is
+   -- parameterized by the type of values derived from flags.
+
+   -- ** Interpreting flags as concrete values
+   -- $example1
+
+   -- ** Interpreting flags as transformations of an options record
+   -- $example2
+) where
+
+import Prelude -- necessary to get dependencies right
+
+import Data.List ( isPrefixOf, find )
+
+-- |What to do with options following non-options
+data ArgOrder a
+  = RequireOrder                -- ^ no option processing after first non-option
+  | Permute                     -- ^ freely intersperse options and non-options
+  | ReturnInOrder (String -> a) -- ^ wrap non-options into options
+
+{-|
+Each 'OptDescr' describes a single option.
+
+The arguments to 'Option' are:
+
+* list of short option characters
+
+* list of long option strings (without \"--\")
+
+* argument descriptor
+
+* explanation of option for user
+-}
+data OptDescr a =              -- description of a single options:
+   Option [Char]                --    list of short option characters
+          [String]              --    list of long option strings (without "--")
+          (ArgDescr a)          --    argument descriptor
+          String                --    explanation of option for user
+
+-- |Describes whether an option takes an argument or not, and if so
+-- how the argument is injected into a value of type @a@.
+data ArgDescr a
+   = NoArg                   a         -- ^   no argument expected
+   | ReqArg (String       -> a) String -- ^   option requires argument
+   | OptArg (Maybe String -> a) String -- ^   optional argument
+
+data OptKind a                -- kind of cmd line arg (internal use only):
+   = Opt       a                --    an option
+   | UnreqOpt  String           --    an un-recognized option
+   | NonOpt    String           --    a non-option
+   | EndOfOpts                  --    end-of-options marker (i.e. "--")
+   | OptErr    String           --    something went wrong...
+
+-- | Return a string describing the usage of a command, derived from
+-- the header (first argument) and the options described by the 
+-- second argument.
+usageInfo :: String                    -- header
+          -> [OptDescr a]              -- option descriptors
+          -> String                    -- nicely formatted decription of options
+usageInfo header optDescr = unlines (header:table)
+   where (ss,ls,ds)     = (unzip3 . concatMap fmtOpt) optDescr
+         table          = zipWith3 paste (sameLen ss) (sameLen ls) ds
+         paste x y z    = "  " ++ x ++ "  " ++ y ++ "  " ++ z
+         sameLen xs     = flushLeft ((maximum . map length) xs) xs
+         flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]
+
+fmtOpt :: OptDescr a -> [(String,String,String)]
+fmtOpt (Option sos los ad descr) =
+   case lines descr of
+     []     -> [(sosFmt,losFmt,"")]
+     (d:ds) ->  (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ]
+   where sepBy _  []     = ""
+         sepBy _  [x]    = x
+         sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs
+         sosFmt = sepBy ',' (map (fmtShort ad) sos)
+         losFmt = sepBy ',' (map (fmtLong  ad) los)
+
+fmtShort :: ArgDescr a -> Char -> String
+fmtShort (NoArg  _   ) so = "-" ++ [so]
+fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad
+fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]"
+
+fmtLong :: ArgDescr a -> String -> String
+fmtLong (NoArg  _   ) lo = "--" ++ lo
+fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad
+fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]"
+
+{-|
+Process the command-line, and return the list of values that matched
+(and those that didn\'t). The arguments are:
+
+* The order requirements (see 'ArgOrder')
+
+* The option descriptions (see 'OptDescr')
+
+* The actual command line arguments (presumably got from 
+  'System.Environment.getArgs').
+
+'getOpt' returns a triple consisting of the option arguments, a list
+of non-options, and a list of error messages.
+-}
+getOpt :: ArgOrder a                   -- non-option handling
+       -> [OptDescr a]                 -- option descriptors
+       -> [String]                     -- the command-line arguments
+       -> ([a],[String],[String])      -- (options,non-options,error messages)
+getOpt ordering optDescr args = (os,xs,es ++ map errUnrec us)
+   where (os,xs,us,es) = getOpt' ordering optDescr args
+
+{-|
+This is almost the same as 'getOpt', but returns a quadruple
+consisting of the option arguments, a list of non-options, a list of
+unrecognized options, and a list of error messages.
+-}
+getOpt' :: ArgOrder a                         -- non-option handling
+        -> [OptDescr a]                       -- option descriptors
+        -> [String]                           -- the command-line arguments
+        -> ([a],[String], [String] ,[String]) -- (options,non-options,unrecognized,error messages)
+getOpt' _        _        []         =  ([],[],[],[])
+getOpt' ordering optDescr (arg:args) = procNextOpt opt ordering
+   where procNextOpt (Opt o)      _                 = (o:os,xs,us,es)
+         procNextOpt (UnreqOpt u) _                 = (os,xs,u:us,es)
+         procNextOpt (NonOpt x)   RequireOrder      = ([],x:rest,[],[])
+         procNextOpt (NonOpt x)   Permute           = (os,x:xs,us,es)
+         procNextOpt (NonOpt x)   (ReturnInOrder f) = (f x :os, xs,us,es)
+         procNextOpt EndOfOpts    RequireOrder      = ([],rest,[],[])
+         procNextOpt EndOfOpts    Permute           = ([],rest,[],[])
+         procNextOpt EndOfOpts    (ReturnInOrder f) = (map f rest,[],[],[])
+         procNextOpt (OptErr e)   _                 = (os,xs,us,e:es)
+
+         (opt,rest) = getNext arg args optDescr
+         (os,xs,us,es) = getOpt' ordering optDescr rest
+
+-- take a look at the next cmd line arg and decide what to do with it
+getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+getNext ('-':'-':[]) rest _        = (EndOfOpts,rest)
+getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr
+getNext ('-'    :xs) rest optDescr = longOpt xs rest optDescr
+getNext a            rest _        = (NonOpt a,rest)
+
+-- handle long option
+longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+longOpt ls rs optDescr = long ads arg rs
+   where (opt,arg) = break (=='=') ls
+         options   = [ o | o@(Option ss xs _ _) <- optDescr
+                         , opt `elem` map (:[]) ss || opt `elem` xs ]
+         ads       = [ ad | Option _ _ ad _ <- options ]
+         optStr    = ("--"++opt)
+
+         long (_:_:_)      _        rest     = (errAmbig options optStr,rest)
+         long [NoArg  a  ] []       rest     = (Opt a,rest)
+         long [NoArg  _  ] ('=':_)  rest     = (errNoArg optStr,rest)
+         long [ReqArg _ d] []       []       = (errReq d optStr,[])
+         long [ReqArg f _] []       (r:rest) = (Opt (f r),rest)
+         long [ReqArg f _] ('=':xs) rest     = (Opt (f xs),rest)
+         long [OptArg f _] []       rest     = (Opt (f Nothing),rest)
+         long [OptArg f _] ('=':xs) rest     = (Opt (f (Just xs)),rest)
+         long _            _        rest     = (UnreqOpt ("--"++ls),rest)
+
+
+-- miscellaneous error formatting
+
+errAmbig :: [OptDescr a] -> String -> OptKind a
+errAmbig ods optStr = OptErr (usageInfo header ods)
+   where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:"
+
+errReq :: String -> String -> OptKind a
+errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n")
+
+errUnrec :: String -> String
+errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n"
+
+errNoArg :: String -> OptKind a
+errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")
+
+{-
+-----------------------------------------------------------------------------------------
+-- and here a small and hopefully enlightening example:
+
+data Flag = Verbose | Version | Name String | Output String | Arg String   deriving Show
+
+options :: [OptDescr Flag]
+options =
+   [Option ['v']     ["verbose"]           (NoArg Verbose)      "verbosely list files",
+    Option ['V','?'] ["version","release"] (NoArg Version)      "show version info",
+    Option ['o']     ["output"]            (OptArg out "FILE")  "use FILE for dump",
+    Option ['n']     ["name"]              (ReqArg Name "USER") "only dump USER's files"]
+
+out :: Maybe String -> Flag
+out Nothing  = Output "stdout"
+out (Just o) = Output o
+
+test :: ArgOrder Flag -> [String] -> String
+test order cmdline = case getOpt order options cmdline of
+                        (o,n,[]  ) -> "options=" ++ show o ++ "  args=" ++ show n ++ "\n"
+                        (_,_,errs) -> concat errs ++ usageInfo header options
+   where header = "Usage: foobar [OPTION...] files..."
+
+-- example runs:
+-- putStr (test RequireOrder ["foo","-v"])
+--    ==> options=[]  args=["foo", "-v"]
+-- putStr (test Permute ["foo","-v"])
+--    ==> options=[Verbose]  args=["foo"]
+-- putStr (test (ReturnInOrder Arg) ["foo","-v"])
+--    ==> options=[Arg "foo", Verbose]  args=[]
+-- putStr (test Permute ["foo","--","-v"])
+--    ==> options=[]  args=["foo", "-v"]
+-- putStr (test Permute ["-?o","--name","bar","--na=baz"])
+--    ==> options=[Version, Output "stdout", Name "bar", Name "baz"]  args=[]
+-- putStr (test Permute ["--ver","foo"])
+--    ==> option `--ver' is ambiguous; could be one of:
+--          -v      --verbose             verbosely list files
+--          -V, -?  --version, --release  show version info   
+--        Usage: foobar [OPTION...] files...
+--          -v        --verbose             verbosely list files  
+--          -V, -?    --version, --release  show version info     
+--          -o[FILE]  --output[=FILE]       use FILE for dump     
+--          -n USER   --name=USER           only dump USER's files
+-----------------------------------------------------------------------------------------
+-}
+
+{- $example1
+
+A simple choice for the type associated with flags is to define a type
+@Flag@ as an algebraic type representing the possible flags and their
+arguments:
+
+>    module Opts1 where
+>    
+>    import System.Console.GetOpt
+>    import Data.Maybe ( fromMaybe )
+>    
+>    data Flag 
+>     = Verbose  | Version 
+>     | Input String | Output String | LibDir String
+>       deriving Show
+>    
+>    options :: [OptDescr Flag]
+>    options =
+>     [ Option ['v']     ["verbose"] (NoArg Verbose)       "chatty output on stderr"
+>     , Option ['V','?'] ["version"] (NoArg Version)       "show version number"
+>     , Option ['o']     ["output"]  (OptArg outp "FILE")  "output FILE"
+>     , Option ['c']     []          (OptArg inp  "FILE")  "input FILE"
+>     , Option ['L']     ["libdir"]  (ReqArg LibDir "DIR") "library directory"
+>     ]
+>    
+>    inp,outp :: Maybe String -> Flag
+>    outp = Output . fromMaybe "stdout"
+>    inp  = Input  . fromMaybe "stdin"
+>    
+>    compilerOpts :: [String] -> IO ([Flag], [String])
+>    compilerOpts argv = 
+>       case getOpt Permute options argv of
+>          (o,n,[]  ) -> return (o,n)
+>          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+>      where header = "Usage: ic [OPTION...] files..."
+
+Then the rest of the program will use the constructed list of flags
+to determine it\'s behaviour.
+
+-}
+
+{- $example2
+
+A different approach is to group the option values in a record of type
+@Options@, and have each flag yield a function of type
+@Options -> Options@ transforming this record.
+
+>    module Opts2 where
+>
+>    import System.Console.GetOpt
+>    import Data.Maybe ( fromMaybe )
+>
+>    data Options = Options
+>     { optVerbose     :: Bool
+>     , optShowVersion :: Bool
+>     , optOutput      :: Maybe FilePath
+>     , optInput       :: Maybe FilePath
+>     , optLibDirs     :: [FilePath]
+>     } deriving Show
+>
+>    defaultOptions    = Options
+>     { optVerbose     = False
+>     , optShowVersion = False
+>     , optOutput      = Nothing
+>     , optInput       = Nothing
+>     , optLibDirs     = []
+>     }
+>
+>    options :: [OptDescr (Options -> Options)]
+>    options =
+>     [ Option ['v']     ["verbose"]
+>         (NoArg (\ opts -> opts { optVerbose = True }))
+>         "chatty output on stderr"
+>     , Option ['V','?'] ["version"]
+>         (NoArg (\ opts -> opts { optShowVersion = True }))
+>         "show version number"
+>     , Option ['o']     ["output"]
+>         (OptArg ((\ f opts -> opts { optOutput = Just f }) . fromMaybe "output")
+>                 "FILE")
+>         "output FILE"
+>     , Option ['c']     []
+>         (OptArg ((\ f opts -> opts { optInput = Just f }) . fromMaybe "input")
+>                 "FILE")
+>         "input FILE"
+>     , Option ['L']     ["libdir"]
+>         (ReqArg (\ d opts -> opts { optLibDirs = optLibDirs opts ++ [d] }) "DIR")
+>         "library directory"
+>     ]
+>
+>    compilerOpts :: [String] -> IO (Options, [String])
+>    compilerOpts argv =
+>       case getOpt Permute options argv of
+>          (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)
+>          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+>      where header = "Usage: ic [OPTION...] files..."
+
+Similarly, each flag could yield a monadic function transforming a record,
+of type @Options -> IO Options@ (or any other monad), allowing option
+processing to perform actions of the chosen monad, e.g. printing help or
+version messages, checking that file arguments exist, etc.
+
+-}
diff --git a/src-3.0/GF/Infra/Modules.hs b/src-3.0/GF/Infra/Modules.hs
index 17a304a6f..8f9edbc68 100644
--- a/src-3.0/GF/Infra/Modules.hs
+++ b/src-3.0/GF/Infra/Modules.hs
@@ -65,7 +65,7 @@ data ModInfo i a =
 data Module i a = Module {
     mtype   :: ModuleType i ,
     mstatus :: ModuleStatus ,
-    flags   :: [Option] ,
+    flags   :: ModuleOptions,
     extend  :: [(i,MInclude i)],
     opens   :: [OpenSpec i] ,
     jments  :: BinTree i a
@@ -126,16 +126,16 @@ addOpenQualif :: i -> i -> Module i t -> Module i t
 addOpenQualif i j (Module mt ms fs me ops js) = 
   Module mt ms fs me (oQualif i j : ops) js
 
-addFlag :: Option -> Module i t -> Module i t
-addFlag f mo = mo {flags = f : flags mo} 
+addFlag :: ModuleOptions -> Module i t -> Module i t
+addFlag f mo = mo {flags = addModuleOptions (flags mo) f} 
 
-flagsModule :: (i,ModInfo i a) -> [Option]
+flagsModule :: (i,ModInfo i a) -> ModuleOptions
 flagsModule (_,mi) = case mi of
   ModMod m -> flags m
-  _ -> []
+  _ -> noModuleOptions
 
-allFlags :: MGrammar i a -> [Option]
-allFlags gr = concat $ map flags $ [m | (_, ModMod m) <- modules gr]
+allFlags :: MGrammar i a -> ModuleOptions
+allFlags gr = concatModuleOptions $ map flags $ [m | (_, ModMod m) <- modules gr]
 
 mapModules :: (Module i a -> Module i a) 
 	   -> MGrammar i a -> MGrammar i a 
@@ -267,7 +267,7 @@ emptyModInfo :: ModInfo i a
 emptyModInfo = ModMod emptyModule
 
 emptyModule :: Module i a
-emptyModule = Module MTResource MSComplete [] [] [] emptyBinTree
+emptyModule = Module MTResource MSComplete noModuleOptions [] [] emptyBinTree
 
 -- | we store the module type with the identifier
 data IdentM i = IdentM {
diff --git a/src-3.0/GF/Infra/Option.hs b/src-3.0/GF/Infra/Option.hs
index a44cd9db8..dc795e597 100644
--- a/src-3.0/GF/Infra/Option.hs
+++ b/src-3.0/GF/Infra/Option.hs
@@ -1,375 +1,464 @@
-----------------------------------------------------------------------
--- |
--- Module      : Option
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/14 16:03:41 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.34 $
---
--- Options and flags used in GF shell commands and files.
---
--- The types 'Option' and 'Options' should be kept abstract, but:
---
---   - The constructor 'Opt' is used in "ShellCommands" and "GrammarToSource"
---
---   - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
------------------------------------------------------------------------------
-
-module GF.Infra.Option where
-
-import Data.List (partition)
-import Data.Char (isDigit)
-
--- * all kinds of options, to be kept abstract
-
-newtype Option = Opt (String,[String]) deriving (Eq,Show,Read)
-newtype Options = Opts [Option] deriving (Eq,Show,Read)
+module GF.Infra.Option
+    (
+     -- * Option types
+     Options, ModuleOptions,
+     Flags(..), ModuleFlags(..),
+     Mode(..), Phase(..), Encoding(..), OutputFormat(..), Optimization(..),
+     Dump(..), Printer(..), Recomp(..),
+     -- * Option parsing 
+     parseOptions, parseModuleOptions,
+     -- * Option pretty-printing
+     moduleOptionsGFO,
+     -- * Option manipulation
+     addOptions, concatOptions, noOptions,
+     moduleOptions,
+     addModuleOptions, concatModuleOptions, noModuleOptions,
+     helpMessage,
+     -- * Checking options
+     flag, moduleFlag,
+     -- * Convenience methods for checking options    
+     beVerbose, beSilent,
+     dump
+    ) where
+
+import Control.Monad
+import Data.Char (toLower)
+import Data.List
+import Data.Maybe
+import GF.Infra.GetOpt
+--import System.Console.GetOpt
+import System.FilePath
+
+import GF.Data.ErrM
+
+
+
+
+usageHeader :: String
+usageHeader = unlines 
+ ["Usage: gfc [OPTIONS] [FILE [...]]",
+  "",
+  "How each FILE is handled depends on the file name suffix:",
+  "",
+  ".gf Normal or old GF source, will be compiled.",
+  ".gfo Compiled GF source, will be loaded as is.",
+  ".gfe Example-based GF source, will be converted to .gf and compiled.",
+  ".ebnf Extended BNF format, will be converted to .gf and compiled.",
+  ".cf Context-free (BNF) format, will be converted to .gf and compiled.",
+  "",
+  "If multiple FILES are given, they must be normal GF source, .gfo or .gfe files.",
+  "For the other input formats, only one file can be given.",
+  "",
+  "Command-line options:"]
+
+
+helpMessage :: String
+helpMessage = usageInfo usageHeader optDescr
+
+
+-- FIXME: do we really want multi-line errors?
+errors :: [String] -> Err a
+errors = fail . unlines
+
+-- Types
+
+data Mode = ModeVersion | ModeHelp | ModeInteractive | ModeCompiler
+  deriving (Show,Eq,Ord)
+
+data Phase = Preproc | Convert | Compile | Link
+  deriving (Show,Eq,Ord)
+
+data Encoding = UTF_8 | ISO_8859_1
+  deriving (Show,Eq,Ord)
+
+data OutputFormat = FmtGFCC | FmtJavaScript | FmtHaskell | FmtHaskellGADT
+  deriving (Eq,Ord)
+
+data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
+  deriving (Show,Eq,Ord)
+
+data Warning = WarnMissingLincat
+  deriving (Show,Eq,Ord)
+
+data Dump = DumpRebuild | DumpExtend | DumpRename | DumpTypeCheck | DumpRefresh | DumpOptimize | DumpCanon
+  deriving (Show,Eq,Ord)
+
+-- | Pretty-printing options
+data Printer = PrinterStrip -- ^ Remove name qualifiers.
+  deriving (Show,Eq,Ord)
+
+data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp
+  deriving (Show,Eq,Ord)
+
+data ModuleFlags = ModuleFlags {
+      optName            :: Maybe String,
+      optAbsName         :: Maybe String,
+      optCncName         :: Maybe String,
+      optResName         :: Maybe String,
+      optPreprocessors   :: [String],
+      optEncoding        :: Encoding,
+      optOptimizations   :: [Optimization],
+      optLibraryPath     :: [FilePath],
+      optStartCat        :: Maybe String,
+      optSpeechLanguage  :: Maybe String,
+      optLexer           :: Maybe String,
+      optUnlexer         :: Maybe String,
+      optBuildParser     :: Bool,
+      optWarnings        :: [Warning],
+      optDump            :: [Dump]
+    }
+  deriving (Show)
+
+data Flags = Flags {
+      optMode            :: Mode,
+      optStopAfterPhase  :: Phase,
+      optVerbosity       :: Int,
+      optShowCPUTime     :: Bool,
+      optEmitGFO         :: Bool,
+      optGFODir          :: FilePath,
+      optOutputFormats   :: [OutputFormat],
+      optOutputFile      :: Maybe FilePath,
+      optOutputDir       :: Maybe FilePath,
+      optRecomp          :: Recomp,
+      optPrinter         :: [Printer],
+      optProb            :: Bool,
+      optRetainResource  :: Bool,
+      optModuleFlags     :: ModuleFlags
+    }
+  deriving (Show)
+
+newtype Options = Options (Flags -> Flags)
+
+instance Show Options where
+    show (Options o) = show (o defaultFlags)
+
+newtype ModuleOptions = ModuleOptions (ModuleFlags -> ModuleFlags)
+
+-- Option parsing
+
+parseOptions :: [String] -> Err (Options, [FilePath])
+parseOptions args 
+    | not (null errs) = errors errs
+    | otherwise = do opts <- liftM concatOptions $ sequence optss
+                     return (opts, files)
+  where (optss, files, errs) = getOpt RequireOrder optDescr args
+
+parseModuleOptions :: [String] -> Err ModuleOptions
+parseModuleOptions args 
+    | not (null errs)  = errors errs
+    | not (null files) = errors $ map ("Non-option among module options: " ++) files
+    | otherwise        = liftM concatModuleOptions $ sequence flags
+  where (flags, files, errs) = getOpt RequireOrder moduleOptDescr args
+
+-- Showing options
+
+-- | Pretty-print the module options that are preserved in .gfo files.
+moduleOptionsGFO :: ModuleOptions -> [(String,String)]
+moduleOptionsGFO (ModuleOptions o) = 
+      maybe [] (\l -> [("language",l)]) (optSpeechLanguage mfs)
+  where mfs = o defaultModuleFlags
+
+
+-- Option manipulation
 
 noOptions :: Options
-noOptions = Opts []
-
--- | simple option -o
-iOpt :: String -> Option
-iOpt o = Opt (o,[])   
-
--- | option with argument -o=a
-aOpt :: String -> String -> Option
-aOpt o a = Opt (o,[a])  
-
-iOpts :: [Option] -> Options
-iOpts = Opts
-
--- | value of option argument
-oArg :: String -> String
-oArg s = s 
-
-oElem :: Option -> Options -> Bool
-oElem o (Opts os) = elem o os
-
-eqOpt :: String -> Option -> Bool
-eqOpt s (Opt (o, [])) = s == o
-eqOpt s _ = False
-
-type OptFun = String -> Option
-type OptFunId = String
-
-getOptVal :: Options -> OptFun -> Maybe String
-getOptVal (Opts os) fopt = 
-  case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
-    a:_ -> Just a
-    _ -> Nothing
+noOptions = Options id
 
-isSetFlag :: Options -> OptFun -> Bool
-isSetFlag (Opts os) fopt = 
-  case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
-    a:_ -> True
-    _ -> False
-
-getOptInt :: Options -> OptFun -> Maybe Int
-getOptInt opts f = do
-  s <- getOptVal opts f
-  if (not (null s) && all isDigit s) then return (read s) else Nothing 
-
-optIntOrAll :: Options -> OptFun -> [a] -> [a]
-optIntOrAll opts f = case getOptInt opts f of
-  Just i -> take i
-  _ -> id
-
-optIntOrN :: Options -> OptFun -> Int -> Int
-optIntOrN opts f n = case getOptInt opts f of
-  Just i -> i
-  _ -> n
-
-optIntOrOne :: Options -> OptFun -> Int
-optIntOrOne opts f = optIntOrN opts f 1
-
-changeOptVal :: Options -> OptFun -> String -> Options
-changeOptVal os f x = 
-  addOption (f x) $ maybe os (\y -> removeOption (f y) os) $ getOptVal os f
-
-addOption :: Option -> Options -> Options
-addOption o (Opts os) = iOpts (o:os)
-
-addOptions :: Options -> Options -> Options
-addOptions (Opts os) os0 = foldr addOption os0 os
+addOptions :: Options -- ^ Existing options.
+           -> Options -- ^ Options to add (these take preference).
+           -> Options
+addOptions (Options o1) (Options o2) = Options (o2 . o1)
 
 concatOptions :: [Options] -> Options
 concatOptions = foldr addOptions noOptions
 
-removeOption :: Option -> Options -> Options
-removeOption o (Opts os) = iOpts (filter (/=o) os)
-
-removeOptions :: Options -> Options -> Options
-removeOptions (Opts os) os0 = foldr removeOption os0 os
+moduleOptions :: ModuleOptions -> Options
+moduleOptions (ModuleOptions f) = Options (\o -> o { optModuleFlags = f (optModuleFlags o) })
 
-options :: [Option] -> Options
-options = foldr addOption noOptions
+addModuleOptions :: ModuleOptions -- ^ Existing options.
+                 -> ModuleOptions -- ^ Options to add (these take preference).
+                 -> ModuleOptions
+addModuleOptions (ModuleOptions o1) (ModuleOptions o2) = ModuleOptions (o2 . o1)
 
-unionOptions :: Options -> Options -> Options
-unionOptions (Opts os) (Opts os') = Opts (os ++ os')
+concatModuleOptions :: [ModuleOptions] -> ModuleOptions
+concatModuleOptions = foldr addModuleOptions noModuleOptions
 
--- * parsing options, with prefix pre (e.g. \"-\")
+noModuleOptions :: ModuleOptions
+noModuleOptions = ModuleOptions id
 
-getOptions :: String -> [String] -> (Options, [String])
-getOptions pre inp = let
-  (os,rest) = span (isOption pre) inp -- options before args
-  in
-  (Opts (map (pOption pre) os), rest)
+flag :: (Flags -> a) -> Options -> a
+flag f (Options o) = f (o defaultFlags)
 
-pOption :: String -> String -> Option
-pOption pre s = case span (/= '=') (drop (length pre) s) of
-  (f,_:a) -> aOpt f a
-  (o,[])  -> iOpt o
+moduleFlag :: (ModuleFlags -> a) -> Options -> a
+moduleFlag f = flag (f . optModuleFlags)
 
-isOption :: String -> String -> Bool
-isOption pre = (==pre) . take (length pre)
 
--- * printing options, without prefix
-
-prOpt :: Option -> String
-prOpt (Opt (s,[])) = s
-prOpt (Opt (s,xs)) = s ++ "=" ++ concat xs
-
-prOpts :: Options -> String
-prOpts (Opts os) = unwords $ map prOpt os
-
--- * a suggestion for option names
+{-
 
--- ** parsing
+parseModuleFlags :: Options -> [(String,Maybe String)] -> Err ModuleOptions
+parseModuleFlags opts flags = 
+    mapM (uncurry (findFlag moduleOptDescr)) flags >>= foldM (flip ($)) (optModuleOptions opts)
+
+findFlag :: Monad m => [OptDescr a] -> String -> Maybe String -> m a
+findFlag opts n mv = 
+    case filter (`flagMatches` n) opts of
+      []    -> fail $ "Unknown option: " ++ n
+      [opt] -> flagValue opt n mv
+      _     -> fail $ n ++ " matches multiple options."
+
+flagMatches :: OptDescr a -> String -> Bool
+flagMatches (Option cs ss _ _) n = n `elem` (map (:[]) cs ++ ss)
+
+flagValue :: Monad m => OptDescr a -> String -> Maybe String -> m a
+flagValue (Option _ _ arg _) n mv =
+    case (arg, mv) of
+      (NoArg x,    Nothing) -> return x
+      (NoArg _,    Just _ ) -> fail $ "Option " ++ n ++ " does not take a value."
+      (ReqArg _ _, Nothing) -> fail $ "Option " ++ n ++ " requires a value."
+      (ReqArg f _, Just x ) -> return (f x)
+      (OptArg f _, mx     ) -> return (f mx)
 
-strictParse, forgiveParse, ignoreParse, literalParse, rawParse, firstParse :: Option
--- | parse as term instead of string
-dontParse :: Option
+-}
 
-strictParse  = iOpt "strict"
-forgiveParse = iOpt "n"
-ignoreParse  = iOpt "ign"
-literalParse = iOpt "lit"
-rawParse     = iOpt "raw"
-firstParse   = iOpt "1"
-dontParse    = iOpt "read" 
+-- Default options
+
+defaultModuleFlags :: ModuleFlags
+defaultModuleFlags = ModuleFlags {
+      optName            = Nothing,
+      optAbsName         = Nothing,
+      optCncName         = Nothing,
+      optResName         = Nothing,
+      optPreprocessors   = [],
+      optEncoding        = ISO_8859_1,
+      optOptimizations   = [OptStem,OptCSE,OptExpand,OptParametrize,OptValues],
+      optLibraryPath     = [],
+      optStartCat        = Nothing,
+      optSpeechLanguage  = Nothing,
+      optLexer           = Nothing,
+      optUnlexer         = Nothing,
+      optBuildParser     = True,
+      optWarnings        = [],
+      optDump            = []
+    }
+
+defaultFlags :: Flags
+defaultFlags = Flags {
+      optMode            = ModeInteractive,
+      optStopAfterPhase  = Compile,
+      optVerbosity       = 1,
+      optShowCPUTime     = False,
+      optEmitGFO         = True,
+      optGFODir          = ".",
+      optOutputFormats   = [FmtGFCC],
+      optOutputFile      = Nothing,
+      optOutputDir       = Nothing,
+      optRecomp          = RecompIfNewer,
+      optPrinter         = [],
+      optProb            = False,
+      optRetainResource  = False,
+      optModuleFlags     = defaultModuleFlags
+    }
+
+-- Option descriptions
+
+moduleOptDescr :: [OptDescr (Err ModuleOptions)]
+moduleOptDescr = 
+    [
+     Option ['n'] ["name"] (ReqArg name "NAME") 
+           (unlines ["Use NAME as the name of the output. This is used in the output file names, ",
+                     "with suffixes depending on the formats, and, when relevant, ",
+                     "internally in the output."]),
+     Option [] ["abs"] (ReqArg absName "NAME")
+            ("Use NAME as the name of the abstract syntax module generated from "
+             ++ "a grammar in GF 1 format."),
+     Option [] ["cnc"] (ReqArg cncName "NAME")
+            ("Use NAME as the name of the concrete syntax module generated from "
+             ++ "a grammar in GF 1 format."),
+     Option [] ["res"] (ReqArg resName "NAME")
+            ("Use NAME as the name of the resource module generated from "
+             ++ "a grammar in GF 1 format."),
+     Option ['i'] [] (ReqArg addLibDir "DIR") "Add DIR to the library search path.",
+     Option [] ["path"] (ReqArg setLibPath "DIR:DIR:...") "Set the library search path.",
+     Option [] ["preproc"] (ReqArg preproc "CMD") 
+                 (unlines ["Use CMD to preprocess input files.",
+                           "Multiple preprocessors can be used by giving this option multiple times."]),
+     Option [] ["coding"] (ReqArg coding "ENCODING") 
+                ("Character encoding of the source grammar, ENCODING = "
+                 ++ concat (intersperse " | " (map fst encodings)) ++ "."),
+     Option [] ["parser"] (onOff parser True) "Build parser (default on).",
+     Option [] ["startcat"] (ReqArg startcat "CAT") "Grammar start category.",
+     Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar.",
+     Option [] ["lexer"] (ReqArg lexer "LEXER") "Use lexer LEXER.",
+     Option [] ["unlexer"] (ReqArg unlexer "UNLEXER") "Use unlexer UNLEXER.",
+     Option [] ["optimize"] (ReqArg optimize "OPT") 
+                "Select an optimization package. OPT = all | values | parametrize | none",
+     Option [] ["stem"] (onOff (toggleOptimize OptStem) True) "Perform stem-suffix analysis (default on).",
+     Option [] ["cse"] (onOff (toggleOptimize OptCSE) True) "Perform common sub-expression elimination (default on).",
+     dumpOption "rebuild" DumpRebuild,
+     dumpOption "extend" DumpExtend,
+     dumpOption "rename" DumpRename,
+     dumpOption "tc" DumpTypeCheck,
+     dumpOption "refresh" DumpRefresh,
+     dumpOption "opt" DumpOptimize,
+     dumpOption "canon" DumpCanon
+    ]
+    where
+       name        x = set $ \o -> o { optName = Just x }
+       absName     x = set $ \o -> o { optAbsName = Just x }
+       cncName     x = set $ \o -> o { optCncName = Just x }
+       resName     x = set $ \o -> o { optResName = Just x }
+       addLibDir   x = set $ \o -> o { optLibraryPath = x:optLibraryPath o }
+       setLibPath  x = set $ \o -> o { optLibraryPath = splitInModuleSearchPath x }
+       preproc     x = set $ \o -> o { optPreprocessors = optPreprocessors o ++ [x] }
+       coding      x = case lookup x encodings of
+                         Just c  -> set $ \o -> o { optEncoding = c }
+                         Nothing -> fail $ "Unknown character encoding: " ++ x
+       parser      x = set $ \o -> o { optBuildParser = x }
+       startcat    x = set $ \o -> o { optStartCat = Just x }
+       language    x = set $ \o -> o { optSpeechLanguage = Just x }
+       lexer       x = set $ \o -> o { optLexer = Just x }
+       unlexer     x = set $ \o -> o { optUnlexer = Just x }
+
+       optimize    x = case lookup x optimizationPackages of
+                         Just p  -> set $ \o -> o { optOptimizations = p }
+                         Nothing -> fail $ "Unknown optimization package: " ++ x
+
+       toggleOptimize x b = set $ \o -> o { optOptimizations = (if b then (x:) else delete x) (optOptimizations o) }
+
+       dumpOption s d = Option [] ["dump-"++s] (NoArg (set $ \o -> o { optDump = d:optDump o})) ("Dump output of the " ++ s ++ " phase.")
+
+       set = return . ModuleOptions
+
+optDescr :: [OptDescr (Err Options)]
+optDescr = 
+    [
+     Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.",
+     Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.",
+     Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 3.",
+     Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
+     Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.",
+     Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",
+     Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).",
+     Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.",
+     Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .",
+     Option [] ["make"] (NoArg (phase Link)) "Build .gfcc file and other output files.",
+     Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.",
+     Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).",
+     Option [] ["emit-gfo"] (NoArg (emitGFO True)) "Create .gfo files (default).",
+     Option [] ["no-emit-gfo"] (NoArg (emitGFO False)) "Do not create .gfo files.",
+     Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').",
+     Option ['f'] ["output-format"] (ReqArg outFmt "FMT") 
+        (unlines ["Output format. FMT can be one of:",
+                  "Multiple concrete: gfcc (default), gar, js, ...",
+                  "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...",
+                  "Abstract only: haskell, ..."]),
+     Option ['o'] ["output-file"] (ReqArg outFile "FILE") 
+           "Save output in FILE (default is out.X, where X depends on output format.",
+     Option ['D'] ["output-dir"] (ReqArg outDir "DIR") 
+           "Save output files (other than .gfc files) in DIR.",
+     Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp)) 
+                 "Always recompile from source.",
+     Option [] ["gfo","recomp-if-newer"] (NoArg (recomp RecompIfNewer)) 
+                 "(default) Recompile from source if the source is newer than the .gfo file.",
+     Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp)) 
+                 "Never recompile from source, if there is already .gfo file.",
+     Option [] ["strip"] (NoArg (printer PrinterStrip))
+                 "Remove name qualifiers when pretty-printing.",
+     Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.",
+     Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas."
+    ] ++ map (fmap (liftM moduleOptions)) moduleOptDescr
+ where phase       x = set $ \o -> o { optStopAfterPhase = x }
+       mode        x = set $ \o -> o { optMode = x }
+       verbosity mv  = case mv of
+                           Nothing -> set $ \o -> o { optVerbosity = 3 }
+                           Just v  -> case reads v of
+                                        [(i,"")] | i >= 0 -> set $ \o -> o { optVerbosity = i }
+                                        _        -> fail $ "Bad verbosity: " ++ show v
+       cpu         x = set $ \o -> o { optShowCPUTime = x }
+       emitGFO     x = set $ \o -> o { optEmitGFO = x }
+       gfoDir      x = set $ \o -> o { optGFODir = x }
+       outFmt      x = readOutputFormat x >>= \f ->
+                         set $ \o -> o { optOutputFormats = optOutputFormats o ++ [f] }
+       outFile     x = set $ \o -> o { optOutputFile = Just x }
+       outDir      x = set $ \o -> o { optOutputDir = Just x }
+       recomp      x = set $ \o -> o { optRecomp = x }
+       printer     x = set $ \o -> o { optPrinter = x : optPrinter o }
+       prob        x = set $ \o -> o { optProb = x }
+
+       set = return . Options
+
+instance Functor OptDescr where
+    fmap f (Option cs ss d s) = Option cs ss (fmap f d) s
+
+instance Functor ArgDescr where
+    fmap f (NoArg x)    = NoArg (f x)
+    fmap f (ReqArg g s) = ReqArg (f . g) s
+    fmap f (OptArg g s) = OptArg (f . g) s
+
+outputFormats :: [(String,OutputFormat)]
+outputFormats = 
+    [("gfcc",         FmtGFCC),
+     ("js",           FmtJavaScript),
+     ("haskell",      FmtHaskell),
+     ("haskell_gadt", FmtHaskellGADT)]
+
+instance Show OutputFormat where
+    show = lookupShow outputFormats
+
+instance Read OutputFormat where
+    readsPrec = lookupReadsPrec outputFormats
+
+optimizationPackages :: [(String,[Optimization])]
+optimizationPackages = 
+    [("all_subs",    [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]), -- deprecated
+     ("all",         [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]),
+     ("values",      [OptStem,OptCSE,OptExpand,OptValues]),
+     ("parametrize", [OptStem,OptCSE,OptExpand,OptParametrize]),
+     ("none",        [OptStem,OptCSE,OptExpand]),
+     ("noexpand",    [OptStem,OptCSE])]
+
+encodings :: [(String,Encoding)]
+encodings = 
+    [("utf8",   UTF_8),
+     ("latin1", ISO_8859_1)]
+
+lookupShow :: Eq a => [(String,a)] -> a -> String
+lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs]
+
+lookupReadsPrec :: [(String,a)] -> Int -> ReadS a
+lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x]
+
+onOff :: Monad m => (Bool -> m a) -> Bool -> ArgDescr (m a)
+onOff f def = OptArg g "[on,off]"
+  where g ma = maybe (return def) readOnOff ma >>= f
+        readOnOff x = case map toLower x of
+                        "on"  -> return True
+                        "off" -> return False
+                        _     -> fail $ "Expected [on,off], got: " ++ show x
+
+readOutputFormat :: Monad m => String -> m OutputFormat
+readOutputFormat s = 
+    maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats
+
+-- FIXME: this is a copy of the function in GF.Devel.UseIO.
+splitInModuleSearchPath :: String -> [FilePath]
+splitInModuleSearchPath s = case break isPathSep s of
+  (f,_:cs) -> f : splitInModuleSearchPath cs
+  (f,_)    -> [f]
+  where
+    isPathSep :: Char -> Bool
+    isPathSep c = c == ':' || c == ';'
+
+-- 
+-- * Convenience functions for checking options
+--
 
-newParser, newerParser, newCParser, newMParser :: Option
-newParser   = iOpt "new"
-newerParser = iOpt "newer"
-newCParser  = iOpt "cfg"
-newMParser  = iOpt "mcfg"
-newFParser  = iOpt "fcfg"
+beVerbose :: Options -> Bool
+beVerbose = flag ((>= 3) . optVerbosity)
 
-{-
-useParserMCFG, useParserMCFGviaCFG, useParserCFG, useParserCF :: Option
+beSilent :: Options -> Bool
+beSilent = flag ((<= 0) . optVerbosity)
 
-useParserMCFG = iOpt "mcfg"
-useParserMCFGviaCFG = iOpt "mcfg-via-cfg"
-useParserCFG = iOpt "cfg"
-useParserCF = iOpt "cf"
--}
+dump :: Options -> Dump -> Bool
+dump opts d = moduleFlag ((d `elem`) . optDump) opts
 
--- ** grammar formats
-
-showAbstr, showXML, showOld, showLatex, showFullForm,
-  showEBNF, showCF, showWords, showOpts,
-  isCompiled, isHaskell, noCompOpers, retainOpers,
-  noCF, checkCirc, noCheckCirc, lexerByNeed, useUTF8id :: Option
-defaultGrOpts :: [Option]
-
-showAbstr   = iOpt "abs"
-showXML     = iOpt "xml"
-showOld     = iOpt "old"
-showLatex   = iOpt "latex"
-showFullForm = iOpt "fullform" 
-showEBNF    = iOpt "ebnf"
-showCF      = iOpt "cf"
-showWords   = iOpt "ws"
-showOpts    = iOpt "opts"
--- showOptim   = iOpt "opt"
-isCompiled  = iOpt "gfc"
-isHaskell   = iOpt "gfhs"
-noCompOpers = iOpt "nocomp"
-retainOpers = iOpt "retain"
-defaultGrOpts = []
-noCF        = iOpt "nocf"
-checkCirc   = iOpt "nocirc"
-noCheckCirc = iOpt "nocheckcirc"
-lexerByNeed = iOpt "cflexer"
-useUTF8id   = iOpt "utf8id"
-elimSubs    = iOpt "subs"
-
--- ** linearization
-
-allLin, firstLin, distinctLin, dontLin,
-  showRecord, showStruct, xmlLin, latexLin,
-  tableLin, useUTF8, showLang, withMetas :: Option
-defaultLinOpts :: [Option]
-
-allLin      = iOpt "all"
-firstLin    = iOpt "one"
-distinctLin = iOpt "nub"
-dontLin     = iOpt "show"
-showRecord  = iOpt "record"
-showStruct  = iOpt "structured"
-xmlLin      = showXML
-latexLin    = showLatex
-tableLin    = iOpt "table"
-defaultLinOpts = [firstLin]
-useUTF8     = iOpt "utf8"
-showLang    = iOpt "lang"
-showDefs    = iOpt "defs"
-withMetas   = iOpt "metas"
-
--- ** other
-
-beVerbose, showInfo, beSilent, emitCode, getHelp,
-  doMake, doBatch, notEmitCode, makeMulti, beShort,
-  wholeGrammar, makeFudget, byLines, byWords, analMorpho,
-  doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
-  stripQualif, nostripQualif, showAll, fromSource :: Option
-
-beVerbose    = iOpt "v"
-invertGrep   = iOpt "v" --- same letter in unix
-showInfo     = iOpt "i"
-beSilent     = iOpt "s"
-emitCode     = iOpt "o"
-getHelp      = iOpt "help"
-doMake       = iOpt "make"
-doBatch      = iOpt "batch"
-notEmitCode  = iOpt "noemit"
-makeMulti    = iOpt "multi"
-beShort      = iOpt "short"
-wholeGrammar = iOpt "w"
-makeFudget   = iOpt "f"
-byLines      = iOpt "lines"
-byWords      = iOpt "words"
-analMorpho   = iOpt "morpho"
-doTrace      = iOpt "tr"
-noCPU        = iOpt "nocpu"
-doCompute    = iOpt "c"
-optimizeCanon = iOpt "opt"
-optimizeValues = iOpt "val"
-stripQualif   = iOpt "strip"
-nostripQualif = iOpt "nostrip"
-showAll      = iOpt "all"
-showFields   = iOpt "fields"
-showMulti    = iOpt "multi"
-fromSource   = iOpt "src"
-makeConcrete = iOpt "examples"
-fromExamples = iOpt "ex"
-openEditor   = iOpt "edit"
-getTrees     = iOpt "trees"
-
--- ** mainly for stand-alone
-
-useUnicode, optCompute, optCheck, optParaphrase, forJava :: Option
-
-useUnicode    = iOpt "unicode"
-optCompute    = iOpt "compute"
-optCheck      = iOpt "typecheck"
-optParaphrase = iOpt "paraphrase"
-forJava       = iOpt "java"
-
--- ** for edit session
-
-allLangs, absView :: Option
-
-allLangs  = iOpt "All"
-absView   = iOpt "Abs"
-
--- ** options that take arguments
-
-useTokenizer, useUntokenizer, useParser, withFun, 
-  useLanguage, useResource, speechLanguage, useFont,
-  grammarFormat, grammarPrinter, filterString, termCommand,
-  transferFun, forForms, menuDisplay, sizeDisplay, typeDisplay,
-  noDepTypes, extractGr, pathList, uniCoding :: String -> Option
--- | used on command line
-firstCat :: String -> Option
--- | used in grammar, to avoid clash w res word
-gStartCat :: String -> Option
-
-useTokenizer   = aOpt "lexer"
-useUntokenizer = aOpt "unlexer"
-useParser      = aOpt "parser"
--- useStrategy    = aOpt "strategy" -- parsing strategy
-withFun        = aOpt "fun"
-firstCat       = aOpt "cat"      
-gStartCat      = aOpt "startcat" 
-useLanguage    = aOpt "lang"
-useResource    = aOpt "res"
-speechLanguage = aOpt "language"
-useFont        = aOpt "font"
-grammarFormat  = aOpt "format"
-grammarPrinter = aOpt "printer"
-filterString   = aOpt "filter"
-termCommand    = aOpt "transform"
-transferFun    = aOpt "transfer"
-forForms       = aOpt "forms"
-menuDisplay    = aOpt "menu"
-sizeDisplay    = aOpt "size"
-typeDisplay    = aOpt "types"
-noDepTypes     = aOpt "nodeptypes"
-extractGr      = aOpt "extract"
-pathList       = aOpt "path"
-uniCoding      = aOpt "coding"
-probFile       = aOpt "probs"
-noparseFile    = aOpt "noparse"
-usePreprocessor = aOpt "preproc"
-
--- peb 16/3-05:
-gfcConversion :: String -> Option
-gfcConversion  = aOpt "conversion"
-
-useName, useAbsName, useCncName, useResName, 
-  useFile, useOptimizer :: String -> Option
-
-useName        = aOpt "name"
-useAbsName     = aOpt "abs"
-useCncName     = aOpt "cnc"
-useResName     = aOpt "res"
-useFile        = aOpt "file"
-useOptimizer   = aOpt "optimize"
-
-markLin :: String -> Option
-markOptXML, markOptJava, markOptStruct, markOptFocus :: String
-
-markLin        = aOpt "mark"
-markOptXML     = oArg "xml"
-markOptJava    = oArg "java"
-markOptStruct  = oArg "struct"
-markOptFocus   = oArg "focus"
-
-
--- ** refinement order
-
-nextRefine :: String -> Option
-firstRefine, lastRefine :: String
-
-nextRefine  = aOpt "nextrefine"
-firstRefine = oArg "first"
-lastRefine  = oArg "last"
-
--- ** Boolean flags
-
-flagYes, flagNo :: String
-
-flagYes = oArg "yes"
-flagNo  = oArg "no"
-
--- ** integer flags
-
-flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees :: String -> Option
-
-flagDepth  = aOpt "depth"
-flagAlts   = aOpt "alts"
-flagLength = aOpt "length"
-flagNumber = aOpt "number"
-flagRawtrees = aOpt "rawtrees"
-
-caseYesNo :: Options -> OptFun -> Maybe Bool
-caseYesNo opts f = do
-  v <- getOptVal opts f
-  if v == flagYes   then return True
-     else if v == flagNo then return False
-     else Nothing
diff --git a/src-3.0/GF/Infra/UseIO.hs b/src-3.0/GF/Infra/UseIO.hs
index ee66ddcff..dcc0c62ca 100644
--- a/src-3.0/GF/Infra/UseIO.hs
+++ b/src-3.0/GF/Infra/UseIO.hs
@@ -24,6 +24,7 @@ import System.FilePath
 import System.IO
 import System.IO.Error
 import System.Environment
+import System.Exit
 import System.CPUTime
 import Control.Monad
 import Control.Exception(evaluate)
@@ -39,20 +40,16 @@ putShow' f = putStrLn . show . length . show . f
 
 putIfVerb :: Options -> String -> IO ()
 putIfVerb opts msg =
-      if oElem beVerbose opts
+      if beVerbose opts
          then putStrLn msg
          else return ()
 
 putIfVerbW :: Options -> String -> IO ()
 putIfVerbW opts msg =
-      if oElem beVerbose opts
+      if beVerbose opts
          then putStr (' ' : msg)
          else return ()
 
--- | obsolete with IOE monad
-errIO :: a -> Err a -> IO a
-errIO = errOptIO noOptions
-
 errOptIO :: Options -> a -> Err a -> IO a
 errOptIO os e m = case m of
   Ok x  -> return x
@@ -235,6 +232,13 @@ foldIOE f s xs = case xs of
       Ok v  -> foldIOE f v xx
       Bad m -> return $ (s, Just m)
 
+dieIOE :: IOE a -> IO a
+dieIOE x = appIOE x >>= err die return
+
+die :: String -> IO a
+die s = do hPutStrLn stderr s
+           exitFailure
+
 putStrLnE :: String -> IOE ()
 putStrLnE = ioeIO . putStrLnFlush 
 
@@ -243,28 +247,27 @@ putStrE = ioeIO . putStrFlush
 
 -- this is more verbose
 putPointE :: Options -> String -> IOE a -> IOE a
-putPointE = putPointEgen (oElem beSilent)
+putPointE = putPointEgen beSilent
 
 -- this is less verbose
 putPointEsil :: Options -> String -> IOE a -> IOE a
-putPointEsil = putPointEgen (not . oElem beVerbose)
+putPointEsil = putPointEgen (not . beVerbose)
 
 putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
 putPointEgen cond opts msg act = do
-  let ve x = if cond opts then return () else x
-  ve $ ioeIO $ putStrFlush msg
+  when (cond opts) $ ioeIO $ putStrFlush msg
 
   t1 <- ioeIO $ getCPUTime
   a <- act >>= ioeIO . evaluate
   t2 <- ioeIO $ getCPUTime
 
-  ve $ ioeIO $ putStrLnFlush (' ' : show ((t2 - t1) `div` 1000000000) ++ " msec")
+  when (flag optShowCPUTime opts) $ ioeIO $ putStrLnFlush (' ' : show ((t2 - t1) `div` 1000000000) ++ " msec")
   return a
 
 
 -- | forces verbosity
 putPointEVerb :: Options -> String -> IOE a -> IOE a
-putPointEVerb opts = putPointE (addOption beVerbose opts)
+putPointEVerb = putPointEgen (const False)
 
 -- ((do {s <- readFile f; return (return s)}) ) 
 readFileIOE :: FilePath -> IOE BS.ByteString