added the possibility to annotate features of syncat words, e.g. @"is" PresSg3

1 files changed, 13 insertions, 8 deletions

diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs
index b1709e88d..ee691fc7a 100644
--- a/src/runtime/haskell/PGF/VisualizeTree.hs
+++ b/src/runtime/haskell/PGF/VisualizeTree.hs
@@ -775,11 +775,11 @@ fixCoNLL cncLabels conll = map fixc conll where
   flabels = [r | Right r <- cncLabels]
 
   fixc row = case row of
-    (i:word:fun:pos:cat:x_:"0":"dep":xs) -> (i:word:fun:pos:cat:(feat cat x_):"0":"root":xs) --- change the root label from dep to root 
+    (i:word:fun:pos:cat:x_:"0":"dep":xs) -> (i:word:fun:pos:cat:(feat cat word x_):"0":"root":xs) --- change the root label from dep to root 
     (i:word:fun:pos:cat:x_:j:label:xs) -> case look (fun,word) of
-      Just (pos',label',"head") -> (i:word:fun:pos' pos:cat:(feat cat x_):j :label':xs)
-      Just (pos',label',target) -> (i:word:fun:pos' pos:cat:(feat cat x_): getDep j target:label':xs)
-      _ -> (i:word:fun:pos:cat:(feat cat x_):j:label:xs)
+      Just (pos',label',"head") -> (i:word:fun:pos' pos:cat:(feat cat word x_):j :label':xs)
+      Just (pos',label',target) -> (i:word:fun:pos' pos:cat:(feat cat word x_): getDep j target:label':xs)
+      _ -> (i:word:fun:pos:cat:(feat cat word x_):j:label:xs)
     _ -> row
     
   look (fun,word) = case lookup fun labels of
@@ -794,9 +794,11 @@ fixCoNLL cncLabels conll = map fixc conll where
   
   getDep j label = maybe j id $ lookup (label,j) [((label,j),i) | i:word:fun:pos:cat:x_:j:label:xs <- conll]
 
-  feat cat x = case lookup cat flabels of
+  feat cat word x = case lookup cat flabels of
     Just tags | all isDigit x && length tags > read x -> tags !! read x
-    _ -> cat ++ "-" ++ x
+    _ -> case lookup (show word) flabels of
+      Just (t:_) -> t
+      _ -> cat ++ "-" ++ x
 
 getCncDepLabels :: String -> CncLabels
 getCncDepLabels s = wlabels ws ++ flabels fs
@@ -814,7 +816,7 @@ getCncDepLabels s = wlabels ws ++ flabels fs
     map collectTags .
     map words
 
-  (fs,ws) = partition chooseF $ lines s
+  (fs,ws) = partition chooseF $ map uncomment $ lines s
 
   --- choose is for compatibility with the general notation
   chooseW line = notElem '(' line &&
@@ -824,7 +826,10 @@ getCncDepLabels s = wlabels ws ++ flabels fs
 
   chooseF line = take 1 line == "@"  --- feature assignments have the form e.g. @N SgNom SgGen ; no spaces inside tags
 
-  isComment line = take 2 line == "--"
+  uncomment line = case line of
+    '-':'-':_ -> ""
+    c:cs -> c : uncomment cs
+    _ -> line
 
   analyse line = case break (=='{') line of
     (beg,_:ws) -> case break (=='}') ws of