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