mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-07 10:12:51 -06:00
remove the dead code left behind by Peter Ljunglöf in VisualizeTree
This commit is contained in:
@@ -988,11 +988,9 @@ allCommands = Map.fromList [
|
|||||||
nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts,
|
nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts,
|
||||||
leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts
|
leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts
|
||||||
}
|
}
|
||||||
let grph = if null es then []
|
let grph = if null es
|
||||||
else if isOpt "old" opts then
|
then []
|
||||||
graphvizParseTreeOld pgf lang (head es)
|
else graphvizParseTree pgf lang gvOptions (head es)
|
||||||
else
|
|
||||||
graphvizParseTree pgf lang gvOptions (head es)
|
|
||||||
if isFlag "view" opts || isFlag "format" opts then do
|
if isFlag "view" opts || isFlag "format" opts then do
|
||||||
let file s = "_grph." ++ s
|
let file s = "_grph." ++ s
|
||||||
let view = optViewGraph opts
|
let view = optViewGraph opts
|
||||||
|
|||||||
@@ -1,18 +1,12 @@
|
|||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : VisualizeTree
|
-- Module : VisualizeTree
|
||||||
-- Maintainer : AR
|
-- Maintainer : KA
|
||||||
-- Stability : (stable)
|
-- Stability : (stable)
|
||||||
-- Portability : (portable)
|
-- Portability : (portable)
|
||||||
--
|
--
|
||||||
-- > CVS $Date:
|
|
||||||
-- > CVS $Author:
|
|
||||||
-- > CVS $Revision:
|
|
||||||
--
|
|
||||||
-- Print a graph of an abstract syntax tree in Graphviz DOT format
|
-- Print a graph of an abstract syntax tree in Graphviz DOT format
|
||||||
-- Based on BB's VisualizeGrammar
|
-- Based on BB's VisualizeGrammar
|
||||||
-- FIXME: change this to use GF.Visualization.Graphviz,
|
|
||||||
-- instead of rolling its own.
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module PGF.VisualizeTree
|
module PGF.VisualizeTree
|
||||||
@@ -20,7 +14,6 @@ module PGF.VisualizeTree
|
|||||||
, graphvizDefaults
|
, graphvizDefaults
|
||||||
, graphvizAbstractTree
|
, graphvizAbstractTree
|
||||||
, graphvizParseTree
|
, graphvizParseTree
|
||||||
, graphvizParseTreeOld
|
|
||||||
, graphvizDependencyTree
|
, graphvizDependencyTree
|
||||||
, graphvizBracketedString
|
, graphvizBracketedString
|
||||||
, graphvizAlignment
|
, graphvizAlignment
|
||||||
@@ -290,50 +283,6 @@ graphvizBracketedString opts bs = render graphviz_code
|
|||||||
space
|
space
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
graphvizParseTreeOld :: PGF -> Language -> Tree -> String
|
|
||||||
graphvizParseTreeOld pgf lang = graphvizBracketedStringOld . bracketedLinearize pgf lang
|
|
||||||
|
|
||||||
|
|
||||||
graphvizBracketedStringOld :: BracketedString -> String
|
|
||||||
graphvizBracketedStringOld = render . lin2tree
|
|
||||||
where
|
|
||||||
lin2tree bs =
|
|
||||||
text "graph {" $$
|
|
||||||
space $$
|
|
||||||
nest 2 (text "rankdir=BU ;" $$
|
|
||||||
text "node [shape = record, color = white] ;" $$
|
|
||||||
space $$
|
|
||||||
vcat (nodes bs)) $$
|
|
||||||
text "}"
|
|
||||||
where
|
|
||||||
nodes bs = zipWith mkStruct [0..] (interns ++ [zipWith (\i (l,p,w) -> (l,p,i,w)) [99990..] leaves])
|
|
||||||
|
|
||||||
nil = -1
|
|
||||||
|
|
||||||
leaves = getLeaves 0 nil bs
|
|
||||||
interns = getInterns 0 [(nil,bs)]
|
|
||||||
|
|
||||||
getLeaves level parent bs =
|
|
||||||
case bs of
|
|
||||||
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]
|
|
||||||
|
|
||||||
mkStruct l cs = struct l <> text "[label = \"" <> fields cs <> text "\"] ;" $$
|
|
||||||
vcat [link pl pid l id | (pl,pid,id,_) <- cs]
|
|
||||||
link pl pid l id
|
|
||||||
| pl < 0 = empty
|
|
||||||
| otherwise = struct pl <> colon <> tag pid <> colon <> char 's' <+>
|
|
||||||
text "--" <+>
|
|
||||||
struct l <> colon <> tag id <> colon <> char 'n' <+> semi
|
|
||||||
fields cs = hsep (intersperse (char '|') [tbrackets (tag id) <> text c | (_,_,id,c) <- cs])
|
|
||||||
|
|
||||||
|
|
||||||
type Rel = (Int,[Int])
|
type Rel = (Int,[Int])
|
||||||
-- possibly needs changes after clearing about many-to-many on this level
|
-- possibly needs changes after clearing about many-to-many on this level
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user