diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Command/TreeOperations.hs | 31 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF.hs | 2 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Expr.hs | 8 |
3 files changed, 13 insertions, 28 deletions
diff --git a/src/compiler/GF/Command/TreeOperations.hs b/src/compiler/GF/Command/TreeOperations.hs index d9c61ccdf..fc0e6616d 100644 --- a/src/compiler/GF/Command/TreeOperations.hs +++ b/src/compiler/GF/Command/TreeOperations.hs @@ -4,8 +4,7 @@ module GF.Command.TreeOperations ( treeChunks ) where -import PGF(PGF,CId,compute,unApp,mkApp,exprSize,exprFunctions) -import PGF.Internal(Expr(..),unAppForm) +import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions) import Data.List type TreeOp = [Expr] -> [Expr] @@ -17,8 +16,6 @@ allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))] allTreeOps pgf = [ ("compute",("compute by using semantic definitions (def)", 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", Left $ largest)), ("nub",("remove duplicate trees", @@ -39,27 +36,15 @@ smallest = sortBy (\t u -> compare (exprSize t) (exprSize u)) treeChunks :: Expr -> [Expr] treeChunks = snd . cks where - cks t = case unAppForm t of - (EFun f, ts) -> case unzip (map cks ts) of - (bs,_) | and bs -> (True, [t]) - (_,cts) -> (False,concat cts) - (EMeta _, ts) -> (False,concatMap (snd . cks) ts) - _ -> (True, [t]) + cks t = + 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]) + (_,cts) -> (False,concat cts) subtrees :: Expr -> [Expr] subtrees t = t : case unApp t of Just (f,ts) -> concatMap subtrees ts _ -> [] -- 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 - diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index 1c425a565..83d9102c3 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -47,7 +47,7 @@ module PGF( Expr, showExpr, readExpr, mkAbs, unAbs, - mkApp, unApp, + mkApp, unApp, unapply, mkStr, unStr, mkInt, unInt, mkDouble, unDouble, diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs index 331a69d90..d015f18e0 100644 --- a/src/runtime/haskell/PGF/Expr.hs +++ b/src/runtime/haskell/PGF/Expr.hs @@ -2,7 +2,7 @@ module PGF.Expr(Tree, BindType(..), Expr(..), Literal(..), Patt(..), Equation(.. readExpr, showExpr, pExpr, pBinds, ppExpr, ppPatt, pattScope,
mkAbs, unAbs,
- mkApp, unApp, unAppForm,
+ mkApp, unApp, unapply,
mkStr, unStr,
mkInt, unInt,
mkDouble, unDouble,
@@ -108,13 +108,13 @@ mkApp f es = foldl EApp (EFun f) es -- | Decomposes an expression into application of function
unApp :: Expr -> Maybe (CId,[Expr])
-unApp e = case unAppForm e of
+unApp e = case unapply e of
(EFun f,es) -> Just (f,es)
_ -> Nothing
-- | Decomposes an expression into an application of a constructor such as a constant or a metavariable
-unAppForm :: Expr -> (Expr,[Expr])
-unAppForm = extract []
+unapply :: Expr -> (Expr,[Expr])
+unapply = extract []
where
extract es f@(EFun _) = (f,es)
extract es (EApp e1 e2) = extract (e2:es) e1
|