path: root/lib/compiler/src/beam_digraph.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2019-2021. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
%% Digraph data type. Similar to the digraph module, but provides a
%% functional API. The functional API allows us to revert to a
%% previous version of the digraph when an optimization that may have
%% damaged the digraph has failed.
%%

-module(beam_digraph).

-export([new/0,
         add_vertex/2, add_vertex/3, add_edge/3, add_edge/4,
         del_edge/2, del_edges/2,
         has_vertex/2,
         is_path/3,
         in_degree/2, in_edges/2, in_neighbours/2,
         out_degree/2, out_edges/2, out_neighbours/2,
         vertex/2, vertices/1,
         reverse_postorder/2,
         roots/1,
         topsort/1,
         strong_components/2]).

%% Debugging.
-define(DEBUG, false).
-if(?DEBUG).
-export([dump/1,dump/2,dump/3]).
-endif.

-import(lists, [foldl/3, reverse/1]).

-type edge_map() :: #{ vertex() => ordsets:ordset(vertex()) }.
-type vertice_map() :: #{ vertex() => label() }.

-record(dg, {vs = #{} :: vertice_map(),
             in_es = #{} :: edge_map(),
             out_es = #{} :: edge_map()}).

-type graph() :: #dg{}.

-type vertex() :: term().
-type label() :: term().
-type edge() :: {vertex(), vertex(), label()}.

-spec new() -> graph().
new() -> #dg{}.

-spec add_vertex(graph(), vertex()) -> graph().
add_vertex(Dg, V) ->
    add_vertex(Dg, V, vertex).

-spec add_vertex(graph(), vertex(), label()) -> graph().
add_vertex(Dg, V, Label) ->
    #dg{in_es=InEsMap0,out_es=OutEsMap0,vs=Vs0} = Dg,
    InEsMap = init_edge_map(V, InEsMap0),
    OutEsMap = init_edge_map(V, OutEsMap0),
    Vs = Vs0#{V=>Label},
    Dg#dg{vs=Vs,in_es=InEsMap,out_es=OutEsMap}.

init_edge_map(V, EsMap) ->
    case is_map_key(V, EsMap) of
        true ->
            EsMap;
        false ->
            EsMap#{V=>ordsets:new()}
    end.

-spec add_edge(graph(), vertex(), vertex()) -> graph().
add_edge(Dg, From, To) ->
    add_edge(Dg, From, To, edge).

-spec add_edge(graph(), vertex(), vertex(), label()) -> graph().
add_edge(Dg, From, To, Label) ->
    #dg{in_es=InEsMap0,out_es=OutEsMap0} = Dg,
    Name = {From,To,Label},
    InEsMap = edge_map_add(To, Name, InEsMap0),
    OutEsMap = edge_map_add(From, Name, OutEsMap0),
    Dg#dg{in_es=InEsMap,out_es=OutEsMap}.

edge_map_add(V, E, EsMap) ->
    Es0 = map_get(V, EsMap),
    Es = ordsets:add_element(E, Es0),
    EsMap#{V:=Es}.

-spec del_edge(graph(), edge()) -> graph().
del_edge(Dg, {From,To,_}=E) ->
    #dg{in_es=InEsMap0,out_es=OutEsMap0} = Dg,
    InEsMap = edge_map_del(To, E, InEsMap0),
    OutEsMap = edge_map_del(From, E, OutEsMap0),
    Dg#dg{in_es=InEsMap,out_es=OutEsMap}.

edge_map_del(V, E, EsMap) ->
    Es0 = map_get(V, EsMap),
    Es = Es0 -- [E],
    EsMap#{V:=Es}.

-spec del_edges(graph(), [edge()]) -> graph().
del_edges(G, Es) when is_list(Es) ->
    foldl(fun(E, A) -> del_edge(A, E) end, G, Es).

-spec has_vertex(graph(), vertex()) -> boolean().
has_vertex(#dg{vs=Vs}, V) ->
    is_map_key(V, Vs).

-spec in_degree(graph(), vertex()) -> non_neg_integer().
in_degree(#dg{in_es=InEsMap}, V) ->
    length(map_get(V, InEsMap)).

-spec in_edges(graph(), vertex()) -> [edge()].
in_edges(#dg{in_es=InEsMap}, V) ->
    map_get(V, InEsMap).

-spec in_neighbours(graph(), vertex()) -> [vertex()].
in_neighbours(#dg{in_es=InEsMap}, V) ->
    [From || {From,_,_} <- map_get(V, InEsMap)].

-spec is_path(graph(), vertex(), vertex()) -> boolean().
is_path(G, From, To) ->
    Seen = sets:new([{version, 2}]),
    try
        _ = is_path_1([From], To, G, Seen),
        false
    catch
        throw:true ->
            true
    end.

is_path_1([To|_], To, _G, _Seen) ->
    throw(true);
is_path_1([V|Vs], To, G, Seen0) ->
    case sets:is_element(V, Seen0) of
        true ->
            is_path_1(Vs, To, G, Seen0);
        false ->
            Seen1 = sets:add_element(V, Seen0),
            Successors = out_neighbours(G, V),
            Seen = is_path_1(Successors, To, G, Seen1),
            is_path_1(Vs, To, G, Seen)
    end;
is_path_1([], _To, _G, Seen) ->
    Seen.

-spec out_degree(graph(), vertex()) -> non_neg_integer().
out_degree(#dg{out_es=OutEsMap}, V) ->
    length(map_get(V, OutEsMap)).

-spec out_edges(graph(), vertex()) -> [edge()].
out_edges(#dg{out_es=OutEsMap}, V) ->
    map_get(V, OutEsMap).

-spec out_neighbours(graph(), vertex()) -> [vertex()].
out_neighbours(#dg{out_es=OutEsMap}, V) ->
    [To || {_,To,_} <- map_get(V, OutEsMap)].

-spec vertex(graph(), vertex()) -> label().
vertex(#dg{vs=Vs}, V) ->
    map_get(V, Vs).

-spec vertices(graph()) -> [{vertex(), label()}].
vertices(#dg{vs=Vs}) ->
    maps:to_list(Vs).

-spec reverse_postorder(graph(), [vertex()]) -> [vertex()].
reverse_postorder(G, Vs) ->
    Seen = sets:new([{version, 2}]),
    {RPO, _} = reverse_postorder_1(Vs, G, Seen, []),
    RPO.

reverse_postorder_1([V|Vs], G, Seen0, Acc0) ->
    case sets:is_element(V, Seen0) of
        true ->
            reverse_postorder_1(Vs, G, Seen0, Acc0);
        false ->
            Seen1 = sets:add_element(V, Seen0),
            Successors = out_neighbours(G, V),
            {Acc,Seen} = reverse_postorder_1(Successors, G, Seen1, Acc0),
            reverse_postorder_1(Vs, G, Seen, [V|Acc])
    end;
reverse_postorder_1([], _, Seen, Acc) ->
    {Acc, Seen}.

-spec roots(graph()) -> [vertex()].
roots(G) ->
    roots_1(vertices(G), G).

roots_1([{V,_}|Vs], G) ->
    case in_degree(G, V) of
        0 ->
            [V|roots_1(Vs, G)];
        _ ->
            roots_1(Vs, G)
    end;
roots_1([], _G) -> [].

-spec topsort(graph()) -> [vertex()].
topsort(G) ->
    Seen = roots(G),
    reverse_postorder(G, Seen).

%%
%% Kosaraju's algorithm
%%
%% Visit each node in reverse post order. If the node has not been assigned to
%% a component yet, start a new component and add all of its in-neighbors to it
%% if they don't yet belong to one. Keep going until all nodes have been
%% visited.
%%
%% https://en.wikipedia.org/wiki/Kosaraju%27s_algorithm
%%

-spec strong_components(graph(), [vertex()]) -> ComponentMap when
      %% Vertices together with their components.
      ComponentMap :: #{ vertex() => [vertex()] }.
strong_components(G, Vs) ->
    sc_1(Vs, G, #{}, #{}).

sc_1([V | Vs], G, Roots0, Components) when not is_map_key(V, Roots0) ->
    %% V has not been assigned to a component, start a new one with this one as
    %% the root.
    {Roots, Component} = sc_2([V], G, V, Roots0, []),
    sc_1(Vs, G, Roots, Components#{ V => Component });
sc_1([V | Vs], G, Roots, Components0) ->
    %% V is already part of a component, copy it over.
    Root = map_get(V, Roots),
    Components = Components0#{ V => map_get(Root, Components0) },

    sc_1(Vs, G, Roots, Components);
sc_1([], _G, _Roots, Components) ->
    Components.

sc_2([V | Vs], G, Root, Roots, Acc) when not is_map_key(V, Roots) ->
    %% V has not been assigned to a component, so assign it to the current one.
    sc_2(in_neighbours(G, V) ++ Vs, G, Root, Roots#{ V => Root }, [V | Acc]);
sc_2([_V | Vs], G, Root, Roots, Acc) ->
    %% V is already part of a component, skip it.
    sc_2(Vs, G, Root, Roots, Acc);
sc_2([], _G, _Root, Roots, Acc) ->
    {Roots, reverse(Acc)}.

-if(?DEBUG).

%%
%% Dumps the graph as a string in dot (graphviz) format.
%%
%% Use dot(1) to convert to an image:
%%
%%    dot [input] -T[format]
%%    dot graph_file -Tsvg > graph.svg

-spec dump(any()) -> any().
dump(G) ->
    Formatter = fun(Node) -> io_lib:format("~p", [Node]) end,
    io:format("~s", [dump_1(G, Formatter)]).

-spec dump(any(), any()) -> any().
dump(G, FileName) ->
    Formatter = fun(Node) -> io_lib:format("~p", [Node]) end,
    dump(G, FileName, Formatter).

-spec dump(any(), any(), any()) -> any().
dump(G, FileName, Formatter) ->
    {ok, Fd} = file:open(FileName, [write]),
    io:fwrite(Fd, "~s", [dump_1(G, Formatter)]),
    file:close(Fd).

dump_1(G, Formatter) ->
    Vs = maps:keys(G#dg.vs),

    {Map, Vertices} = dump_vertices(Vs, 0, Formatter,#{}, []),
    Edges = dump_edges(Vs, G, Map, []),

    io_lib:format("digraph g {~n~s~n~s~n}~n", [Vertices, Edges]).

dump_vertices([V | Vs], Counter, Formatter, Map, Acc) ->
    VerticeSlug = io_lib:format("    ~p [label=\"~s\"]~n",
                                [Counter, Formatter(V)]),
    dump_vertices(Vs, Counter + 1, Formatter,
                  Map#{ V => Counter }, [VerticeSlug | Acc]);
dump_vertices([], _Counter, _Formatter, Map, Acc) ->
    {Map, Acc}.

dump_edges([V | Vs], G, Map, Acc) ->
    SelfId = map_get(V, Map),
    EdgeSlug = [io_lib:format("    ~p -> ~p~n", [SelfId, map_get(To, Map)]) ||
                {_, To, _} <- out_edges(G, V)],
    dump_edges(Vs, G, Map, [EdgeSlug | Acc]);
dump_edges([], _G, _Map, Acc) ->
    Acc.

-endif.