From b8a7e50107ecc5a5b9cd1dbad6460a5fb3fbbf67 Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Thu, 17 Sep 2009 15:47:06 +0000
Subject: [PATCH] added pt -transfer

---
 src/GF/Command/Commands.hs       | 17 +++++++++++------
 src/GF/Command/TreeOperations.hs | 14 +++++++-------
 2 files changed, 18 insertions(+), 13 deletions(-)

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index 584535279..e3378ed1e 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -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
diff --git a/src/GF/Command/TreeOperations.hs b/src/GF/Command/TreeOperations.hs
index 0489dd23f..73cef05b2 100644
--- a/src/GF/Command/TreeOperations.hs
+++ b/src/GF/Command/TreeOperations.hs
@@ -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]