mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-25 18:58:56 -06:00
added exprSize and exprFunctions in the Haskell runtime too and use them in TreeOperations
This commit is contained in:
@@ -4,7 +4,7 @@ module GF.Command.TreeOperations (
|
|||||||
treeChunks
|
treeChunks
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import PGF(PGF,CId,compute,unApp)
|
import PGF(PGF,CId,compute,unApp,mkApp,exprSize,exprFunctions)
|
||||||
import PGF.Internal(Expr(..),unAppForm)
|
import PGF.Internal(Expr(..),unAppForm)
|
||||||
import Data.List
|
import Data.List
|
||||||
|
|
||||||
@@ -28,18 +28,14 @@ allTreeOps pgf = [
|
|||||||
("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest",
|
("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest",
|
||||||
Left $ concatMap subtrees)),
|
Left $ concatMap subtrees)),
|
||||||
("funs",("return all fun functions appearing in the tree, with duplications",
|
("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 :: [Expr] -> [Expr]
|
||||||
largest = reverse . smallest
|
largest = reverse . smallest
|
||||||
|
|
||||||
smallest :: [Expr] -> [Expr]
|
smallest :: [Expr] -> [Expr]
|
||||||
smallest = sortBy (\t u -> compare (size t) (size u)) where
|
smallest = sortBy (\t u -> compare (exprSize t) (exprSize u))
|
||||||
size t = case t of
|
|
||||||
EAbs _ _ e -> size e + 1
|
|
||||||
EApp e1 e2 -> size e1 + size e2 + 1
|
|
||||||
_ -> 1
|
|
||||||
|
|
||||||
treeChunks :: Expr -> [Expr]
|
treeChunks :: Expr -> [Expr]
|
||||||
treeChunks = snd . cks where
|
treeChunks = snd . cks where
|
||||||
@@ -55,13 +51,6 @@ subtrees t = t : case unApp t of
|
|||||||
Just (f,ts) -> concatMap subtrees ts
|
Just (f,ts) -> concatMap subtrees ts
|
||||||
_ -> [] -- don't go under abstractions
|
_ -> [] -- 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
|
--- simple-minded transfer; should use PGF.Expr.match
|
||||||
|
|
||||||
transfer :: PGF -> CId -> Expr -> Expr
|
transfer :: PGF -> CId -> Expr -> Expr
|
||||||
|
|||||||
@@ -54,7 +54,7 @@ module PGF(
|
|||||||
mkFloat, unFloat,
|
mkFloat, unFloat,
|
||||||
mkMeta, unMeta,
|
mkMeta, unMeta,
|
||||||
-- extra
|
-- extra
|
||||||
pExpr,
|
pExpr, exprSize, exprFunctions,
|
||||||
|
|
||||||
-- * Operations
|
-- * Operations
|
||||||
-- ** Linearization
|
-- ** Linearization
|
||||||
@@ -314,6 +314,23 @@ functionType pgf fun =
|
|||||||
compute :: PGF -> Expr -> Expr
|
compute :: PGF -> Expr -> Expr
|
||||||
compute pgf = PGF.Data.normalForm (funs (abstract pgf),const Nothing) 0 []
|
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 -> CId -> Maybe (String,[CId],[CId])
|
||||||
browse pgf id = fmap (\def -> (def,producers,consumers)) definition
|
browse pgf id = fmap (\def -> (def,producers,consumers)) definition
|
||||||
where
|
where
|
||||||
|
|||||||
Reference in New Issue
Block a user