mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
added pt -transfer
This commit is contained in:
@@ -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
|
||||||
|
|||||||
@@ -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]
|
||||||
|
|||||||
Reference in New Issue
Block a user