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

This commit is contained in:
Krasimir Angelov
2017-09-05 10:16:48 +02:00
parent 5ed0e3ae7f
commit 13d8045814
2 changed files with 21 additions and 15 deletions

View File

@@ -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

View File

@@ -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