parse tree visualization

7 files changed, 99 insertions, 10 deletions

diff --git a/doc/gf-history.html b/doc/gf-history.html
index 1f0b81ad3..e098570e4 100644
--- a/doc/gf-history.html
+++ b/doc/gf-history.html
@@ -14,6 +14,13 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2
 
 <p>
 
+20/6 (AR) Added the command <tt>visialize_tree</tt> = <tt>vt</tt>, to
+display syntax trees graphically. Like <tt>vg</tt>, this command uses
+GraphViz and Ghostview. The foremost use is to pipe the parser to this
+command.
+
+<p>
+
 10/6 (AR) Preprocessor of <tt>.gfe</tt> files can now be performed as part of
 any grammar compilation. The flag <tt>-ex</tt> causes GF to look for
 the <tt>.gfe</tt> files and preprocess those that are younger
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 29e00e72f..ac5a5d660 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/06/14 20:09:57 $ 
+-- > CVS $Date: 2005/06/20 16:14:19 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.40 $
+-- > CVS $Revision: 1.41 $
 --
 -- GF shell command interpreter.
 -----------------------------------------------------------------------------
@@ -31,6 +31,7 @@ import GF.UseGrammar.GetTree
 import GF.Shell.ShellCommands
 
 import GF.Visualization.VisualizeGrammar (visualizeCanonGrammar, visualizeSourceGrammar)
+import GF.Visualization.VisualizeTree (visualizeTrees)
 import GF.API
 import GF.API.IOGrammar
 import GF.Compile.Compile
@@ -57,7 +58,6 @@ import GF.Data.Operations
 import GF.Infra.UseIO
 import GF.Text.UTF8 (encodeUTF8)
 
-import GF.Visualization.VisualizeGrammar (visualizeSourceGrammar)
 
 ---- import qualified GrammarToGramlet as Gr
 ---- import qualified GrammarToCanonXML2 as Canon
@@ -208,6 +208,12 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
         _ -> Nothing
     returnArg (ATrms $ generateTrees opts gro mt) sa
 
+  CShowTreeGraph  -> do
+    let g0 = writeFile "grphtmp.dot" $ visualizeTrees opts $ strees $ s2t a
+        g1 = system "dot -Tps grphtmp.dot >grphtmp.ps" 
+        g2 = system "gv grphtmp.ps &" 
+        g3 = return () ---- system "rm -f grphtmp.*"
+    justOutput opts (g0 >> g1 >> g2 >> g3 >> return ()) sa
 
   CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro)  . s2t) sa
 
@@ -306,6 +312,10 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
      AString s  -> err AError (ATrms . return) $ string2treeErr gro s
      _ -> a
 
+   strees a = case a of
+     ATrms ts -> ts
+     _ -> [] 
+
    warnDiscont os = err putStrLn id $ do
      let c0 = firstAbsCat os gro
      c <- GrammarToCanon.redQIdent c0
diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 84069ec2b..6a95ff7bf 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/06/10 21:04:01 $
+-- > CVS $Date: 2005/06/20 16:14:19 $
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- Help on shell commands. Generated from HelpFile by 'make help'.
 -- PLEASE DON'T EDIT THIS FILE.
@@ -310,6 +310,14 @@ txtHelpFile =
   "\n  flags:" ++
   "\n      -c           compute the resulting new tree to normal form" ++
   "\n" ++
+  "\nvt, visualize_tree: vt Tree" ++
+  "\n      Shows the abstract syntax tree via dot and gv (via temporary files" ++
+  "\n      grphtmp.dot, grphtmp.ps)." ++
+  "\n  flags:" ++
+  "\n      -c           show categories only (no functions)" ++
+  "\n      -f           show functions only (no categories)" ++
+  "\n      -g           show as graph (sharing uses of the same function)" ++
+  "\n" ++
   "\n-- subshells" ++
   "\n" ++
   "\nes, editing_session: es" ++
diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs
index 169e7315f..b555317aa 100644
--- a/src/GF/Shell/PShell.hs
+++ b/src/GF/Shell/PShell.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/20 14:34:11 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.24 $
+-- > CVS $Date: 2005/06/20 16:14:20 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.25 $
 --
 -- parsing GF shell commands. AR 11\/11\/2001
 -----------------------------------------------------------------------------
@@ -145,6 +145,7 @@ pCommand ws = case ws of
   "px"  : []     -> aUnit CPrintCanonXML
   "pm"  : []     -> aUnit CPrintMultiGrammar
   "vg"  : []     -> aUnit CShowGrammarGraph
+  "vt"  : s      -> aTerm CShowTreeGraph s
   "sg"  : []     -> aUnit CPrintSourceGrammar
   "po"  : []     -> aUnit CPrintGlobalOptions
   "pl"  : []     -> aUnit CPrintLanguages
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index 687d57bee..e2b809b21 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/06/10 21:04:01 $ 
+-- > CVS $Date: 2005/06/20 16:14:20 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.37 $
+-- > CVS $Revision: 1.38 $
 --
 -- The datatype of shell commands and the list of their options.
 -----------------------------------------------------------------------------
@@ -75,6 +75,7 @@ data Command =
  | CPrintMultiGrammar
  | CPrintSourceGrammar
  | CShowGrammarGraph
+ | CShowTreeGraph
  | CPrintGramlet 
  | CPrintCanonXML
  | CPrintCanonXMLStruct 
@@ -190,6 +191,7 @@ optionsOfCommand co = case co of
   CSpeakAloud -> flags "language"
   CPutString -> both "utf8" "filter length"
   CShowTerm -> flags "printer"
+  CShowTreeGraph -> opts "c f g"
   CSystemCommand _ -> none
 
   CPrintGrammar -> both "utf8" "printer lang"
diff --git a/src/GF/Visualization/VisualizeTree.hs b/src/GF/Visualization/VisualizeTree.hs
new file mode 100644
index 000000000..af583567f
--- /dev/null
+++ b/src/GF/Visualization/VisualizeTree.hs
@@ -0,0 +1,53 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : VisualizeTree
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author:
+-- > CVS $Revision: 
+--
+-- Print a graph of an abstract syntax tree in Graphviz DOT format
+-- Based on BB's VisualizeGrammar
+-----------------------------------------------------------------------------
+
+module GF.Visualization.VisualizeTree ( visualizeTrees
+			) where
+
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Grammar.Abstract
+import GF.Data.Zipper
+import GF.Grammar.PrGrammar
+
+import Data.List (intersperse, nub)
+import Data.Maybe (maybeToList)
+
+visualizeTrees :: Options -> [Tree] -> String
+visualizeTrees opts = unlines . map (prGraph . 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 ++ "\""
+  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 ' '
+  prc a v 
+    | oElem (iOpt "c") opts = prt_ v
+    | oElem (iOpt "f") opts = prt_ a
+    | otherwise             = prt_ a ++ " : " ++ prt_ v
+
+prGraph ns = concat $ map (++"\n") $ ["graph {\n"] ++ ns ++ ["}"]
diff --git a/src/HelpFile b/src/HelpFile
index 3560141c9..dcd246858 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -281,6 +281,14 @@ wt, wrap_tree: wt Fun
   flags:
       -c           compute the resulting new tree to normal form
 
+vt, visualize_tree: vt Tree
+      Shows the abstract syntax tree via dot and gv (via temporary files
+      grphtmp.dot, grphtmp.ps).
+  flags:
+      -c           show categories only (no functions)
+      -f           show functions only (no categories)
+      -g           show as graph (sharing uses of the same function)
+
 -- subshells
 
 es, editing_session: es