summaryrefslogtreecommitdiff
path: root/src/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler')
-rw-r--r--src/compiler/GF/Command/Abstract.hs4
-rw-r--r--src/compiler/GF/Command/CommandInfo.hs51
-rw-r--r--src/compiler/GF/Command/Commands.hs48
-rw-r--r--src/compiler/GF/Command/CommonCommands.hs2
-rw-r--r--src/compiler/GF/Command/Help.hs8
-rw-r--r--src/compiler/GF/Command/Interpreter.hs27
-rw-r--r--src/compiler/GF/Command/Parse.hs11
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 '"')))
<++
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:29:12 +0000