aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/util/hipe_digraph.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe/util/hipe_digraph.erl')
-rw-r--r--lib/hipe/util/hipe_digraph.erl238
1 files changed, 238 insertions, 0 deletions
diff --git a/lib/hipe/util/hipe_digraph.erl b/lib/hipe/util/hipe_digraph.erl
new file mode 100644
index 0000000000..a62e913fe5
--- /dev/null
+++ b/lib/hipe/util/hipe_digraph.erl
@@ -0,0 +1,238 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------------
+%% File : hipe_digraph.erl
+%% Author : Tobias Lindahl <[email protected]>
+%% Purpose : Provides a simple implementation of a directed graph.
+%%
+%% Created : 9 Feb 2005 by Tobias Lindahl <[email protected]>
+%%-----------------------------------------------------------------------
+-module(hipe_digraph).
+
+-export([new/0, add_edge/3, add_node/2, add_node_list/2,
+ from_list/1, to_list/1, get_parents/2, get_children/2]).
+-export([reverse_preorder_sccs/1]).
+
+%%------------------------------------------------------------------------
+
+-type ordset(T) :: [T]. % XXX: temporarily
+
+-record(hipe_digraph, {edges = dict:new() :: dict(),
+ rev_edges = dict:new() :: dict(),
+ leaves = ordsets:new() :: ordset(_), % ???
+ nodes = sets:new() :: set()}).
+
+-opaque hdg() :: #hipe_digraph{}.
+
+%%------------------------------------------------------------------------
+
+-spec new() -> hdg().
+
+new() ->
+ #hipe_digraph{edges = dict:new(), rev_edges = dict:new(),
+ leaves = ordsets:new(), nodes = sets:new()}.
+
+-spec from_list([_]) -> hdg().
+
+from_list(List) ->
+ Edges = lists:foldl(fun({From, To}, Dict) ->
+ Fun = fun(Set) -> ordsets:add_element(To, Set) end,
+ dict:update(From, Fun, [To], Dict)
+ end,
+ dict:new(), List),
+ RevEdges = lists:foldl(fun({From, To}, Dict) ->
+ Fun = fun(Set) ->
+ ordsets:add_element(From, Set)
+ end,
+ dict:update(To, Fun, [From], Dict)
+ end,
+ dict:new(), List),
+ Keys1 = sets:from_list(dict:fetch_keys(Edges)),
+ Keys2 = sets:from_list(dict:fetch_keys(RevEdges)),
+ Nodes = sets:union(Keys1, Keys2),
+ #hipe_digraph{edges = Edges, rev_edges = RevEdges,
+ leaves = [], nodes = Nodes}.
+
+-spec to_list(hdg()) -> [_].
+
+to_list(#hipe_digraph{edges = Edges}) ->
+ List1 = dict:to_list(Edges),
+ List2 = lists:foldl(fun({From, ToList}, Acc) ->
+ [[{From, To} || To <- ToList]|Acc]
+ end, [], List1),
+ lists:flatten(List2).
+
+-spec add_node(_, hdg()) -> hdg().
+
+add_node(NewNode, DG = #hipe_digraph{nodes=Nodes}) ->
+ DG#hipe_digraph{nodes = sets:add_element(NewNode, Nodes)}.
+
+-spec add_node_list([_], hdg()) -> hdg().
+
+add_node_list(NewNodes, DG = #hipe_digraph{nodes=Nodes}) ->
+ Set = sets:from_list(NewNodes),
+ DG#hipe_digraph{nodes = sets:union(Set, Nodes)}.
+
+-spec add_edge(_, _, hdg()) -> hdg().
+
+add_edge(From, To, #hipe_digraph{edges = Edges, rev_edges = RevEdges,
+ leaves = Leaves, nodes = Nodes}) ->
+ Fun1 = fun(Set) -> ordsets:add_element(To, Set) end,
+ NewEdges = dict:update(From, Fun1, [To], Edges),
+ Fun2 = fun(Set) -> ordsets:add_element(From, Set) end,
+ NewRevEdges = dict:update(To, Fun2, [From], RevEdges),
+ NewLeaves = ordsets:del_element(From, Leaves),
+ #hipe_digraph{edges = NewEdges,
+ rev_edges = NewRevEdges,
+ leaves = NewLeaves,
+ nodes = sets:add_element(From, sets:add_element(To, Nodes))}.
+
+%%-------------------------------------------------------------------------
+
+-spec take_indep_scc(hdg()) -> 'none' | {'ok', [_], hdg()}.
+
+take_indep_scc(DG = #hipe_digraph{edges = Edges, rev_edges = RevEdges,
+ leaves = Leaves, nodes = Nodes}) ->
+ case sets:size(Nodes) =:= 0 of
+ true -> none;
+ false ->
+ {SCC, NewLeaves} =
+ case Leaves of
+ [H|T] ->
+ {[H], T};
+ [] ->
+ case find_all_leaves(Edges) of
+ [] ->
+ {[Node|_], _} = dfs(Nodes, RevEdges),
+ {SCC1, _} = dfs(Node, Edges),
+ {SCC1, []};
+ [H|T] ->
+ {[H], T}
+ end
+ end,
+ NewEdges = remove_edges(SCC, Edges, RevEdges),
+ NewRevEdges = remove_edges(SCC, RevEdges, Edges),
+ NewNodes = sets:subtract(Nodes, sets:from_list(SCC)),
+ {ok, reverse_preorder(SCC, Edges),
+ DG#hipe_digraph{edges = NewEdges, rev_edges = NewRevEdges,
+ leaves = NewLeaves, nodes = NewNodes}}
+ end.
+
+find_all_leaves(Edges) ->
+ List = dict:fold(fun(Key, [Key], Acc) -> [Key|Acc];
+ (_, _, Acc) -> Acc
+ end, [], Edges),
+ ordsets:from_list(List).
+
+remove_edges(Nodes0, Edges, RevEdges) ->
+ Nodes = ordsets:from_list(Nodes0),
+ Fun = fun(N, Dict) -> dict:erase(N, Dict) end,
+ Edges1 = lists:foldl(Fun, Edges, Nodes),
+ remove_edges_in(Nodes, Edges1, RevEdges).
+
+remove_edges_in([Node|Nodes], Edges, RevEdges) ->
+ NewEdges =
+ case dict:find(Node, RevEdges) of
+ error ->
+ Edges;
+ {ok, Set} ->
+ Fun = fun(Key, Dict) ->
+ case dict:find(Key, Dict) of
+ error ->
+ Dict;
+ {ok, OldTo} ->
+ case ordsets:del_element(Node, OldTo) of
+ [] -> dict:store(Key, [Key], Dict);
+ NewSet -> dict:store(Key, NewSet, Dict)
+ end
+ end
+ end,
+ lists:foldl(Fun, Edges, Set)
+ end,
+ remove_edges_in(Nodes, NewEdges, RevEdges);
+remove_edges_in([], Edges, _RevEdges) ->
+ Edges.
+
+reverse_preorder([_] = Nodes, _Edges) ->
+ Nodes;
+reverse_preorder([N|_] = Nodes, Edges) ->
+ NodeSet = sets:from_list(Nodes),
+ {PreOrder, _} = dfs(N, Edges),
+ DFS = [X || X <- PreOrder, sets:is_element(X, NodeSet)],
+ lists:reverse(DFS).
+
+%%---------------------------------------------------------------------
+
+-spec reverse_preorder_sccs(hdg()) -> [[_]].
+
+reverse_preorder_sccs(DG) ->
+ reverse_preorder_sccs(DG, []).
+
+reverse_preorder_sccs(DG, Acc) ->
+ case take_indep_scc(DG) of
+ none -> lists:reverse(Acc);
+ {ok, SCC, DG1} -> reverse_preorder_sccs(DG1, [SCC|Acc])
+ end.
+
+%%---------------------------------------------------------------------
+
+-spec get_parents(_, hdg()) -> [_].
+
+get_parents(Node, #hipe_digraph{rev_edges = RevEdges}) ->
+ case dict:is_key(Node, RevEdges) of
+ true -> dict:fetch(Node, RevEdges);
+ false -> []
+ end.
+
+-spec get_children(_, hdg()) -> [_].
+
+get_children(Node, #hipe_digraph{edges = Edges}) ->
+ case dict:is_key(Node, Edges) of
+ true -> dict:fetch(Node, Edges);
+ false -> []
+ end.
+
+%%---------------------------------------------------------------------
+%% dfs/2 returns a preordered depth first search and the nodes visited.
+
+dfs(Node, Edges) ->
+ case sets:is_set(Node) of
+ true ->
+ dfs(sets:to_list(Node), Edges, sets:new(), []);
+ false ->
+ dfs([Node], Edges, sets:new(), [])
+ end.
+
+dfs([Node|Left], Edges, Visited, Order) ->
+ case sets:is_element(Node, Visited) of
+ true ->
+ dfs(Left, Edges, Visited, Order);
+ false ->
+ NewVisited = sets:add_element(Node, Visited),
+ case dict:find(Node, Edges) of
+ error ->
+ dfs(Left, Edges, NewVisited, [Node|Order]);
+ {ok, Succ} ->
+ {NewOrder, NewVisited1} = dfs(Succ, Edges, NewVisited, Order),
+ dfs(Left, Edges, NewVisited1, [Node|NewOrder])
+ end
+ end;
+dfs([], _Edges, Visited, Order) ->
+ {Order, Visited}.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-11 10:42:29 +0000