added exprSize and exprFunctions in the Haskell runtime too and use them in TreeOperations

2 files changed, 21 insertions, 15 deletions

diff --git a/src/compiler/GF/Command/TreeOperations.hs b/src/compiler/GF/Command/TreeOperations.hs
index 221881f44..d9c61ccdf 100644
--- a/src/compiler/GF/Command/TreeOperations.hs
+++ b/src/compiler/GF/Command/TreeOperations.hs
@@ -4,7 +4,7 @@ module GF.Command.TreeOperations (
   treeChunks
   ) where
 
-import PGF(PGF,CId,compute,unApp)
+import PGF(PGF,CId,compute,unApp,mkApp,exprSize,exprFunctions)
 import PGF.Internal(Expr(..),unAppForm)
 import Data.List
 
@@ -28,18 +28,14 @@ allTreeOps pgf = [
    ("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest",
       Left  $ concatMap subtrees)),
    ("funs",("return all fun functions appearing in the tree, with duplications",
-      Left  $ concatMap funNodes))
+      Left  $ \es -> [mkApp f [] | e <- es, f <- exprFunctions e]))
   ]
 
 largest :: [Expr] -> [Expr]
 largest = reverse . smallest
 
 smallest :: [Expr] -> [Expr]
-smallest = sortBy (\t u -> compare (size t) (size u)) where
-  size t = case t of
-    EAbs _ _ e -> size e + 1
-    EApp e1 e2 -> size e1 + size e2 + 1
-    _ -> 1
+smallest = sortBy (\t u -> compare (exprSize t) (exprSize u))
 
 treeChunks :: Expr -> [Expr]
 treeChunks = snd . cks where
@@ -55,13 +51,6 @@ subtrees t = t : case unApp t of
   Just (f,ts) -> concatMap subtrees ts
   _ -> []  -- don't go under abstractions
 
-funNodes :: Expr -> [Expr]
-funNodes t = case t of
-   EAbs _ _ e -> funNodes e
-   EApp e1 e2 -> funNodes e1 ++ funNodes e2
-   EFun _ -> [t]
-   _ -> []  -- not literals, metas, etc
-
 --- simple-minded transfer; should use PGF.Expr.match
 
 transfer :: PGF -> CId -> Expr -> Expr
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index 42519fb63..1c425a565 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -54,7 +54,7 @@ module PGF(
            mkFloat,  unFloat,
            mkMeta,   unMeta,
            -- extra
-           pExpr,
+           pExpr, exprSize, exprFunctions,
 
            -- * Operations
            -- ** Linearization
@@ -314,6 +314,23 @@ functionType pgf fun =
 compute :: PGF -> Expr -> Expr
 compute pgf = PGF.Data.normalForm (funs (abstract pgf),const Nothing) 0 []
 
+exprSize :: Expr -> Int
+exprSize (EAbs _ _ e) = exprSize e
+exprSize (EApp e1 e2) = exprSize e1 + exprSize e2
+exprSize (ETyped e ty)= exprSize e
+exprSize (EImplArg e) = exprSize e
+exprSize _            = 1
+
+exprFunctions :: Expr -> [CId]
+exprFunctions (EAbs _ _ e) = exprFunctions e
+exprFunctions (EApp e1 e2) = exprFunctions e1 ++ exprFunctions e2
+exprFunctions (ETyped e ty)= exprFunctions e
+exprFunctions (EImplArg e) = exprFunctions e
+exprFunctions (EFun f)     = [f]
+exprFunctions _            = []
+
+--exprFunctions :: Expr -> [Fun]
+
 browse :: PGF -> CId -> Maybe (String,[CId],[CId])
 browse pgf id = fmap (\def -> (def,producers,consumers)) definition
   where