From 01a8e1b88f190a6170512efd303981e98b4b3134 Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Tue, 5 Sep 2017 10:29:02 +0200
Subject: [PATCH] GF.Command.TreeOperations is now independent from the
 runtime's internals

---
 src/compiler/GF/Command/TreeOperations.hs | 31 ++++++-----------------
 src/runtime/haskell/PGF.hs                |  2 +-
 src/runtime/haskell/PGF/Expr.hs           |  8 +++---
 3 files changed, 13 insertions(+), 28 deletions(-)

diff --git a/src/compiler/GF/Command/TreeOperations.hs b/src/compiler/GF/Command/TreeOperations.hs
index d9c61ccdf..fc0e6616d 100644
--- a/src/compiler/GF/Command/TreeOperations.hs
+++ b/src/compiler/GF/Command/TreeOperations.hs
@@ -4,8 +4,7 @@ module GF.Command.TreeOperations (
   treeChunks
   ) where
 
-import PGF(PGF,CId,compute,unApp,mkApp,exprSize,exprFunctions)
-import PGF.Internal(Expr(..),unAppForm)
+import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
 import Data.List
 
 type TreeOp = [Expr] -> [Expr]
@@ -17,8 +16,6 @@ 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, recursively in subtrees",
-      Right $ \f -> map (transfer pgf f))),
    ("largest",("sort trees from largest to smallest, in number of nodes",
       Left  $ largest)),
    ("nub",("remove duplicate trees",
@@ -39,27 +36,15 @@ smallest = sortBy (\t u -> compare (exprSize t) (exprSize u))
 
 treeChunks :: Expr -> [Expr]
 treeChunks = snd . cks where
-  cks t = case unAppForm t of
-    (EFun f, ts) -> case unzip (map cks ts) of 
-       (bs,_) | and bs      -> (True, [t])
-       (_,cts)              -> (False,concat cts)
-    (EMeta _, ts)           -> (False,concatMap (snd . cks) ts)
-    _                       -> (True, [t])
+  cks t = 
+    case unapply t of
+      (t, ts) -> case unMeta t of
+                   Just _  -> (False,concatMap (snd . cks) ts)
+                   Nothing -> case unzip (map cks ts) of
+                                (bs,_) | and bs      -> (True, [t])
+                                (_,cts)              -> (False,concat cts)
 
 subtrees :: Expr -> [Expr]
 subtrees t = t : case unApp t of
   Just (f,ts) -> concatMap subtrees ts
   _ -> []  -- don't go under abstractions
-
---- 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
-
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index 1c425a565..83d9102c3 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -47,7 +47,7 @@ module PGF(
            Expr,
            showExpr, readExpr,
            mkAbs,    unAbs,
-           mkApp,    unApp,
+           mkApp,    unApp, unapply,
            mkStr,    unStr,
            mkInt,    unInt,
            mkDouble, unDouble,
diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs
index 331a69d90..d015f18e0 100644
--- a/src/runtime/haskell/PGF/Expr.hs
+++ b/src/runtime/haskell/PGF/Expr.hs
@@ -2,7 +2,7 @@ module PGF.Expr(Tree, BindType(..), Expr(..), Literal(..), Patt(..), Equation(..
                 readExpr, showExpr, pExpr, pBinds, ppExpr, ppPatt, pattScope,
 
                 mkAbs,    unAbs,
-                mkApp,    unApp, unAppForm,
+                mkApp,    unApp, unapply,
                 mkStr,    unStr,
                 mkInt,    unInt,
                 mkDouble, unDouble,
@@ -108,13 +108,13 @@ mkApp f es = foldl EApp (EFun f) es
 
 -- | Decomposes an expression into application of function
 unApp :: Expr -> Maybe (CId,[Expr])
-unApp e = case unAppForm e of
+unApp e = case unapply e of
   (EFun f,es) -> Just (f,es)
   _           -> Nothing
 
 -- | Decomposes an expression into an application of a constructor such as a constant or a metavariable
-unAppForm :: Expr -> (Expr,[Expr])
-unAppForm = extract []
+unapply :: Expr -> (Expr,[Expr])
+unapply = extract []
   where
     extract es f@(EFun _)   = (f,es)
     extract es (EApp e1 e2) = extract (e2:es) e1