15.4.27  src/app/future-lex/src/backends/dot/dot-output.pkg

### 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)

stipulate
    package fil =  file__premicrothread;                                # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
    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
herein

    package dot_output: (weak)  Output {                                # Output                is from   src/app/future-lex/src/backends/output.api
        #
        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 
                \\ '\\' => "\\\\";  c => string::from_char c; end
                str;

        fun write_graph (out, graph)
            =
            wr_graph  graph
            where

                # Write a string:
                #
                fun wr s
                    =
                    fil::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 (\\ 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_forward 
                                          (\\ (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)
            =
            {   spec ->  lo::SPEC { dfa, start_states, ... };
                #
                out   =  fil::open_for_write  (fname + ".dot");
                graph =  make_graph_fn dfa;

                print (" writing " + fname + ".dot\n");

                write_graph (out, graph)
                then
                    fil::close_output  out;
            };
    };
end;