mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-23 01:52:50 -06:00
GF.Command.TreeOperations is now independent from the runtime's internals
This commit is contained in:
@@ -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
|
||||||
(bs,_) | and bs -> (True, [t])
|
(t, ts) -> case unMeta t of
|
||||||
(_,cts) -> (False,concat cts)
|
Just _ -> (False,concatMap (snd . cks) ts)
|
||||||
(EMeta _, ts) -> (False,concatMap (snd . cks) ts)
|
Nothing -> case unzip (map cks ts) of
|
||||||
_ -> (True, [t])
|
(bs,_) | and bs -> (True, [t])
|
||||||
|
(_,cts) -> (False,concat cts)
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
|
|||||||
@@ -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,
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user