msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

GF.Command.Commands: allCommands is now a constant

Browse Source 
The dependency on PGFEnv has been moved from the list to the exec function of
the commands in the list. This means that the help command no longer needs
to generate a new list of commands and that the state of the shell
(type GF.Command.Interpreter.CommandEnv) no longer needs to contain the list
of commands.
This commit is contained in:
hallgren
2012-09-25 11:42:32 +00:00
parent bf49f3c246
commit 69de623c17
2 changed files with 162 additions and 161 deletions
Download Patch File Download Diff File Expand all files Collapse all files

175
src/compiler/GF/Command/Commands.hs
View File

@@ -1,5 +1,4 @@
{-# LANGUAGE PatternGuards #-}
module GF.Command.Commands (
allCommands,
lookCommand,
@@ -54,7 +53,7 @@ import System.Random (newStdGen) ----
type CommandOutput = ([Expr],String) ---- errors, etc
data CommandInfo = CommandInfo {
exec :: [Option] -> [Expr] -> IO CommandOutput,
exec :: PGFEnv -> [Option] -> [Expr] -> IO CommandOutput,
synopsis :: String,
syntax :: String,
explanation :: String,
@@ -67,7 +66,7 @@ data CommandInfo = CommandInfo {
emptyCommandInfo :: CommandInfo
emptyCommandInfo = CommandInfo {
exec = \_ ts -> return (ts,[]), ----
exec = \_ _ ts -> return (ts,[]), ----
synopsis = "",
syntax = "",
explanation = "",
@@ -81,10 +80,9 @@ emptyCommandInfo = CommandInfo {
lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
lookCommand = Map.lookup
commandHelpAll :: PGFEnv -> [Option] -> String
commandHelpAll pgf opts = unlines
[commandHelp' opts (isOpt "full" opts) (co,info)
| (co,info) <- Map.assocs (allCommands pgf)]
commandHelpAll :: [Option] -> String
commandHelpAll opts = unlines $
commandHelp' opts (isOpt "full" opts) `map` Map.toList allCommands
commandHelp' opts = if isOpt "t2t" opts then commandHelpTags else commandHelp
@@ -123,7 +121,7 @@ commandHelpTags full (co,info) = unlines . compact $ [
lit = optionally (wrap "``")
equal = optionally (" = "++)
verbatim = optionally (wrap ["```"])
-- verbatim = optionally (wrap ["```"])
wrap d s = d++s++d
section hdr = optionally ((hdr++++).unlines)
@@ -140,8 +138,8 @@ type PGFEnv = (PGF, Map.Map Language Morpho)
mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl))
-- this list must no more be kept sorted by the command name
allCommands :: PGFEnv -> Map.Map String CommandInfo
allCommands env@(pgf, mos) = Map.fromList [
allCommands :: Map.Map String CommandInfo
allCommands = Map.fromList [
("!", emptyCommandInfo {
synopsis = "system command: escape to system shell",
syntax = "! SYSTEMCOMMAND",
@@ -170,8 +168,8 @@ allCommands env@(pgf, mos) = Map.fromList [
"by the flag. The target format is postscript, unless overridden by the",
"flag -format."
],
exec = \opts es -> do
let langs = optLangs opts
exec = \env@(pgf, mos) opts es -> do
let langs = optLangs pgf opts
if isOpt "giza" opts
then do
let giz = map (gizaAlignment pgf (head $ langs, head $ tail $ langs)) es
@@ -217,15 +215,15 @@ allCommands env@(pgf, mos) = Map.fromList [
"by the flag '-clitics'. The list of stems is given as the list of words",
"of the language given by the '-lang' flag."
],
exec = \opts -> case opts of
exec = \env opts -> case opts of
_ | isOpt "raw" opts ->
return . fromString .
unlines . map (unwords . map (concat . intersperse "+")) .
map (getClitics (isInMorpho (optMorpho opts)) (optClitics opts)) .
map (getClitics (isInMorpho (optMorpho env opts)) (optClitics opts)) .
concatMap words . toStrings
_ ->
return . fromStrings .
getCliticsText (isInMorpho (optMorpho opts)) (optClitics opts) .
getCliticsText (isInMorpho (optMorpho env opts)) (optClitics opts) .
concatMap words . toStrings,
flags = [
("clitics","the list of possible clitics (comma-separated, no spaces)"),
@@ -347,11 +345,11 @@ allCommands env@(pgf, mos) = Map.fromList [
("lang","the language in which to parse"),
("probs","file with probabilities to rank the parses")
],
exec = \opts _ -> do
exec = \env@(pgf, mos) opts _ -> do
let file = optFile opts
pgf <- optProbs opts pgf
let printer = if (isOpt "api" opts) then exprToAPI else (showExpr [])
let conf = configureExBased pgf (optMorpho opts) (optLang opts) printer
let conf = configureExBased pgf (optMorpho env opts) (optLang pgf opts) printer
(file',ws) <- parseExamplesInGrammar conf file
if null ws then return () else putStrLn ("unknown words: " ++ unwords ws)
return (fromString ("wrote " ++ file')),
@@ -381,13 +379,13 @@ allCommands env@(pgf, mos) = Map.fromList [
("depth","the maximum generation depth"),
("probs", "file with biased probabilities (format 'f 0.4' one by line)")
],
exec = \opts xs -> do
pgf <- optProbs opts (optRestricted opts)
exec = \env@(pgf, mos) opts xs -> do
pgf <- optProbs opts (optRestricted opts pgf)
gen <- newStdGen
let dp = valIntOpts "depth" 4 opts
let ts = case mexp xs of
Just ex -> generateRandomFromDepth gen pgf ex (Just dp)
Nothing -> generateRandomDepth gen pgf (optType opts) (Just dp)
Nothing -> generateRandomDepth gen pgf (optType pgf opts) (Just dp)
returnFromExprs $ take (optNum opts) ts
}),
("gt", emptyCommandInfo {
@@ -411,12 +409,12 @@ allCommands env@(pgf, mos) = Map.fromList [
mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2",
mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))"
],
exec = \opts xs -> do
let pgfr = optRestricted opts
exec = \env@(pgf, mos) opts xs -> do
let pgfr = optRestricted opts pgf
let dp = valIntOpts "depth" 4 opts
let ts = case mexp xs of
Just ex -> generateFromDepth pgfr ex (Just dp)
Nothing -> generateAllDepth pgfr (optType opts) (Just dp)
Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp)
returnFromExprs $ take (optNumInf opts) ts
}),
("h", emptyCommandInfo {
@@ -434,17 +432,17 @@ allCommands env@(pgf, mos) = Map.fromList [
("license","show copyright and license information"),
("t2t","output help in txt2tags format")
],
exec = \opts ts ->
exec = \_ opts ts ->
let
msg = case ts of
_ | isOpt "changes" opts -> changesMsg
_ | isOpt "coding" opts -> codingMsg
_ | isOpt "license" opts -> licenseMsg
[t] -> let co = getCommandOp (showExpr [] t) in
case lookCommand co (allCommands env) of ---- new map ??!!
case lookCommand co allCommands of
Just info -> commandHelp' opts True (co,info)
_ -> "command not found"
_ -> commandHelpAll env opts
_ -> commandHelpAll opts
in return (fromString msg),
needsTypeCheck = False
}),
@@ -494,7 +492,7 @@ allCommands env@(pgf, mos) = Map.fromList [
mkEx "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table",
mkEx "l -unlexer=\"LangAra=to_arabic LangHin=to_devanagari\" -- different unlexers"
],
exec = \opts -> return . fromStrings . optLins opts,
exec = \env@(pgf, mos) opts -> return . fromStrings . optLins pgf opts,
options = [
("all","show all forms and variants, one by line (cf. l -list)"),
("bracket","show tree structure with brackets and paths to nodes"),
@@ -516,17 +514,17 @@ allCommands env@(pgf, mos) = Map.fromList [
"Prints all the analyses of space-separated words in the input string,",
"using the morphological analyser of the actual grammar (see command pg)"
],
exec = \opts -> case opts of
exec = \env opts -> case opts of
_ | isOpt "missing" opts ->
return . fromString . unwords .
morphoMissing (optMorpho opts) .
morphoMissing (optMorpho env opts) .
concatMap words . toStrings
_ | isOpt "known" opts ->
return . fromString . unwords .
morphoKnown (optMorpho opts) .
morphoKnown (optMorpho env opts) .
concatMap words . toStrings
_ -> return . fromString . unlines .
map prMorphoAnalysis . concatMap (morphos opts) .
map prMorphoAnalysis . concatMap (morphos env opts) .
concatMap words . toStrings ,
flags = [
("lang","the languages of analysis (comma-separated, no spaces)")
@@ -541,9 +539,9 @@ allCommands env@(pgf, mos) = Map.fromList [
longname = "morpho_quiz",
synopsis = "start a morphology quiz",
syntax = "mq (-cat=CAT)? (-probs=FILE)? TREE?",
exec = \opts xs -> do
let lang = optLang opts
let typ = optType opts
exec = \env@(pgf, mos) opts xs -> do
let lang = optLang pgf opts
let typ = optType pgf opts
pgf <- optProbs opts pgf
let mt = mexp xs
morphologyQuiz mt pgf lang typ
@@ -569,8 +567,8 @@ allCommands env@(pgf, mos) = Map.fromList [
"the parser. For example if -openclass=\"A,N,V\" is given, the parser",
"will accept unknown adjectives, nouns and verbs with the resource grammar."
],
exec = \opts ts ->
return $ fromParse opts (concat [map ((,) s) (par opts s) | s <- toStrings ts]),
exec = \env@(pgf, mos) opts ts ->
return $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]),
flags = [
("cat","target category of parsing"),
("lang","the languages of parsing (comma-separated, no spaces)"),
@@ -600,7 +598,7 @@ allCommands env@(pgf, mos) = Map.fromList [
" " ++ opt ++ "\t\t" ++ expl |
((opt,_),expl) <- outputFormatsExpl, take 1 expl /= "*"
]),
exec = \opts _ -> prGrammar opts,
exec = \env opts _ -> prGrammar env opts,
flags = [
--"cat",
("file", "set the file name when printing with -pgf option"),
@@ -655,7 +653,7 @@ allCommands env@(pgf, mos) = Map.fromList [
mkEx "rf -file=Ara.gf | ps -from_utf8 -env=quotes -from_arabic -- convert UTF8 to transliteration",
mkEx "ps -to=chinese.trans \"abc\" -- apply transliteration defined in file chinese.trans"
],
exec = \opts x -> do
exec = \_ opts x -> do
let (os,fs) = optsAndFlags opts
trans <- optTranslit opts
return ((fromString . trans . stringOps (envFlag fs) (map prOpt os) . toString) x),
@@ -680,10 +678,10 @@ allCommands env@(pgf, mos) = Map.fromList [
mkEx "pt -compute (plus one two) -- compute value",
mkEx "p \"4 dogs love 5 cats\" | pt -transfer=digits2numeral | l -- four...five..."
],
exec = \opts ->
returnFromExprs . takeOptNum opts . treeOps opts,
options = treeOpOptions pgf,
flags = [("number","take at most this many trees")] ++ treeOpFlags pgf
exec = \env@(pgf, mos) opts ->
returnFromExprs . takeOptNum opts . treeOps pgf opts,
options = treeOpOptions undefined{-pgf-},
flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-}
}),
("q", emptyCommandInfo {
longname = "quit",
@@ -707,7 +705,7 @@ allCommands env@(pgf, mos) = Map.fromList [
("lines","return the list of lines, instead of the singleton of all contents"),
("tree","convert strings into trees")
],
exec = \opts _ -> do
exec = \env@(pgf, mos) opts _ -> do
let file = valStrOpts "file" "_gftmp" opts
let exprs [] = ([],empty)
exprs ((n,s):ls) | null s
@@ -742,7 +740,7 @@ allCommands env@(pgf, mos) = Map.fromList [
"by the file given by flag -probs=FILE, where each line has the form",
"'function probability', e.g. 'youPol_Pron 0.01'."
],
exec = \opts ts -> do
exec = \env@(pgf, mos) opts ts -> do
pgf <- optProbs opts pgf
let tds = rankTreesByProbs pgf ts
if isOpt "v" opts
@@ -764,10 +762,10 @@ allCommands env@(pgf, mos) = Map.fromList [
longname = "translation_quiz",
syntax = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",
synopsis = "start a translation quiz",
exec = \opts xs -> do
let from = optLangFlag "from" opts
let to = optLangFlag "to" opts
let typ = optType opts
exec = \env@(pgf, mos) opts xs -> do
let from = optLangFlag "from" pgf opts
let to = optLangFlag "to" pgf opts
let typ = optType pgf opts
let mt = mexp xs
pgf <- optProbs opts pgf
translationQuiz mt pgf from to typ
@@ -820,7 +818,7 @@ allCommands env@(pgf, mos) = Map.fromList [
longname = "system_pipe",
synopsis = "send argument to a system command",
syntax = "sp -command=\"SYSTEMCOMMAND\", alt. ? SYSTEMCOMMAND",
exec = \opts arg -> do
exec = \_ opts arg -> do
let tmpi = "_tmpi" ---
let tmpo = "_tmpo"
restricted $ writeFile tmpi $ toString arg
@@ -885,7 +883,7 @@ allCommands env@(pgf, mos) = Map.fromList [
("ut", emptyCommandInfo {
longname = "unicode_table",
synopsis = "show a transliteration table for a unicode character set",
exec = \opts _ -> do
exec = \_ opts _ -> do
let t = concatMap prOpt (take 1 opts)
let out = maybe "no such transliteration" characterTable $ transliteration t
return $ fromString out,
@@ -907,14 +905,14 @@ allCommands env@(pgf, mos) = Map.fromList [
"by the flag. The target format is png, unless overridden by the",
"flag -format."
],
exec = \opts es -> do
exec = \env@(pgf, mos) opts es -> do
let debug = isOpt "v" opts
let file = valStrOpts "file" "" opts
let outp = valStrOpts "output" "dot" opts
mlab <- case file of
"" -> return Nothing
_ -> readFile file >>= return . Just . getDepLabels . lines
let lang = optLang opts
let lang = optLang pgf opts
let grphs = unlines $ map (graphvizDependencyTree outp debug mlab Nothing pgf lang) es
if isFlag "view" opts || isFlag "format" opts then do
let file s = "_grphd." ++ s
@@ -954,8 +952,8 @@ allCommands env@(pgf, mos) = Map.fromList [
"by the flag. The target format is png, unless overridden by the",
"flag -format."
],
exec = \opts es -> do
let lang = optLang opts
exec = \env@(pgf, mos) opts es -> do
let lang = optLang pgf opts
let grph = if null es then [] else graphvizParseTree pgf lang (head es)
if isFlag "view" opts || isFlag "format" opts then do
let file s = "_grph." ++ s
@@ -990,7 +988,7 @@ allCommands env@(pgf, mos) = Map.fromList [
"flag -format.",
"With option -mk, use for showing library style function names of form 'mkC'."
],
exec = \opts es ->
exec = \env@(pgf, mos) opts es ->
if isOpt "mk" opts
then return $ fromString $ unlines $ map (tree2mk pgf) es
else if isOpt "api" opts
@@ -1029,7 +1027,7 @@ allCommands env@(pgf, mos) = Map.fromList [
("wf", emptyCommandInfo {
longname = "write_file",
synopsis = "send string or tree to a file",
exec = \opts arg -> do
exec = \_ opts arg -> do
let file = valStrOpts "file" "_gftmp" opts
if isOpt "append" opts
then restricted $ appendFile file (toString arg)
@@ -1043,7 +1041,7 @@ allCommands env@(pgf, mos) = Map.fromList [
("t", emptyCommandInfo {
longname = "tokenize",
synopsis = "Tokenize string using the vocabulary",
exec = execToktok env,
exec = execToktok,
options = [],
flags = [("lang","The name of the concrete to use")]
}),
@@ -1059,7 +1057,7 @@ allCommands env@(pgf, mos) = Map.fromList [
"If a whole expression is given it prints the expression with refined",
"metavariables and the type of the expression."
],
exec = \opts arg -> do
exec = \env@(pgf, mos) opts arg -> do
case arg of
[EFun id] -> case Map.lookup id (funs (abstract pgf)) of
Just fd -> do putStrLn $ render (ppFun id fd)
@@ -1087,28 +1085,28 @@ allCommands env@(pgf, mos) = Map.fromList [
})
]
where
par opts s = case optOpenTypes opts of
[] -> [parse_ pgf lang (optType opts) (Just dp) s | lang <- optLangs opts]
open_typs -> [parseWithRecovery pgf lang (optType opts) open_typs (Just dp) s | lang <- optLangs opts]
par pgf opts s = case optOpenTypes opts of
[] -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]
open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]
where
dp = valIntOpts "depth" 4 opts
void = ([],[])
optLins opts ts = case opts of
optLins pgf opts ts = case opts of
_ | isOpt "groups" opts ->
map (unlines . snd) $ groupResults
[[(lang, linear opts lang t) | lang <- optLangs opts] | t <- ts]
_ -> map (optLin opts) ts
optLin opts t = unlines $
[[(lang, linear pgf opts lang t) | lang <- optLangs pgf opts] | t <- ts]
_ -> map (optLin pgf opts) ts
optLin pgf opts t = unlines $
case opts of
_ | isOpt "treebank" opts ->
(showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
[showCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
_ -> [linear opts lang t | lang <- optLangs opts]
[showCId lang ++ ": " ++ linear pgf opts lang t | lang <- optLangs pgf opts]
_ -> [linear pgf opts lang t | lang <- optLangs pgf opts]
linear :: [Option] -> CId -> Expr -> String
linear opts lang = let unl = unlex opts lang in case opts of
linear :: PGF -> [Option] -> CId -> Expr -> String
linear pgf opts lang = let unl = unlex opts lang in case opts of
_ | isOpt "all" opts -> unlines . concat . intersperse [[]] .
map (map (unl . snd)) . tabularLinearizes pgf lang
_ | isOpt "list" opts -> commaList . concat . intersperse [[]] .
@@ -1142,29 +1140,30 @@ allCommands env@(pgf, mos) = Map.fromList [
-- - If lang has flag coding=utf8, -to_utf8 is ignored.
-- - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first.
-- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly
unlexx opts lang = {- trace (unwords optsC) $ -} stringOps Nothing optsC where ----
{-
unlexx pgf opts lang = {- trace (unwords optsC) $ -} stringOps Nothing optsC where ----
optsC = case lookConcrFlag pgf (mkCId lang) (mkCId "coding") of
Just (LStr "utf8") -> filter (/="to_utf8") $ map prOpt opts
Just (LStr other) | isOpt "to_utf8" opts ->
let cod = ("from_" ++ other)
in cod : filter (/=cod) (map prOpt opts)
_ -> map prOpt opts
optRestricted opts =
restrictPGF (\f -> and [hasLin pgf la f | la <- optLangs opts]) pgf
-}
optRestricted opts pgf =
restrictPGF (\f -> and [hasLin pgf la f | la <- optLangs pgf opts]) pgf
optLang = optLangFlag "lang"
optLangs = optLangsFlag "lang"
optLangsFlag f opts = case valStrOpts f "" opts of
optLangsFlag f pgf opts = case valStrOpts f "" opts of
"" -> languages pgf
lang -> map completeLang (chunks ',' lang)
completeLang la = let cla = (mkCId la) in
lang -> map (completeLang pgf) (chunks ',' lang)
completeLang pgf la = let cla = (mkCId la) in
if elem cla (languages pgf)
then cla
else (mkCId (showCId (abstractName pgf) ++ la))
optLangFlag f opts = head $ optLangsFlag f opts ++ [wildCId]
optLangFlag f pgf opts = head $ optLangsFlag f pgf opts ++ [wildCId]
optOpenTypes opts = case valStrOpts "openclass" "" opts of
"" -> []
@@ -1187,7 +1186,7 @@ allCommands env@(pgf, mos) = Map.fromList [
optFile opts = valStrOpts "file" "_gftmp" opts
optType opts =
optType pgf opts =
let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts
in case readType str of
Just ty -> case checkType pgf ty of
@@ -1227,7 +1226,7 @@ allCommands env@(pgf, mos) = Map.fromList [
[] -> ([], "no trees found")
_ -> fromExprs es
prGrammar opts
prGrammar env@(pgf,mos) opts
| isOpt "pgf" opts = do
let pgf1 = if isOpt "opt" opts then optimizePGF pgf else pgf
let outfile = valStrOpts "file" (showCId (abstractName pgf) ++ ".pgf") opts
@@ -1236,25 +1235,25 @@ allCommands env@(pgf, mos) = Map.fromList [
return void
| isOpt "cats" opts = return $ fromString $ unwords $ map showCId $ categories pgf
| isOpt "funs" opts = return $ fromString $ unlines $ map showFun $ funsigs pgf
| isOpt "fullform" opts = return $ fromString $ concatMap (morpho "" prFullFormLexicon) $ optLangs opts
| isOpt "fullform" opts = return $ fromString $ concatMap (morpho mos "" prFullFormLexicon) $ optLangs pgf opts
| isOpt "langs" opts = return $ fromString $ unwords $ map showCId $ languages pgf
| isOpt "lexc" opts = return $ fromString $ concatMap (morpho "" prLexcLexicon) $ optLangs opts
| isOpt "lexc" opts = return $ fromString $ concatMap (morpho mos "" prLexcLexicon) $ optLangs pgf opts
| isOpt "missing" opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) |
la <- optLangs opts, let cs = missingLins pgf la]
| isOpt "words" opts = return $ fromString $ concatMap (morpho "" prAllWords) $ optLangs opts
la <- optLangs pgf opts, let cs = missingLins pgf la]
| isOpt "words" opts = return $ fromString $ concatMap (morpho mos "" prAllWords) $ optLangs pgf opts
| otherwise = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf
funsigs pgf = [(f,ty) | (f,(ty,_,_,_,_)) <- Map.assocs (funs (abstract pgf))]
showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;"
morphos opts s =
[(s,morpho [] (\mo -> lookupMorpho mo s) la) | la <- optLangs opts]
morphos (pgf,mos) opts s =
[(s,morpho mos [] (\mo -> lookupMorpho mo s) la) | la <- optLangs pgf opts]
morpho z f la = maybe z f $ Map.lookup la mos
morpho mos z f la = maybe z f $ Map.lookup la mos
optMorpho opts = morpho (error "no morpho") id (head (optLangs opts))
optMorpho (pgf,mos) opts = morpho mos (error "no morpho") id (head (optLangs pgf opts))
optClitics opts = case valStrOpts "clitics" "" opts of
"" -> []
@@ -1273,7 +1272,7 @@ allCommands env@(pgf, mos) = Map.fromList [
"quotes" -> Just ("\"","\"")
_ -> Nothing
treeOps opts s = foldr app s (reverse opts) where
treeOps pgf opts s = foldr app s (reverse opts) where
app (OOpt op) | Just (Left f) <- treeOp pgf op = f
app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f (mkCId x)
app _ = id

10
src/compiler/GF/Command/Interpreter.hs
View File

@@ -1,5 +1,5 @@
module GF.Command.Interpreter (
CommandEnv (..),
CommandEnv,commands,multigrammar,commandmacros,expmacros,
mkCommandEnv,
emptyCommandEnv,
interpretCommandLine,
@@ -24,15 +24,16 @@ import qualified Data.Map as Map
data CommandEnv = CommandEnv {
multigrammar :: PGF,
morphos :: Map.Map Language Morpho,
commands :: Map.Map String CommandInfo,
--commands :: Map.Map String CommandInfo,
commandmacros :: Map.Map String CommandLine,
expmacros :: Map.Map String Expr
}
commands _ = allCommands
mkCommandEnv :: PGF -> CommandEnv
mkCommandEnv pgf =
let mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] in
CommandEnv pgf mos (allCommands (pgf, mos)) Map.empty Map.empty
CommandEnv pgf mos {-allCommands-} Map.empty Map.empty
emptyCommandEnv :: CommandEnv
emptyCommandEnv = mkCommandEnv emptyPGF
@@ -86,7 +87,8 @@ interpret env trees comm =
case getCommand env trees comm of
Left msg -> do putStrLn ('\n':msg)
return ([],[])
Right (info,opts,trees) -> do tss@(_,s) <- exec info opts trees
Right (info,opts,trees) -> do let cmdenv = (multigrammar env,morphos env)
tss@(_,s) <- exec info cmdenv opts trees
if isOpt "tr" opts
then putStrLn s
else return ()