From ab3cc776566847998fdca67714d40693f3f7b26c Mon Sep 17 00:00:00 2001 From: hallgren Date: Thu, 7 Apr 2016 13:40:05 +0000 Subject: [PATCH] GF shell: fix a parsing problem with the cc command This patch fixes a problem introduced last year when the GF shell was refactored to allow more commands to be treated uniformly and be part of pipes. The cc command was one of those commands, but unfortunately this introduced a parsing problem, e.g. > cc "last" constant not found: last > cc "last"++"year" command not parsed: cc "last"++"year" This happened because the generic command line parser in GF.Command.{Abstract,Parse} assumes that all commands have an argument of type PGF.Expr. Commands that expect other types of arguments have to use PGF.showExpr combined with other conversion to the argument type they expect. The cc command excpets a GF.Grammar.Term, and unfortunately not all terms survice the roundtrip through PGF.Expr, in part because of an additional hack to allow strings to be roundtripped through PGF.Expr without adding superfluous double quotes. To solve the problem, this patch + makes room for arguments of type Term in the Argument type in GF.Command.Abstract. + makes a special case for the cc command in GF.Command.Parse, by calling the partial parser 'runPartial pTerm' recently added in GF.Grammar.Lexer and GF.Grammar.Parser. Care was taken so that that "|" and ";" can be used both inside terms and as separators between commands in the shell, e.g. things like the following now work: > cc ("a"|"b") | ps -lexcode variants { "a" ; "b" } + introduces a type CommandArgument that replaces [Expr] as the type of values passed between commands in pipes. It has room for values of type [Expr], [String] and Term, thus eliminating the need to roundtrip through the Expr type all the time. The hack to avoid adding superfluous quotes when strings are roundtripped through Expr has been left in place for now, but can probably be removed. --- src/compiler/GF/Command/Abstract.hs | 4 +- src/compiler/GF/Command/CommandInfo.hs | 51 ++++++++++++++++------- src/compiler/GF/Command/Commands.hs | 48 ++++++++++++--------- src/compiler/GF/Command/CommonCommands.hs | 2 +- src/compiler/GF/Command/Help.hs | 8 ++-- src/compiler/GF/Command/Interpreter.hs | 27 ++++++------ src/compiler/GF/Command/Parse.hs | 11 ++++- 7 files changed, 97 insertions(+), 54 deletions(-) diff --git a/src/compiler/GF/Command/Abstract.hs b/src/compiler/GF/Command/Abstract.hs index 0a664d1ca..25760e41f 100644 --- a/src/compiler/GF/Command/Abstract.hs +++ b/src/compiler/GF/Command/Abstract.hs @@ -1,6 +1,7 @@ -module GF.Command.Abstract(module GF.Command.Abstract,Expr,showExpr) where +module GF.Command.Abstract(module GF.Command.Abstract,Expr,showExpr,Term) where import PGF(CId,mkCId,Expr,showExpr) +import GF.Grammar.Grammar(Term) type Ident = String @@ -25,6 +26,7 @@ data Value data Argument = AExpr Expr + | ATerm Term | ANoArg | AMacro Ident deriving (Eq,Ord,Show) diff --git a/src/compiler/GF/Command/CommandInfo.hs b/src/compiler/GF/Command/CommandInfo.hs index 7d68f9221..b0b5869c3 100644 --- a/src/compiler/GF/Command/CommandInfo.hs +++ b/src/compiler/GF/Command/CommandInfo.hs @@ -1,10 +1,13 @@ module GF.Command.CommandInfo where -import GF.Command.Abstract(Option,Expr) +import GF.Command.Abstract(Option,Expr,Term) +import GF.Text.Pretty(render) +import GF.Grammar.Printer() -- instance Pretty Term +import GF.Grammar.Macros(string2term) import qualified PGF as H(showExpr) import qualified PGF.Internal as H(Literal(LStr),Expr(ELit)) ---- data CommandInfo m = CommandInfo { - exec :: [Option] -> [Expr] -> m CommandOutput, + exec :: [Option] -> CommandArguments -> m CommandOutput, synopsis :: String, syntax :: String, explanation :: String, @@ -35,26 +38,46 @@ class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr -------------------------------------------------------------------------------- -newtype CommandOutput = Piped {fromPipe :: ([Expr],String)} ---- errors, etc +data CommandArguments = Exprs [Expr] | Strings [String] | Term Term + +newtype CommandOutput = Piped (CommandArguments,String) ---- errors, etc -- ** Converting command output -fromStrings ss = Piped (map stringAsExpr ss, unlines ss) -fromExprs es = Piped (es,unlines (map (H.showExpr []) es)) -fromString s = Piped ([stringAsExpr s], s) -pipeWithMessage es msg = Piped (es,msg) -pipeMessage msg = Piped ([],msg) -pipeExprs es = Piped (es,[]) -- only used in emptyCommandInfo -void = Piped ([],"") +fromStrings ss = Piped (Strings ss, unlines ss) +fromExprs es = Piped (Exprs es,unlines (map (H.showExpr []) es)) +fromString s = Piped (Strings [s], s) +pipeWithMessage es msg = Piped (Exprs es,msg) +pipeMessage msg = Piped (Exprs [],msg) +pipeExprs es = Piped (Exprs es,[]) -- only used in emptyCommandInfo +void = Piped (Exprs [],"") stringAsExpr = H.ELit . H.LStr -- should be a pattern macro -- ** Converting command input -toStrings = map showAsString +toStrings args = + case args of + Strings ss -> ss + Exprs es -> zipWith showAsString (True:repeat False) es + Term t -> [render t] where - showAsString t = case t of - H.ELit (H.LStr s) -> s - _ -> "\n" ++ H.showExpr [] t ---newline needed in other cases than the first + showAsString first t = + case t of + H.ELit (H.LStr s) -> s + _ -> ['\n'|not first] ++ + H.showExpr [] t ---newline needed in other cases than the first + +toExprs args = + case args of + Exprs es -> es + Strings ss -> map stringAsExpr ss + Term t -> [stringAsExpr (render t)] + +toTerm args = + case args of + Term t -> t + Strings ss -> string2term $ unwords ss -- hmm + Exprs es -> string2term $ unwords $ map (H.showExpr []) es -- hmm -- ** Creating documentation diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index adea48857..feaeb0f33 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -61,7 +61,8 @@ pgfCommands = Map.fromList [ "by the view flag. The target format is png, unless overridden by the", "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick)." ], - exec = getEnv $ \ opts es (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do + let es = toExprs arg let langs = optLangs pgf opts if isOpt "giza" opts then do @@ -182,11 +183,11 @@ pgfCommands = Map.fromList [ ("depth","the maximum generation depth"), ("probs", "file with biased probabilities (format 'f 0.4' one by line)") ], - exec = getEnv $ \ opts xs (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do pgf <- optProbs opts (optRestricted opts pgf) gen <- newStdGen let dp = valIntOpts "depth" 4 opts - let ts = case mexp xs of + let ts = case mexp (toExprs arg) of Just ex -> generateRandomFromDepth gen pgf ex (Just dp) Nothing -> generateRandomDepth gen pgf (optType pgf opts) (Just dp) returnFromExprs $ take (optNum opts) ts @@ -212,10 +213,10 @@ pgfCommands = 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 = getEnv $ \ opts xs (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do let pgfr = optRestricted opts pgf let dp = valIntOpts "depth" 4 opts - let ts = case mexp xs of + let ts = case mexp (toExprs arg) of Just ex -> generateFromDepth pgfr ex (Just dp) Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp) returnFromExprs $ take (optNumInf opts) ts @@ -266,7 +267,7 @@ pgfCommands = 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 = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings $ optLins pgf opts ts, + exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings . optLins pgf opts $ toExprs ts, options = [ ("all", "show all forms and variants, one by line (cf. l -list)"), ("bracket","show tree structure with brackets and paths to nodes"), @@ -291,7 +292,7 @@ pgfCommands = Map.fromList [ examples = [ mkEx "l -lang=LangSwe,LangNor -chunks ? a b (? c d)" ], - exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings $ optLins pgf (opts ++ [OOpt "chunks"]) ts, + exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings $ optLins pgf (opts ++ [OOpt "chunks"]) (toExprs ts), options = [ ("treebank","show the tree and tag linearizations with language names") ] ++ stringOpOptions, @@ -332,11 +333,11 @@ pgfCommands = Map.fromList [ longname = "morpho_quiz", synopsis = "start a morphology quiz", syntax = "mq (-cat=CAT)? (-probs=FILE)? TREE?", - exec = getEnv $ \ opts xs (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do let lang = optLang pgf opts let typ = optType pgf opts pgf <- optProbs opts pgf - let mt = mexp xs + let mt = mexp (toExprs arg) restricted $ morphologyQuiz mt pgf lang typ return void, flags = [ @@ -427,8 +428,8 @@ pgfCommands = Map.fromList [ mkEx "pt -compute (plus one two) -- compute value", mkEx "p \"4 dogs love 5 cats\" | pt -transfer=digits2numeral | l -- four...five..." ], - exec = getEnv $ \ opts ts (Env pgf mos) -> - returnFromExprs . takeOptNum opts $ treeOps pgf opts ts, + exec = getEnv $ \ opts arg (Env pgf mos) -> + returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg, options = treeOpOptions undefined{-pgf-}, flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-} }), @@ -481,7 +482,8 @@ pgfCommands = 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 = getEnv $ \ opts ts (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do + let ts = toExprs arg pgf <- optProbs opts pgf let tds = rankTreesByProbs pgf ts if isOpt "v" opts @@ -503,11 +505,11 @@ pgfCommands = Map.fromList [ longname = "translation_quiz", syntax = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?", synopsis = "start a translation quiz", - exec = getEnv $ \ opts xs (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do let from = optLangFlag "from" pgf opts let to = optLangFlag "to" pgf opts let typ = optType pgf opts - let mt = mexp xs + let mt = mexp (toExprs arg) pgf <- optProbs opts pgf restricted $ translationQuiz mt pgf from to typ return void, @@ -542,7 +544,8 @@ pgfCommands = Map.fromList [ "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).", "See also 'vp -showdep' for another visualization of dependencies." ], - exec = getEnv $ \ opts es (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do + let es = toExprs arg let debug = isOpt "v" opts let file = valStrOpts "file" "" opts let outp = valStrOpts "output" "dot" opts @@ -552,7 +555,7 @@ pgfCommands = Map.fromList [ let lang = optLang pgf opts let grphs = map (graphvizDependencyTree outp debug mlab Nothing pgf lang) es if isOpt "conll2latex" opts - then return $ fromString $ conlls2latexDoc $ stanzas $ unlines $ toStrings es + then return $ fromString $ conlls2latexDoc $ stanzas $ unlines $ toStrings arg else if isFlag "view" opts && valStrOpts "output" "" opts == "latex" then do let view = optViewGraph opts @@ -596,7 +599,8 @@ pgfCommands = Map.fromList [ "by the view flag. The target format is png, unless overridden by the", "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick)." ], - exec = getEnv $ \ opts es (Env pgf mos) -> do + exec = getEnv $ \ opts arg (Env pgf mos) -> do + let es = toExprs arg let lang = optLang pgf opts let gvOptions = GraphvizOptions {noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts), noFun = isOpt "nofun" opts || not (isOpt "showfun" opts), @@ -661,7 +665,8 @@ pgfCommands = Map.fromList [ "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).", "With option -mk, use for showing library style function names of form 'mkC'." ], - exec = getEnv $ \ opts es (Env pgf mos) -> + exec = getEnv $ \ opts arg (Env pgf mos) -> + let es = toExprs arg in if isOpt "mk" opts then return $ fromString $ unlines $ map (tree2mk pgf) es else if isOpt "api" opts @@ -707,7 +712,7 @@ pgfCommands = Map.fromList [ "metavariables and the type of the expression." ], exec = getEnv $ \ opts arg (Env pgf mos) -> do - case arg of + case toExprs arg of [EFun id] -> case Map.lookup id (funs (abstract pgf)) of Just fd -> do putStrLn $ render (ppFun id fd) let (_,_,_,prob) = fd @@ -748,7 +753,10 @@ pgfCommands = Map.fromList [ fromParse opts = foldr (joinPiped . fromParse1 opts) void - joinPiped (Piped (es1,ms1)) (Piped (es2,ms2)) = Piped (es1++es2,ms1+++-ms2) + joinPiped (Piped (es1,ms1)) (Piped (es2,ms2)) = Piped (jA es1 es2,ms1+++-ms2) + where + jA (Exprs es1) (Exprs es2) = Exprs (es1++es2) + -- ^ fromParse1 always output Exprs fromParse1 opts (s,(po,bs)) | isOpt "bracket" opts = pipeMessage (showBracketedString bs) diff --git a/src/compiler/GF/Command/CommonCommands.hs b/src/compiler/GF/Command/CommonCommands.hs index 0dce8e894..0cafad531 100644 --- a/src/compiler/GF/Command/CommonCommands.hs +++ b/src/compiler/GF/Command/CommonCommands.hs @@ -179,7 +179,7 @@ commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [ longname = "to_trie", syntax = "to_trie", synopsis = "combine a list of trees into a trie", - exec = \ _ ts -> return . fromString $ trie ts + exec = \ _ -> return . fromString . trie . toExprs }), ("ut", emptyCommandInfo { longname = "unicode_table", diff --git a/src/compiler/GF/Command/Help.hs b/src/compiler/GF/Command/Help.hs index 2a736088d..eb50c6d35 100644 --- a/src/compiler/GF/Command/Help.hs +++ b/src/compiler/GF/Command/Help.hs @@ -1,6 +1,6 @@ module GF.Command.Help where import GF.Command.Messages -import GF.Command.Abstract(isOpt,getCommandOp,showExpr) +import GF.Command.Abstract(isOpt,getCommandOp) import GF.Command.CommandInfo import GF.Data.Operations((++++)) @@ -75,13 +75,13 @@ helpCommand allCommands = ("license","show copyright and license information"), ("t2t","output help in txt2tags format") ], - exec = \opts ts -> + exec = \opts args -> let - msg = case ts of + msg = case toStrings args of _ | isOpt "changes" opts -> changesMsg _ | isOpt "coding" opts -> codingMsg _ | isOpt "license" opts -> licenseMsg - [t] -> let co = getCommandOp (showExpr [] t) in + [s] -> let co = getCommandOp s in case Map.lookup co allCommands of Just info -> commandHelp' opts True (co,info) _ -> "command not found" diff --git a/src/compiler/GF/Command/Interpreter.hs b/src/compiler/GF/Command/Interpreter.hs index abd06c3a1..bcb15d238 100644 --- a/src/compiler/GF/Command/Interpreter.hs +++ b/src/compiler/GF/Command/Interpreter.hs @@ -33,29 +33,31 @@ interpretPipe env cs = do putStrLnE s return () where - intercs [] treess = return treess - intercs (c:cs) (Piped (trees,_)) = interc c trees >>= intercs cs + intercs [] args = return args + intercs (c:cs) (Piped (args,_)) = interc c args >>= intercs cs - interc comm@(Command co opts arg) es = + interc comm@(Command co opts arg) args = case co of '%':f -> case Map.lookup f (commandmacros env) of Just css -> - do es <- getCommandTrees env False arg es - mapM_ (interpretPipe env) (appLine es css) + do args <- getCommandTrees env False arg args + mapM_ (interpretPipe env) (appLine args css) return void Nothing -> do putStrLnE $ "command macro " ++ co ++ " not interpreted" return void - _ -> interpret env es comm + _ -> interpret env args comm appLine = map . map . appCommand -- | macro definition applications: replace ?i by (exps !! i) -appCommand :: [Expr] -> Command -> Command -appCommand xs c@(Command i os arg) = case arg of +appCommand :: CommandArguments -> Command -> Command +appCommand args c@(Command i os arg) = case arg of AExpr e -> Command i os (AExpr (app e)) _ -> c where + xs = toExprs args + app e = case e of EAbs b x e -> EAbs b x (app e) EApp e1 e2 -> EApp (app e1) (app e2) @@ -97,14 +99,15 @@ checkOpts info opts = os -> fail $ "options not interpreted: " ++ unwords os --getCommandTrees :: CommandEnv -> Bool -> Argument -> [Expr] -> Either String [Expr] -getCommandTrees env needsTypeCheck a es = +getCommandTrees env needsTypeCheck a args = case a of AMacro m -> case Map.lookup m (expmacros env) of Just e -> one e - _ -> return [] -- report error? + _ -> return (Exprs []) -- report error? AExpr e -> if needsTypeCheck then one =<< typeCheckArg e else one e - ANoArg -> return es -- use piped + ATerm t -> return (Term t) + ANoArg -> return args -- use piped where - one e = return [e] -- ignore piped + one e = return (Exprs [e]) -- ignore piped diff --git a/src/compiler/GF/Command/Parse.hs b/src/compiler/GF/Command/Parse.hs index 0967f30e9..9ead12e7e 100644 --- a/src/compiler/GF/Command/Parse.hs +++ b/src/compiler/GF/Command/Parse.hs @@ -1,6 +1,7 @@ module GF.Command.Parse(readCommandLine, pCommand) where import PGF(pExpr,pIdent) +import GF.Grammar.Parser(runPartial,pTerm) import GF.Command.Abstract import Data.Char(isDigit,isSpace) @@ -21,10 +22,10 @@ pCommandLine = pPipe = sepBy1 (skipSpaces >> pCommand) (skipSpaces >> char '|') pCommand = (do - cmd <- pIdent <++ (char '%' >> pIdent >>= return . ('%':)) + cmd <- pIdent <++ (char '%' >> fmap ('%':) pIdent) skipSpaces opts <- sepBy pOption skipSpaces - arg <- pArgument + arg <- if getCommandOp cmd == "cc" then pArgTerm else pArgument return (Command cmd opts arg) ) <++ (do @@ -55,6 +56,12 @@ pArgument = <++ (skipSpaces >> char '%' >> fmap AMacro pIdent)) +pArgTerm = ATerm `fmap` readS_to_P sTerm + where + sTerm s = case runPartial pTerm s of + Right (s,t) -> [(t,s)] + _ -> [] + pSystemCommand = (char '"' >> (manyTill (pEsc <++ get) (char '"'))) <++