added pt -transfer

This commit is contained in:
krasimir
2009-09-17 15:47:06 +00:00
parent d9365c6cf0
commit e55b70a9af
2 changed files with 18 additions and 13 deletions

View File

@@ -1,3 +1,5 @@
{-# LANGUAGE PatternGuards #-}
module GF.Command.Commands (
allCommands,
lookCommand,
@@ -471,11 +473,11 @@ allCommands cod env@(pgf, mos) = Map.fromList [
"are type checking and semantic computation."
],
examples = [
"pt -compute (plus one two) -- compute value",
"p \"foo\" | pt -typecheck -- type check parse results"
"pt -compute (plus one two) -- compute value"
],
exec = \opts -> returnFromExprs . treeOps (map prOpt opts),
options = treeOpOptions pgf
exec = \opts -> returnFromExprs . treeOps opts,
options = treeOpOptions pgf,
flags = treeOpFlags pgf
}),
("q", emptyCommandInfo {
longname = "quit",
@@ -748,7 +750,9 @@ allCommands cod env@(pgf, mos) = Map.fromList [
_ -> Nothing
treeOps opts s = foldr app s (reverse opts) where
app f = maybe id id (treeOp pgf f)
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
showAsString t = case t of
ELit (LStr s) -> s
@@ -777,7 +781,8 @@ stringOpOptions = sort $ [
("to_" ++ p, "from GF " ++ n ++ " transliteration to unicode")] |
(p,n) <- transliterationPrintNames]
treeOpOptions pgf = [(op,expl) | (op,(expl,_)) <- allTreeOps pgf]
treeOpOptions pgf = [(op,expl) | (op,(expl,Left _)) <- allTreeOps pgf]
treeOpFlags pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf]
translationQuiz :: Encoding -> PGF -> Language -> Language -> Type -> IO ()
translationQuiz cod pgf ig og typ = do

View File

@@ -3,25 +3,25 @@ module GF.Command.TreeOperations (
allTreeOps
) where
import GF.Compile.TypeCheck
import PGF
import PGF.Data
import Data.List
type TreeOp = [Expr] -> [Expr]
treeOp :: PGF -> String -> Maybe TreeOp
treeOp :: PGF -> String -> Maybe (Either TreeOp (CId -> TreeOp))
treeOp pgf f = fmap snd $ lookup f $ allTreeOps pgf
allTreeOps :: PGF -> [(String,(String,TreeOp))]
allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]
allTreeOps pgf = [
("compute",("compute by using semantic definitions (def)",
map (compute pgf))),
Left $ map (compute pgf))),
("transfer",("syntactic transfer by applying function and computing",
Right $ \f -> map (compute pgf . EApp (EFun f)))),
("paraphrase",("paraphrase by using semantic definitions (def)",
nub . concatMap (paraphrase pgf))),
Left $ nub . concatMap (paraphrase pgf))),
("smallest",("sort trees from smallest to largest, in number of nodes",
smallest))
Left $ smallest))
]
smallest :: [Expr] -> [Expr]