generalized pt -transfer so that it goes into subtrees (naive implementation in TreeOperations; using PGF.Expr.match would be better); example given in 'h pt'

2 files changed, 18 insertions, 3 deletions

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index 1e69c1df2..1290666cb 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -649,7 +649,8 @@ allCommands env@(pgf, mos) = Map.fromList [
        "are type checking and semantic computation."
        ], 
      examples = [
-       "pt -compute (plus one two)   -- compute value"
+       "pt -compute (plus one two)                               -- compute value",
+       "p \"4 dogs love 5 cats\" | pt -transfer=digits2numeral | l -- four...five..."
        ],
      exec = \opts -> 
             returnFromExprs . takeOptNum opts . treeOps opts,
diff --git a/src/compiler/GF/Command/TreeOperations.hs b/src/compiler/GF/Command/TreeOperations.hs
index 941f03782..b9ec7f538 100644
--- a/src/compiler/GF/Command/TreeOperations.hs
+++ b/src/compiler/GF/Command/TreeOperations.hs
@@ -16,8 +16,8 @@ allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]
 allTreeOps pgf = [
    ("compute",("compute by using semantic definitions (def)",
       Left  $ map (compute pgf))),
-   ("transfer",("syntactic transfer by applying function and computing",
-      Right $ \f -> map (compute pgf . EApp (EFun f)))),
+   ("transfer",("syntactic transfer by applying function, recursively in subtrees",
+      Right $ \f -> map (transfer pgf f))),
    ("paraphrase",("paraphrase by using semantic definitions (def)",
       Left  $ nub . concatMap (paraphrase pgf))),
    ("smallest",("sort trees from smallest to largest, in number of nodes",
@@ -30,3 +30,17 @@ smallest = sortBy (\t u -> compare (size t) (size u)) where
     EAbs _ _ e -> size e + 1
     EApp e1 e2 -> size e1 + size e2 + 1
     _ -> 1
+
+
+--- simple-minded transfer; should use PGF.Expr.match
+
+transfer :: PGF -> CId -> Expr -> Expr
+transfer pgf f e = case transf e of
+  v | v /= appf e -> v
+  _ -> case e of
+    EApp g a -> EApp (transfer pgf f g) (transfer pgf f a)
+    _ -> e
+ where
+  appf = EApp (EFun f)
+  transf = compute pgf . appf
+