From aba666c5bc7a46cdc7de7e2a36869456c34909bd Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 5 Nov 2013 17:28:47 +0000 Subject: linearization by chunks in the GF shell: a new command 'lc' needed because 'l' requires type checking and trees with metavariable function heads don't type check. This will hopefully be a temporary command. --- src/compiler/GF/Command/TreeOperations.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'src/compiler/GF/Command/TreeOperations.hs') diff --git a/src/compiler/GF/Command/TreeOperations.hs b/src/compiler/GF/Command/TreeOperations.hs index bf8882802..220c8f561 100644 --- a/src/compiler/GF/Command/TreeOperations.hs +++ b/src/compiler/GF/Command/TreeOperations.hs @@ -1,6 +1,7 @@ module GF.Command.TreeOperations ( treeOp, - allTreeOps + allTreeOps, + treeChunks ) where import PGF @@ -30,6 +31,8 @@ allTreeOps pgf = [ Left $ concatMap subtrees)), ("funs",("return all fun functions appearing in the tree, with duplications", Left $ concatMap funNodes)) +--- ("chunks",("return all chunks, i.e. maximal subtrees where the top node is not a metavariable", +--- Left $ concatMap treeChunks)) --- a tree with ? head does not type check anyway AR 5/11/2013 ] largest :: [Expr] -> [Expr] @@ -42,6 +45,15 @@ smallest = sortBy (\t u -> compare (size t) (size u)) where EApp e1 e2 -> size e1 + size e2 + 1 _ -> 1 +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]) + subtrees :: Expr -> [Expr] subtrees t = t : case unApp t of Just (f,ts) -> concatMap subtrees ts -- cgit v1.2.3