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.

2 files changed, 35 insertions, 3 deletions

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index a05b3cf20..5b3737553 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -516,9 +516,9 @@ allCommands = Map.fromList [
        ],
      exec = \env@(pgf, mos) opts -> return . fromStrings . optLins pgf opts,
      options = [
-       ("all","show all forms and variants, one by line (cf. l -list)"),
+       ("all",    "show all forms and variants, one by line (cf. l -list)"),
        ("bracket","show tree structure with brackets and paths to nodes"),
-       ("groups","all languages, grouped by lang, remove duplicate strings"),
+       ("groups", "all languages, grouped by lang, remove duplicate strings"),
        ("list","show all forms and variants, comma-separated on one line (cf. l -all)"),
        ("multi","linearize to all languages (default)"),
        ("table","show all forms labelled by parameters"),
@@ -529,6 +529,24 @@ allCommands = Map.fromList [
        ("unlexer","set unlexers separately to each language (space-separated)")
        ]
      }),
+  ("lc", emptyCommandInfo {
+     longname = "linearize_chunks",
+     synopsis = "linearize a tree that has metavariables in maximal chunks without them",
+     explanation = unlines [
+       "A hopefully temporary command, intended to work around the type checker that fails",
+       "trees where a function node is a metavariable."
+       ],
+     examples = [
+       mkEx "l -lang=LangSwe,LangNor -chunks ? a b (? c d)"
+       ],
+     exec = \env@(pgf, mos) opts -> return . fromStrings . optLins pgf (opts ++ [OOpt "chunks"]),
+     options = [
+       ] ++ stringOpOptions,
+     flags = [
+       ("lang","the languages of linearization (comma-separated, no spaces)")
+       ],
+     needsTypeCheck = False
+     }),
   ("ma", emptyCommandInfo {
      longname = "morpho_analyse",
      synopsis = "print the morphological analyses of all words in the string",
@@ -1155,6 +1173,8 @@ allCommands = Map.fromList [
        _ | isOpt "treebank" opts ->
          (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
          [showCId lang ++ ": " ++ linear pgf opts lang t | lang <- optLangs pgf opts]
+       _ | isOpt "chunks" opts ->
+            [unwords (intersperse "<+>" (map (linear pgf opts lang) (treeChunks t))) | lang <- optLangs pgf opts]
        _  -> [linear pgf opts lang t | lang <- optLangs pgf opts]
 
    linear :: PGF -> [Option] -> CId -> Expr -> String
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