The R13B03 release.OTP_R13B03

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}.