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

GF shell: fix a parsing problem with the cc command

Browse Source 
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.
This commit is contained in:
hallgren
2016-04-07 13:40:05 +00:00
parent 6d5ecf7c3f
commit 58cd043fa8
7 changed files with 97 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Command/Abstract.hs
View File

@@ -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)

51
src/compiler/GF/Command/CommandInfo.hs
View File

@@ -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

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

@@ -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)

2
src/compiler/GF/Command/CommonCommands.hs
View File

@@ -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",

8
src/compiler/GF/Command/Help.hs
View File

@@ -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"

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

@@ -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

11
src/compiler/GF/Command/Parse.hs
View File

@@ -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 '"')))
<++