GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-19 01:39:32 -06:00
Code Issues Packages Projects Releases Wiki Activity

now every BracketedString also has reference to the source expression(s)

Browse Source
This commit is contained in:
krasimir
2010-05-19 13:32:39 +00:00
parent 8e01bc3118
commit 7e8a5d05ca
5 changed files with 88 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/runtime/haskell/PGF/VisualizeTree.hs
View File

@@ -22,7 +22,7 @@ module PGF.VisualizeTree
, graphvizBracketedString
, graphvizAlignment
, getDepLabels
) where
) where
import PGF.CId (CId,showCId,ppCId,mkCId)
import PGF.Data
@@ -122,8 +122,8 @@ graphvizDependencyTree format debug mlab ms pgf lang t = render $
getLeaves parent bs =
case bs of
Leaf w -> [(parent,w)]
Bracket _ fid _ bss -> concatMap (getLeaves fid) bss
Leaf w -> [(parent,w)]
Bracket _ fid _ _ bss -> concatMap (getLeaves fid) bss
mkNode (p,i,w) =
tag p <> text " [label = " <> doubleQuotes (int i <> char '.' <+> text w) <> text "] ;"
@@ -234,13 +234,13 @@ graphvizBracketedString = render . lin2tree
getLeaves level parent bs =
case bs of
Leaf w -> [(level-1,parent,w)]
Bracket _ fid i bss -> concatMap (getLeaves (level+1) fid) bss
Leaf w -> [(level-1,parent,w)]
Bracket _ fid i _ bss -> concatMap (getLeaves (level+1) fid) bss
getInterns level [] = []
getInterns level nodes =
nub [(level-1,parent,fid,showCId cat) | (parent,Bracket cat fid _ _) <- nodes] :
getInterns (level+1) [(fid,child) | (_,Bracket _ fid _ children) <- nodes, child <- children]
nub [(level-1,parent,fid,showCId cat) | (parent,Bracket cat fid _ _ _) <- nodes] :
getInterns (level+1) [(fid,child) | (_,Bracket _ fid _ _ children) <- nodes, child <- children]
mkStruct l cs = struct l <> text "[label = \"" <> fields cs <> text "\"] ;" $$
vcat [link pl pid l id | (pl,pid,id,_) <- cs]
@@ -290,8 +290,8 @@ graphvizAlignment pgf langs = render . lin2graph . linsBracketed
getLeaves parent bs =
case bs of
Leaf w -> [(parent,w)]
Bracket _ fid _ bss -> concatMap (getLeaves fid) bss
Leaf w -> [(parent,w)]
Bracket _ fid _ _ bss -> concatMap (getLeaves fid) bss
mkLayers l [] = empty
mkLayers l (cs:css) = struct l <> text "[label = \"" <> fields cs <> text "\"] ;" $$