### dot-output.pkg
### John Reppy (http://www.cs.uchicago.edu/~jhr)
### Aaron Turon (adrassi@gmail.com)
### All rights reserved.
# Compiled by:
# src/app/future-lex/src/lexgen.lib# Produce a .dot file from a DFA.
# (See www.graphviz.org for details about DOT)
package dot_output: (weak) Output { # Output is from src/app/future-lex/src/backends/output.api #
package re= regular_expression; # regular_expression is from src/app/future-lex/src/regular-expression.pkg package lex= lex_fn; # lex_fn is from src/app/future-lex/src/lex-fn.pkg package lo= lex_output_spec; # lex_output_spec is from src/app/future-lex/src/backends/lex-output-spec.pkg Attribute = ATTRIBUTE (String, String);
Node = NODE (String, List( Attribute ));
Di_Edge = EDGE (String, String, List( Attribute ));
Di_Graph = GRAPH (String, List( Node ), List( Di_Edge ), List( Attribute ));
fun repl_bs str
=
string::translate
fn '\\' => "\\\\"; c => string::from_char c; end
str;
fun write_graph (out, graph)
=
wr_graph graph
where
# Write a string:
#
fun wr s
=
file::write (out, s);
# Write a list of strings:
#
fun wrs ss
=
wr (string::cat ss);
# indent to some level
#
fun wr_indent 0 => ();
wr_indent lvl => { wr " "; wr_indent (lvl - 1);};
end;
# Apply output functions, indenting each time
#
fun apply indent f list
=
list::apply (fn x => { wr_indent indent; f x;}; end ) list;
fun wr_attribute (ATTRIBUTE (name, value))
=
wrs ([
"[ ", name, " = \"", value, "\" ]", "\n"
]);
fun wr_node (NODE (name, atts))
=
{ wr name;
wr "\n";
apply 2 wr_attribute atts;
};
fun wr_edge (EDGE (no1, no2, atts))
=
{ wrs ([no1, " -> ", no2, "\n"]);
apply 2 wr_attribute atts;
};
fun wr_graph_attribute attribute
=
{ wr "graph\n";
wr_indent 2;
wr_attribute attribute;
};
fun wr_graph (GRAPH (name, nodes, edges, atts))
=
{ wrs (["digraph ", name, " {\n"]);
apply 1 wr_graph_attribute atts;
apply 1 wr_node nodes;
apply 1 wr_edge edges;
wr "}";
};
end;
fun make_graph_fn states
=
{
# node id -> node name
fun name id
=
"Q" + int::to_string id;
fun make_node (lo::STATE { id, label, final => [], ... } )
=>
NODE (name id, [ATTRIBUTE ("shape", "circle")]);
make_node (lo::STATE { id, label, final => i ! _, ... } )
=>
NODE (name id,
[ATTRIBUTE ("shape", "doublecircle"),
ATTRIBUTE ("label", (name id) + "/" + (int::to_string i))]);
end;
fun make_edge from_id (symbol_set, lo::STATE { id, ... } )
=
EDGE (name from_id, name id,
[ATTRIBUTE ("label", repl_bs (re::to_string (re::make_symbol_set symbol_set)))]);
fun make_edges (lo::STATE { id, next, ... } )
=
list::map (make_edge id) (list::reverse *next);
fun make_rule (i, re)
=
string::cat (
["Rule ",
int::to_string i,
": ",
repl_bs (re::to_string re),
"\\n"]);
# Node for input REs
#
fun make_rules result
=
NODE ("Rules",
[ATTRIBUTE ("label", vector::keyed_fold_left
(fn (i, r, s) = s + (make_rule (i, r)))
"" result),
ATTRIBUTE ("shape", "plaintext"),
ATTRIBUTE ("fontname", "Courier")]);
nodes' = list::map make_node states;
nodes = nodes';
edges = list::cat (list::map make_edges states);
GRAPH ("DFA", nodes, edges,
[ATTRIBUTE ("size", "7, 10"),
ATTRIBUTE ("rankdir", "LR")]);
};
fun output (spec, fname)
=
{ my lo::SPEC { dfa, start_states, ... }
=
spec;
out = file::open_for_write (fname + ".dot");
graph = make_graph_fn dfa;
print (" writing " + fname + ".dot\n");
write_graph (out, graph)
before file::close_output out;
};
};