From dcc2888fafb1ab1066f5faed3b5dd52bbb4a4124 Mon Sep 17 00:00:00 2001
From: aarne <aarne@chalmers.se>
Date: Sun, 15 Nov 2009 20:03:28 +0000
Subject: command vt -mk for displaying overload-style function names

---
 src/PGF/VisualizeTree.hs | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

(limited to 'src/PGF/VisualizeTree.hs')

diff --git a/src/PGF/VisualizeTree.hs b/src/PGF/VisualizeTree.hs
index 857c1b08d..25bc2b3f1 100644
--- a/src/PGF/VisualizeTree.hs
+++ b/src/PGF/VisualizeTree.hs
@@ -19,7 +19,7 @@ module PGF.VisualizeTree ( graphvizAbstractTree
                          , graphvizParseTree
                          , graphvizDependencyTree
                          , graphvizAlignment
-
+                         , tree2mk
                          , getDepLabels
                          , PosText(..), readPosText
 			 ) where
@@ -27,6 +27,7 @@ module PGF.VisualizeTree ( graphvizAbstractTree
 import PGF.CId (CId,showCId,pCId,mkCId)
 import PGF.Data
 import PGF.Tree
+import PGF.Expr (showExpr)
 import PGF.Linearize
 import PGF.Macros (lookValCat)
 
@@ -63,6 +64,14 @@ prGraph digr ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where
   graph = if digr then "digraph" else "graph"
 
 
+-- replace each non-atomic constructor with mkC, where C is the val cat
+tree2mk :: PGF -> Expr -> String
+tree2mk pgf = showExpr [] . tree2expr . t2m . expr2tree where
+  t2m t = case t of
+    Fun cid [] -> t
+    Fun cid ts -> Fun (mk cid) (map t2m ts)
+  mk = mkCId . ("mk" ++) . showCId . lookValCat pgf
+
 -- dependency trees from Linearize.linearizeMark
 
 graphvizDependencyTree :: String -> Bool -> Maybe Labels -> Maybe String -> PGF -> CId -> Expr -> String
-- 
cgit v1.2.3