From 3e293ae3e0b9664fadb118d013563be52f0e5885 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Sat, 13 Dec 2008 20:19:37 +0000
Subject: [PATCH] bracketing with tree node reference: l -bracket

---
 src/GF/Command/Commands.hs | 10 ++++++----
 src/PGF/Linearize.hs       | 37 ++++++++++++++++++++++++++++++++++++-
 src/PGF/ShowLinearize.hs   |  7 ++++++-
 3 files changed, 48 insertions(+), 6 deletions(-)

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index 35a86ad96..a78fa0fac 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -273,6 +273,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      exec = \opts -> return . fromStrings . map (optLin opts),
      options = [
        ("all","show all forms and variants"),
+       ("bracket","show tree structure with brackets and paths to nodes"),
        ("multi","linearize to all languages (default)"),
        ("record","show source-code-like record"),
        ("table","show all forms labelled by parameters"),
@@ -555,10 +556,11 @@ allCommands cod env@(pgf, mos) = Map.fromList [
      _ -> unlines [linear opts lang t | lang <- optLangs opts] 
     
    linear opts lang = let unl = unlex opts lang in case opts of
-       _ | isOpt "all"    opts -> allLinearize unl pgf lang
-       _ | isOpt "table"  opts -> tableLinearize unl pgf lang
-       _ | isOpt "term"   opts -> termLinearize pgf lang
-       _ | isOpt "record" opts -> recordLinearize pgf lang
+       _ | isOpt "all"     opts -> allLinearize unl pgf lang
+       _ | isOpt "table"   opts -> tableLinearize unl pgf lang
+       _ | isOpt "term"    opts -> termLinearize pgf lang
+       _ | isOpt "record"  opts -> recordLinearize pgf lang
+       _ | isOpt "bracket" opts -> markLinearize pgf lang
        _  -> unl . linearize pgf lang
 
    treebank opts t = unlines $ 
diff --git a/src/PGF/Linearize.hs b/src/PGF/Linearize.hs
index 469654f07..3b0c42597 100644
--- a/src/PGF/Linearize.hs
+++ b/src/PGF/Linearize.hs
@@ -1,4 +1,5 @@
-module PGF.Linearize (linearizes,realize,realizes,linTree) where
+module PGF.Linearize 
+  (linearizes,realize,realizes,linTree, linTreeMark,linearizesMark) where
 
 import PGF.CId
 import PGF.Data
@@ -118,3 +119,37 @@ compute pgf lang args = comp where
     TM s   -> TM s
     _ -> error ("ERROR in grammar compiler: field from " ++ show t) t
 
+---------
+-- markup with tree positions
+
+linearizesMark :: PGF -> CId -> Tree -> [String]
+linearizesMark pgf lang = realizes . linTreeMark pgf lang
+
+linTreeMark :: PGF -> CId -> Tree -> Term
+linTreeMark pgf lang = lin []
+  where
+    lin p (Abs xs  e )   = case lin p e of
+                             R ts -> R $ ts     ++ (Data.List.map (kks . prCId) xs)
+                             TM s -> R $ (TM s)  : (Data.List.map (kks . prCId) xs)
+    lin p (Fun fun es)   = let argVariants = 
+                                mapM (\ (i,e) -> liftVariants $ lin (sub p i) e) (zip [0..] es)
+                          in variants [mark p $ compute pgf lang args $ look fun | args <- argVariants]
+    lin p (Lit (LStr s)) = mark p $ R [kks (show s)] -- quoted
+    lin p (Lit (LInt i)) = mark p $ R [kks (show i)] 
+    lin p (Lit (LFlt d)) = mark p $ R [kks (show d)]
+    lin p (Var x)        = mark p $ TM (prCId x)
+    lin p (Meta i)       = mark p $ TM (show i)
+ 
+    look = lookLin pgf lang
+
+    mark p t = case t of
+      R  ts -> R $ map (mark p) ts
+      FV ts -> R $ map (mark p) ts
+      S  ts -> S $ bracket p ts
+      K  s  -> S $ bracket p [t]
+      W s (R ts) -> R [mark p $ kks (s ++ u) | K (KS u) <- ts]
+      _     -> t
+      -- otherwise in normal form
+
+    bracket p ts = [kks ("["++show p)] ++ ts ++ [kks "]"]
+    sub p i = p ++ [i]
diff --git a/src/PGF/ShowLinearize.hs b/src/PGF/ShowLinearize.hs
index 87538201c..26fddd6c2 100644
--- a/src/PGF/ShowLinearize.hs
+++ b/src/PGF/ShowLinearize.hs
@@ -4,7 +4,8 @@ module PGF.ShowLinearize (
   recordLinearize,
   termLinearize,
   tabularLinearize,
-  allLinearize
+  allLinearize,
+  markLinearize
   ) where
 
 import PGF.CId
@@ -89,6 +90,10 @@ recLinearize pgf lang tree = mkRecord typ $ linTree pgf lang tree where
 termLinearize :: PGF -> CId -> Tree -> String
 termLinearize pgf lang = show . linTree pgf lang
 
+-- show bracketed markup with references to tree structure
+markLinearize :: PGF -> CId -> Tree -> String
+markLinearize pgf lang t = concat $ take 1 $ linearizesMark pgf lang t
+
 
 -- for Morphology: word, lemma, tags
 collectWords :: PGF -> CId -> [(String, [(String,String)])]