better tree viz

lib/resource/finnish/CategoriesFin.gf

@@ -65,9 +65,9 @@ lincat
   V2A    = TransVerb ; ----
   V0     = Verb ;
 
-----  TP     = {s : Str ; b : Bool ; t : Tense ; a : Anteriority} ; --- the Str field is dummy
-----  Tense  = {s : Str ; t : Tense} ;
-----  Ant    = {s : Str ; a : Anteriority} ;
+  TP     = {s : Str ; b : Bool ; t : Tense ; a : Anteriority} ; --- the Str field is dummy
+  Tense  = {s : Str ; t : Tense} ;
+  Ant    = {s : Str ; a : Anteriority} ;
 
   PP     = {s : Str} ;
   Adv    = {s : Str} ;
@@ -76,8 +76,8 @@ lincat
   AdC    = {s : Str} ;
 
   S      = {s : Str} ; 
-----  Cl     = Clause ;
-      -- = {s : Order => Bool => SForm => Str} ;
+  Cl     = Clause ;
+      -- = {s : SType => Bool => SForm => Str} ;
 
   Slash  = Sentence ** {s2 : Str ; c : Case} ;
 

lib/resource/finnish/RulesFin.gf

@@ -73,24 +73,25 @@ lin
 
 ----  PredAS = predAdjSent ;
 ----  PredV0 rain = predVerbClause (pronNounPhrase pronIt) rain (complVerb rain) ;
-{-
+
 -- Partial saturation.
 
-  UseV2 = transAsVerb ;
+  UseV2 v = v ;
 
-  ComplA2S = predAdjSent2 ;
+----  ComplA2S = predAdjSent2 ;
 
-  AdjPart = adjPastPart ;
+----  AdjPart = adjPastPart ;
+
+----  UseV2V x = verb2aux x ** {isAux = False} ;
 
-  UseV2V x = verb2aux x ** {isAux = False} ;
   UseV2S x = x ;
   UseV2Q x = x ;
   UseA2S x = x ;
   UseA2V x = x ;
 
-  UseCl  tp cl = {s = tp.s ++ cl.s ! Dir ! tp.b ! VFinite tp.t tp.a} ;
-  UseQCl tp cl = {s = \\q => tp.s ++ cl.s ! tp.b ! VFinite tp.t tp.a ! q} ;
-  UseRCl tp cl = {s = \\a => tp.s ++ cl.s ! tp.b ! VFinite tp.t tp.a ! a} ;
+  UseCl  tp cl = {s = tp.s ++ cl.s ! SDecl ! tp.b ! VFinite tp.t tp.a} ;
+----  UseQCl tp cl = {s = \\q => tp.s ++ cl.s ! tp.b ! VFinite tp.t tp.a ! q} ;
+----  UseRCl tp cl = {s = \\a => tp.s ++ cl.s ! tp.b ! VFinite tp.t tp.a ! a} ;
 
   PosTP t a = {s = t.s ++ a.s ; b = True  ; t = t.t ; a = a.a} ;
   NegTP t a = {s = t.s ++ a.s ; b = False ; t = t.t ; a = a.a} ;
@@ -102,7 +103,7 @@ lin
 
   ASimul = {s = [] ; a = Simul} ;
   AAnter = {s = [] ; a = Anter} ;
--}
+
 -- Adverbs.
 
 ----  AdjAdv a = ss (a.s ! AAttr ! AAdv) ; --- also APred?

lib/resource/finnish/SyntaxFin.gf

@@ -458,12 +458,31 @@ oper
 --
 --3 Verb phrases
 --
+-- These are parameters for clauses and sentences.
+
+  param
+
+  Tense = Present | Past | Future | Conditional ;
+  Anteriority = Simul | Anter ;
+
+  SForm = 
+     VFinite  Tense Anteriority
+   | VInfinit Anteriority
+   | VPresPart
+   ;
+  
+  SType = SDecl | SQuest ;
+
+  oper
+  Clause : Type = {s : SType => Bool => SForm => Str} ;
+
 -- Verb phrases are discontinuous: the two parts of a verb phrase are
 -- (s) an inflected verb, (s2) a complement.
 -- For instance: "on" - "kaunis" ; "ei" - "ole kaunis" ; "sisältää" - "rikkiä".
 -- Moreover, a subject case is needed, because of passive and 'have' verb
 -- phrases ("minä uin" ; "minut valitaan" ; "minua odotetaan" ; "minulla on jano").
 
+  oper
   VerbPhrase = Verb ** {s2 : VForm => Str ; c : ComplCase} ;
   VerbGroup   = {s,s2 : Bool => VForm => Str ; c : ComplCase} ;
 

src/GF/Visualization/VisualizeTree.hs

@@ -26,28 +26,31 @@ import Data.List (intersperse, nub)
 import Data.Maybe (maybeToList)
 
 visualizeTrees :: Options -> [Tree] -> String
-visualizeTrees opts = unlines . map (prGraph . tree2graph opts)
+visualizeTrees opts = unlines . map (prGraph opts . tree2graph opts)
 
 tree2graph :: Options -> Tree -> [String]
-tree2graph opts = prf (0,0) where
-  prf (i,j) t@(Tr (node, trees)) = 
-    let nod = prn (i,j) node in
-      (nod ++ " [style = \"solid\", shape = \"plaintext\"] ;") : 
-      [pra (i+1,j) nod t    | (j,t) <- zip [0..] trees] ++
-      concat [prf (i+1,j) t | (j,t) <- zip [0..] trees]
-  prn (i,j) (N (bi,at,val,_,_)) = 
-    "\"" ++ prs i ++ 
-    prb bi ++ 
-    prc at val ++ 
-    prs j ++ "\""
+tree2graph opts = prf [] where
+  prf ps t@(Tr (node, trees)) = 
+    let (nod,lab) = prn ps node in
+      (nod ++ " [label = " ++ lab ++ ", style = \"solid\", shape = \"plaintext\"] ;") : 
+      [       pra (j:ps) nod t | (j,t) <- zip [0..] trees] ++
+      concat [prf (j:ps) t     | (j,t) <- zip [0..] trees]
+  prn ps (N (bi,at,val,_,_)) = 
+    let 
+      lab = 
+        "\"" ++ 
+        prb bi ++ 
+        prc at val ++ 
+        "\""
+    in if oElem (iOpt "g") opts then (lab,lab) else (show(show (ps :: [Int])),lab)
   prb [] = ""
   prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
-  pra i nod t@(Tr (node,_)) =  nod ++ " -- " ++ prn i node ++ " [style = \"solid\"];"
-
-  prs k = if oElem (iOpt "g") opts then "" else replicate k ' '
+  pra i nod t@(Tr (node,_)) =  nod ++ arr ++ fst (prn i node) ++ " [style = \"solid\"];"
   prc a v 
     | oElem (iOpt "c") opts = prt_ v
     | oElem (iOpt "f") opts = prt_ a
     | otherwise             = prt_ a ++ " : " ++ prt_ v
+  arr = if oElem (iOpt "g") opts then " -> " else " -- "
 
-prGraph ns = concat $ map (++"\n") $ ["graph {\n"] ++ ns ++ ["}"]
+prGraph opts ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where
+  graph = if oElem (iOpt "g") opts then "digraph" else "graph"