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

View File

@@ -3,25 +3,25 @@ module GF.Command.TreeOperations (
allTreeOps allTreeOps
) where ) where
import GF.Compile.TypeCheck
import PGF import PGF
import PGF.Data import PGF.Data
import Data.List import Data.List
type TreeOp = [Expr] -> [Expr] 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 treeOp pgf f = fmap snd $ lookup f $ allTreeOps pgf
allTreeOps :: PGF -> [(String,(String,TreeOp))] allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]
allTreeOps pgf = [ allTreeOps pgf = [
("compute",("compute by using semantic definitions (def)", ("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)", ("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",("sort trees from smallest to largest, in number of nodes",
smallest)) Left $ smallest))
] ]
smallest :: [Expr] -> [Expr] smallest :: [Expr] -> [Expr]