1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
module GF.Devel.GFC.Options
(
Err(..), -- FIXME: take from somewhere else
Options(..),
Mode(..), Phase(..), OutputFormat(..), Optimization(..),
parseOptions, helpMessage
) where
import Control.Monad
import Data.Maybe
import System.Console.GetOpt
import System.FilePath
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.",
".gfc 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, .gfc or .gfe files.",
"For the other input formats, only one file can be given.",
"",
"Command-line options:"]
helpMessage :: String
helpMessage = usageInfo usageHeader optDescr
type ErrorMsg = String
data Err a = Ok a | Errors [ErrorMsg]
deriving (Read, Show, Eq)
instance Monad Err where
return = Ok
fail e = Errors [e]
Ok a >>= f = f a
Errors s >>= f = Errors s
errors :: [ErrorMsg] -> Err a
errors = Errors
data Mode = Version | Help | Compiler
deriving (Show)
data Phase = Preproc | Convert | Compile | Link
deriving (Show)
data OutputFormat = FmtGFCC | FmtJS
deriving (Show)
data Optimization = None
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
}
deriving (Show)
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
}
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
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 ['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 [] ["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 ['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 ['n'] ["output-name"] (ReqArg outName "NAME")
("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 ['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 ['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."
]
where phase x o = return $ o { optStopAfterPhase = x }
mode x o = return $ o { optMode = x }
verbosity mv o = case mv of
Nothing -> return $ o { optVerbosity = 3 }
Just v -> case reads v of
[(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] }
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 }
outputFormats :: [(String,OutputFormat)]
outputFormats =
[("gfcc", FmtGFCC),
("js", FmtJS)]
readOutputFormat :: Monad m => String -> m OutputFormat
readOutputFormat s =
maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats
|
