From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/hipe/util/hipe_digraph.erl | 238 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 238 insertions(+) create mode 100644 lib/hipe/util/hipe_digraph.erl (limited to 'lib/hipe/util/hipe_digraph.erl') 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 +%% Purpose : Provides a simple implementation of a directed graph. +%% +%% Created : 9 Feb 2005 by Tobias Lindahl +%%----------------------------------------------------------------------- +-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}. -- cgit v1.2.3