GF.Command.TreeOperations is now independent from the runtime's internals

This commit is contained in:
Krasimir Angelov
2017-09-05 10:29:02 +02:00
parent 13d8045814
commit 01a8e1b88f
3 changed files with 13 additions and 28 deletions

View File

@@ -4,8 +4,7 @@ module GF.Command.TreeOperations (
treeChunks treeChunks
) where ) where
import PGF(PGF,CId,compute,unApp,mkApp,exprSize,exprFunctions) import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
import PGF.Internal(Expr(..),unAppForm)
import Data.List import Data.List
type TreeOp = [Expr] -> [Expr] type TreeOp = [Expr] -> [Expr]
@@ -17,8 +16,6 @@ allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]
allTreeOps pgf = [ allTreeOps pgf = [
("compute",("compute by using semantic definitions (def)", ("compute",("compute by using semantic definitions (def)",
Left $ map (compute pgf))), 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", ("largest",("sort trees from largest to smallest, in number of nodes",
Left $ largest)), Left $ largest)),
("nub",("remove duplicate trees", ("nub",("remove duplicate trees",
@@ -39,27 +36,15 @@ smallest = sortBy (\t u -> compare (exprSize t) (exprSize u))
treeChunks :: Expr -> [Expr] treeChunks :: Expr -> [Expr]
treeChunks = snd . cks where treeChunks = snd . cks where
cks t = case unAppForm t of cks t =
(EFun f, ts) -> case unzip (map cks ts) of 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]) (bs,_) | and bs -> (True, [t])
(_,cts) -> (False,concat cts) (_,cts) -> (False,concat cts)
(EMeta _, ts) -> (False,concatMap (snd . cks) ts)
_ -> (True, [t])
subtrees :: Expr -> [Expr] subtrees :: Expr -> [Expr]
subtrees t = t : case unApp t of 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
--- 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

View File

@@ -47,7 +47,7 @@ module PGF(
Expr, Expr,
showExpr, readExpr, showExpr, readExpr,
mkAbs, unAbs, mkAbs, unAbs,
mkApp, unApp, mkApp, unApp, unapply,
mkStr, unStr, mkStr, unStr,
mkInt, unInt, mkInt, unInt,
mkDouble, unDouble, mkDouble, unDouble,

View File

@@ -2,7 +2,7 @@ module PGF.Expr(Tree, BindType(..), Expr(..), Literal(..), Patt(..), Equation(..
readExpr, showExpr, pExpr, pBinds, ppExpr, ppPatt, pattScope, readExpr, showExpr, pExpr, pBinds, ppExpr, ppPatt, pattScope,
mkAbs, unAbs, mkAbs, unAbs,
mkApp, unApp, unAppForm, mkApp, unApp, unapply,
mkStr, unStr, mkStr, unStr,
mkInt, unInt, mkInt, unInt,
mkDouble, unDouble, mkDouble, unDouble,
@@ -108,13 +108,13 @@ mkApp f es = foldl EApp (EFun f) es
-- | Decomposes an expression into application of function -- | Decomposes an expression into application of function
unApp :: Expr -> Maybe (CId,[Expr]) unApp :: Expr -> Maybe (CId,[Expr])
unApp e = case unAppForm e of unApp e = case unapply e of
(EFun f,es) -> Just (f,es) (EFun f,es) -> Just (f,es)
_ -> Nothing _ -> Nothing
-- | Decomposes an expression into an application of a constructor such as a constant or a metavariable -- | Decomposes an expression into an application of a constructor such as a constant or a metavariable
unAppForm :: Expr -> (Expr,[Expr]) unapply :: Expr -> (Expr,[Expr])
unAppForm = extract [] unapply = extract []
where where
extract es f@(EFun _) = (f,es) extract es f@(EFun _) = (f,es)
extract es (EApp e1 e2) = extract (e2:es) e1 extract es (EApp e1 e2) = extract (e2:es) e1