GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

Some work on gf3/gfc command-line options.

Browse Source
This commit is contained in:
bjorn
2008-02-19 20:59:01 +00:00
parent a4bded9f3a
commit b468482c3f
1 changed files with 149 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

220
src/GF/Devel/GFC/Options.hs → src/GF/Devel/Options.hs
View File

@@ -1,4 +1,4 @@
module GF.Devel.GFC.Options
module GF.Devel.Options
(
Err(..), -- FIXME: take from somewhere else
@@ -8,6 +8,8 @@ module GF.Devel.GFC.Options
) where
import Control.Monad
import Data.Char (toLower)
import Data.List
import Data.Maybe
import System.Console.GetOpt
import System.FilePath
@@ -37,6 +39,7 @@ usageHeader = unlines
helpMessage :: String
helpMessage = usageInfo usageHeader optDescr
-- Error monad
type ErrorMsg = String
@@ -52,85 +55,152 @@ instance Monad Err where
errors :: [ErrorMsg] -> Err a
errors = Errors
-- Types
data Mode = Version | Help | Compiler
deriving (Show)
data Mode = Version | Help | Interactive | Compiler
deriving (Show,Eq,Ord)
data Phase = Preproc | Convert | Compile | Link
deriving (Show)
deriving (Show,Eq,Ord)
data Encoding = UTF_8 | ISO_8859_1
deriving (Show,Eq,Ord)
data OutputFormat = FmtGFCC | FmtJS
deriving (Show)
deriving (Show,Eq,Ord)
data Optimization = None
data Optimization = OptStem | OptCSE
deriving (Show,Eq,Ord)
data Warning = WarnMissingLincat
deriving (Show,Eq,Ord)
data Dump = DumpRebuild | DumpExtend | DumpRename | DumpTypecheck | DumpRefresh | DumpOptimize | DumpCanon
deriving (Show,Eq,Ord)
data ModuleOptions = ModuleOptions {
optPreprocessors :: [String],
optEncoding :: Encoding,
optOptimizations :: [Optimization],
optLibraryPath :: [FilePath],
optSpeechLanguage :: Maybe String,
optBuildParser :: Bool,
optWarnings :: [Warning],
optDump :: [Dump]
}
deriving (Show)
data Options = Options {
optMode :: Mode,
optStopAfterPhase :: Phase,
optVerbosity :: Int,
optShowCPUTime :: Bool,
optEmitGFC :: Bool,
optGFCDir :: FilePath,
optOutputFormats :: [OutputFormat],
optOutputName :: Maybe String,
optOutputFile :: Maybe FilePath,
optOutputDir :: FilePath,
optLibraryPath :: [FilePath],
optForceRecomp :: Bool,
optPreprocessors :: [String],
optOptimization :: Optimization,
optProb :: Bool,
optStartCategory :: Maybe String,
optSpeechLanguage :: Maybe String
}
optMode :: Mode,
optStopAfterPhase :: Phase,
optVerbosity :: Int,
optShowCPUTime :: Bool,
optEmitGFO :: Bool,
optGFODir :: FilePath,
optOutputFormats :: [OutputFormat],
optOutputName :: Maybe String,
optOutputFile :: Maybe FilePath,
optOutputDir :: FilePath,
optForceRecomp :: Bool,
optProb :: Bool,
optStartCategory :: Maybe String,
optModuleOptions :: ModuleOptions
}
deriving (Show)
-- Option parsing
parseOptions :: [String] -> Err (Options, [FilePath])
parseOptions args = case errs of
[] -> do o <- foldM (\o f -> f o) defaultOptions opts
return (o, files)
_ -> errors errs
where (opts, files, errs) = getOpt RequireOrder optDescr args
parseModuleFlags :: Options -> [(String,String)] -> Err ModuleOptions
parseModuleFlags opts flags = foldr setOpt (optModuleOptions opts) moduleOptDescr
where
setOpt (Option _ ss arg _) d
| null values = d
| otherwise = case arg of
NoArg a ->
ReqArg (String -> a) _ ->
OptArg (Maybe String -> a) String
last values
where values = [v | (k,v) <- flags, k `elem` ss ]
-- Default options
defaultModuleOptions :: ModuleOptions
defaultModuleOptions = ModuleOptions {
optPreprocessors = [],
optEncoding = ISO_8859_1,
optOptimizations = [OptStem,OptCSE],
optLibraryPath = [],
optSpeechLanguage = Nothing,
optBuildParser = True,
optWarnings = [],
optDump = []
}
defaultOptions :: Options
defaultOptions = Options {
optMode = Compiler,
optStopAfterPhase = Link,
optVerbosity = 1,
optShowCPUTime = False,
optEmitGFC = True,
optGFCDir = ".",
optOutputFormats = [FmtGFCC],
optOutputName = Nothing,
optOutputFile = Nothing,
optOutputDir = ".",
optLibraryPath = [],
optForceRecomp = False,
optPreprocessors = [],
optOptimization = None,
optProb = False,
optStartCategory = Nothing,
optSpeechLanguage = Nothing
}
optMode = Interactive,
optStopAfterPhase = Link,
optVerbosity = 1,
optShowCPUTime = False,
optEmitGFO = True,
optGFODir = ".",
optOutputFormats = [FmtGFCC],
optOutputName = Nothing,
optOutputFile = Nothing,
optOutputDir = ".",
optForceRecomp = False,
optProb = False,
optStartCategory = Nothing,
optModuleOptions = defaultModuleOptions
}
-- Option descriptions
parseOptions :: [String] -> Err (Options, [FilePath])
parseOptions args = do case errs of
[] -> do o <- foldM (\o f -> f o) defaultOptions opts
return (o, files)
_ -> errors errs
where (opts, files, errs) = getOpt RequireOrder optDescr args
moduleOptDescr :: [OptDescr (ModuleOptions -> Err ModuleOptions)]
moduleOptDescr =
[
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 [] ["stem"] (onOff (optimize OptStem) True) "Perform stem-suffix analysis (default on).",
Option [] ["cse"] (onOff (optimize OptCSE) True) "Perform common sub-expression elimination (default on).",
Option [] ["parser"] (onOff parser True) "Build parser (default on).",
Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar."
]
where
addLibDir x o = return $ o { optLibraryPath = x:optLibraryPath o }
setLibPath x o = return $ o { optLibraryPath = splitSearchPath x }
preproc x o = return $ o { optPreprocessors = optPreprocessors o ++ [x] }
optimize x b o = return $ o { optOptimizations = (if b then (x:) else delete x) (optOptimizations o) }
parser x o = return $ o { optBuildParser = x }
language x o = return $ o { optSpeechLanguage = Just x }
optDescr :: [OptDescr (Options -> Err Options)]
optDescr =
[
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 .gfc.",
Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo.",
Option ['V'] ["version"] (NoArg (mode Version)) "Display GF version number.",
Option ['?','h'] ["help"] (NoArg (mode Help)) "Show help message.",
Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 3.",
Option ['q'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
Option [] ["batch"] (NoArg (mode Compiler)) "Run in batch compiler mode.",
Option [] ["interactive"] (NoArg (mode Interactive)) "Run in interactive mode (default).",
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-gfc"] (NoArg (emitGFC True)) "Create .gfc files (default).",
Option [] ["no-emit-gfc"] (NoArg (emitGFC False)) "Do not create .gfc files.",
Option [] ["gfc-dir"] (ReqArg gfcDir "DIR") "Directory to put .gfc files in (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, ...",
@@ -144,19 +214,11 @@ optDescr =
"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 ['i'] [] (ReqArg addLibDir "DIR") "Add DIR to the library search path.",
Option [] ["path"] (ReqArg setLibPath "DIR:DIR:...") "Set the library search path.",
Option [] ["src","force-recomp"] (NoArg (forceRecomp True))
"Always recompile from source, i.e. disable recompilation checking.",
Option [] ["preproc"] (ReqArg preproc "CMD")
(unlines ["Use CMD to preprocess input files.",
"Multiple preprocessors can be used by giving this option multiple times."]),
Option ['O'] [] (OptArg optimize "OPT")
"Perform the named optimization. Just -O means FIXME.",
Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas.",
Option [] ["startcat"] (ReqArg startcat "CAT") "Use CAT as the start category in the generated grammar.",
Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar."
]
Option [] ["startcat"] (ReqArg startcat "CAT") "Use CAT as the start category in the generated grammar."
] ++ map (fmap onModuleOptions) moduleOptDescr
where phase x o = return $ o { optStopAfterPhase = x }
mode x o = return $ o { optMode = x }
verbosity mv o = case mv of
@@ -165,27 +227,43 @@ optDescr =
[(i,"")] | i >= 0 -> return $ o { optVerbosity = i }
_ -> fail $ "Bad verbosity: " ++ show v
cpu x o = return $ o { optShowCPUTime = x }
emitGFC x o = return $ o { optEmitGFC = x }
gfcDir x o = return $ o { optGFCDir = x }
outFmt x o = readOutputFormat x >>= \f -> return $ o { optOutputFormats = optOutputFormats o ++ [f] }
emitGFO x o = return $ o { optEmitGFO = x }
gfoDir x o = return $ o { optGFODir = x }
outFmt x o = readOutputFormat x >>= \f ->
return $ o { optOutputFormats = optOutputFormats o ++ [f] }
outName x o = return $ o { optOutputName = Just x }
outFile x o = return $ o { optOutputFile = Just x }
outDir x o = return $ o { optOutputDir = x }
addLibDir x o = return $ o { optLibraryPath = x:optLibraryPath o }
setLibPath x o = return $ o { optLibraryPath = splitSearchPath x }
forceRecomp x o = return $ o { optForceRecomp = x }
preproc x o = return $ o { optPreprocessors = optPreprocessors o ++ [x] }
optimize x o = return $ o { optOptimization = None }
prob x o = return $ o { optProb = x }
startcat x o = return $ o { optStartCategory = Just x }
language x o = return $ o { optSpeechLanguage = Just x }
onModuleOptions :: Monad m => (ModuleOptions -> m ModuleOptions) -> Options -> m Options
onModuleOptions f o = do mo' <- f (optModuleOptions o)
return $ o { optModuleOptions = mo' }
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", FmtJS)]
onOff :: Monad m => (Bool -> (a -> m a)) -> Bool -> ArgDescr (a -> m a)
onOff f def = OptArg g "[on,off]"
where g ma x = do b <- maybe (return def) readOnOff ma
f b x
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