%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2005-2007, 2009-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: rbmm.points_to_graph.m.
% Main author: Quan Phan.
%
% This module defines the region points-to graph data structure and the
% operations on it.

:- module transform_hlds.rbmm.points_to_graph.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_proc.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_pragma.

:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module set.

%---------------------------------------------------------------------------%

    % The region points-to graph.
:- type rpt_graph.
:- type rptg_nodes == map(rptg_node, rptg_node_content).
:- type rptg_edges == map(rptg_edge, rptg_edge_info).
:- type rptg_outedges == map(rptg_node, map(rptg_edge, rptg_node)).

    % rpt_graph_init(Graph) binds Graph to an empty graph containing
    % no nodes and no edges.
    %
:- func rpt_graph_init = rpt_graph.

:- func rptg_get_nodes(rpt_graph) = rptg_nodes.
:- func rptg_get_edges(rpt_graph) = rptg_edges.
:- func rptg_get_outedges(rpt_graph) = rptg_outedges.

:- func rptg_get_nodes_as_list(rpt_graph) = list(rptg_node).

:- func rptg_get_next_node_id(rpt_graph) = int.

    % rptg_get_node_content(Graph, Node) takes Graph and Node
    % and returns the information NodeContent associated with Node.
    %
    % This operation is O(lgN) for a graph containing N nodes.
    %
:- func rptg_get_node_content(rpt_graph, rptg_node) = rptg_node_content.

    % Overwrite the content of a node.
    %
:- pred rptg_set_node_content(rptg_node::in, rptg_node_content::in,
    rpt_graph::in, rpt_graph::out) is det.

    % Overwrite the allocated status of a node.
    %
:- pred rptg_set_node_is_allocated(rptg_node::in, bool::in,
    rpt_graph::in, rpt_graph::out) is det.

    % rptg_add_node(NodeInfo, Node, OldGraph, NewGraph) takes OldGraph and
    % NodeInfo that is the information to be stored in a new node, and
    % returns a key "Node" which refers to that node, and the new graph
    % NewGraph containing all of the nodes and edges in OldGraph as well as
    % the new node. It is possible to have two nodes in the graph with the
    % same content.
    %
    % This operation is O(lgN) for a graph containing N nodes.
    %
:- pred rptg_add_node(rptg_node_content::in, rptg_node::out,
    rpt_graph::in, rpt_graph::out) is det.

    % rptg_get_edge_contents(Graph, Edge, Start, End, EdgeInfo) takes
    % Graph and Edge and returns the start and end nodes and the
    % content associated with Edge.
    %
:- pred rptg_get_edge_contents(rpt_graph::in, rptg_edge::in, rptg_node::out,
    rptg_node::out, rptg_edge_content::out) is det.

    % rptg_set_edge(Start, End, EdgeContent, Edge, OldGraph, NewGraph)
    % takes a graph OldGraph and adds an edge from Start to End with
    % the information EdgeContent, and returns the edge as Edge
    % and the new graph as NewGraph.
    % If an identical edge already exists then this operation has no effect.
    %
    % This operation is O(lgN+lgM) for a graph with N nodes and M edges.
    %
:- pred rptg_set_edge(rptg_node::in, rptg_node::in, rptg_edge_content::in,
    rptg_edge::out, rpt_graph::in, rpt_graph::out) is det.

    % rptg_successors(Graph, Node) takes a graph Graph and a node Node
    % and returns the set of nodes Nodes that are *directly* reachable
    % (not transitively) from Node.
    %
    % This operation is O(NlgN) for a graph containing N nodes.
    %
:- func rptg_successors(rpt_graph, rptg_node) = set(rptg_node).

    % rptg_path(Graph, Start, End, Path) is true iff there is a path
    % from the node Start to the node End in Graph.
    % When succeed it returns the path as Path, a list of edges.
    %
    % The algorithm will return paths containing at most one cycle.
    %
:- pred rptg_path(rpt_graph, rptg_node, rptg_node, list(rptg_edge)).
:- mode rptg_path(in, in, in, out) is nondet.
:- mode rptg_path(in, in, out, out) is nondet.

    % rptg_reachable_and_having_type(Graph, Start, EType, Node)
    % finds a node that is reachable from Start and has type EType.
    % If not found, fails.
    %
:- pred rptg_reachable_and_having_type(rpt_graph::in, rptg_node::in,
    mer_type::in, rptg_node::out) is semidet.

    % Get a node given the region name (region variable) assigned to it.
    % There is one and only one node with a given region name.
    % Therefore the predicate returns the node as soon as it finds.
    %
:- pred rptg_get_node_by_region_name(rpt_graph::in, string::in,
    rptg_node::out) is det.

    % Get a node given a set of Mercury variables assigned to it.
    % There is one and only one node corresponding to a set of variables.
    % Therefore the predicate returns the node as soon as it finds.
    %
:- pred rptg_get_node_by_vars(rpt_graph::in, set(prog_var)::in,
    rptg_node::out) is det.

    % Get a node given a Mercury variable assigned to it.
    % There is one and only one node of a variable.
    % Therefore the predicate returns the node as soon as it finds.
    %
:- pred rptg_get_node_by_variable(rpt_graph::in, prog_var::in,
    rptg_node::out) is det.

    % Get a node given a node that has been merged into the first one.
    %
:- pred rptg_get_node_by_node(rpt_graph::in, rptg_node::in, rptg_node::out)
    is det.

:- func rptg_lookup_region_name(rpt_graph, rptg_node) = string.
:- func rptg_lookup_node_type(rpt_graph, rptg_node) = mer_type.
:- func rptg_lookup_node_vars(rpt_graph, rptg_node) = set(prog_var).
:- func rptg_lookup_node_is_allocated(rpt_graph, rptg_node) = bool.

:- pred rptg_is_allocated_node(rpt_graph::in, rptg_node::in) is semidet.

    % Return the list of edges (edge id's).
    %
:- func rptg_lookup_list_outedges(rpt_graph, rptg_node) = list(rptg_edge).

    % Return the outedges map.
    %
:- func rptg_lookup_map_outedges(rpt_graph, rptg_node) =
    map(rptg_edge, rptg_node).

    % Return the list of nodes reached directly from a node.
    %
:- func rptg_lookup_list_endnodes(rpt_graph, rptg_node) = list(rptg_node).

    % rptg_find_edge_from_node_with_same_content(N, EdgeContent, Graph, M)
    % finds in Graph, an edge that has the given EdgeContent.
    % If found, it returns the node which the edge points to as M.
    % Fails if no such an edge exists.
    %
    % Note: this predicate is used when we do not know the end node. If we
    % know the start node, the label and the end node, we may want to use
    % rptg_edge_in_graph instead.
    %
:- pred rptg_find_edge_from_node_with_same_content(rptg_node::in,
    rptg_edge_content::in, rpt_graph::in, rptg_node::out) is semidet.

    % Check if an edge (Start, Label, End) is in the Graph or not.
    %
:- pred rptg_edge_in_graph(rptg_node::in, rptg_edge_content::in, rptg_node::in,
    rpt_graph::in) is semidet.

    % This predicate finds all regions that are reachable from X.
    % The regions must be reached by edges with labels (type selectors)
    % which are valid with the type of X.
    %
:- pred rptg_reach_from_a_variable(rpt_graph::in, module_info::in,
    proc_info::in, prog_var::in, set(rptg_node)::in, set(rptg_node)::out)
    is det.

    % Compare two graphs.
    %
:- pred rptg_equal(rpt_graph::in, rpt_graph::in) is semidet.

    % The unify operator.
    % We merge the second node into the first one.
    %
:- pred unify_operator(rptg_node::in, rptg_node::in,
    rpt_graph::in, rpt_graph::out) is det.

    % The edge operator.
    %
:- pred edge_operator(rptg_node::in, rptg_node::in, rptg_edge_content::in,
    rpt_graph::in, rpt_graph::out) is det.

%---------------------------------------------------------------------------%

    % A node in region points-to graphs.
:- type rptg_node
        --->    rptg_node(int).

:- type rptg_node_content
        --->    rptg_node_content(
                    % The set of procedure variables assigned to this node.
                    rptg_nc_vars            :: set(prog_var),

                    % The region variable that names this node.
                    rptg_nc_reg_var_name    :: string,

                    rptg_nc_merged_from     :: set(rptg_node),
                    rptg_nc_node_type       :: mer_type,
                    rptg_nc_is_allocated    :: bool
                ).

:- func rptg_node_content_get_vars(rptg_node_content) = set(prog_var).
:- func rptg_node_content_get_region_name(rptg_node_content) = string.
:- func rptg_node_content_get_merged_from(rptg_node_content) = set(rptg_node).
:- func rptg_node_content_get_node_type(rptg_node_content) = mer_type.
:- func rptg_node_content_get_is_allocated(rptg_node_content) = bool.

:- pred rptg_node_content_set_vars(set(prog_var)::in,
    rptg_node_content::in, rptg_node_content::out) is det.
:- pred rptg_node_content_set_region_name(string::in,
    rptg_node_content::in, rptg_node_content::out) is det.
:- pred rptg_node_content_set_merged_from(set(rptg_node)::in,
    rptg_node_content::in, rptg_node_content::out) is det.
:- pred rptg_node_content_set_node_type(mer_type::in,
    rptg_node_content::in, rptg_node_content::out) is det.
:- pred rptg_node_content_set_is_allocated(bool::in,
    rptg_node_content::in, rptg_node_content::out) is det.

%---------------------------------------------------------------------------%

    % An edge in region points-to graphs.
:- type rptg_edge
        --->    rptg_edge(int).

:- type rptg_edge_content
        --->    rptg_edge_content(
                    rptg_ec_label     :: selector
                    % The label of an edge.
                ).

:- func rptg_edge_content_get_label(rptg_edge_content) = selector.
:- pred rptg_edge_content_set_label(selector::in,
    rptg_edge_content::in, rptg_edge_content::out) is det.

:- type rptg_edge_info
        --->    rptg_edge_info(
                    rptg_edge_from_node     :: rptg_node,
                    rptg_edge_to_node       :: rptg_node,
                    rptg_edge_label         :: rptg_edge_content
                ).

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.

:- import_module parse_tree.var_table.
:- import_module transform_hlds.smm_common.

:- import_module assoc_list.
:- import_module counter.
:- import_module pair.
:- import_module require.
:- import_module solutions.
:- import_module term.

    % A region points-to graph (rpt_graph) is a directed graph in which
    % 1. Each node is associated with some pieces of info represented by
    %    rptg_node_content. The set of nodes is presented as a map
    %    from rptg_node, which is the node id, to rptg_node_content.
    % 2. Each edge is a tuple (start node, label, end node) that is represented
    %    by rtpg_edge_info. The set of edges is presented as a map
    %    from rptg_edge, which is the edge id, to rptg_edge_info.
    %    We refer to label as some information associated with an edge. We
    %    represent it by rptg_edge_content.
    %
    % Two above maps (for sets of nodes and edges) store enough *information*
    % about an rpt graph. But in terms of *accessibility* it is unconvenient.
    % We often access an rpt graph from a node, and then follow
    % the node's outedges to other nodes, then from those nodes through their
    % outedges to other nodes, and so on. To facilitate this, we maintain
    % (redundantly) the outedges of a node. This is represented by
    % a map from rptg_node to all of the node's outedges, which are represented
    % by a map from rptg_edge to rptg_node (end node).
    %
:- type rpt_graph
        --->    rpt_graph(
                    % The source of node ids.
                    rptg_node_supply    :: counter,

                    % The source of edge ids.
                    rptg_edge_supply    :: counter,

                    rptg_nodes          :: rptg_nodes,
                    rptg_edges          :: rptg_edges,
                    rptg_outedges       :: rptg_outedges
                ).

%---------------------------------------------------------------------------%

rpt_graph_init = Graph :-
    counter.init(1, NodeSupply),
    counter.init(1, EdgeSupply),
    map.init(Nodes),
    map.init(Edges),
    map.init(OutEdges),
    Graph = rpt_graph(NodeSupply, EdgeSupply, Nodes, Edges, OutEdges).

:- func rptg_get_node_supply(rpt_graph) = counter.
:- func rptg_get_edge_supply(rpt_graph) = counter.

rptg_get_node_supply(G) = G ^ rptg_node_supply.
rptg_get_edge_supply(G) = G ^ rptg_edge_supply.
rptg_get_nodes(G) = G ^ rptg_nodes.
rptg_get_edges(G) = G ^ rptg_edges.
rptg_get_outedges(G) = G ^ rptg_outedges.

:- pred rptg_set_node_supply(counter::in,
    rpt_graph::in, rpt_graph::out)is det.
:- pred rptg_set_edge_supply(counter::in,
    rpt_graph::in, rpt_graph::out) is det.
:- pred rptg_set_nodes(rptg_nodes::in,
    rpt_graph::in, rpt_graph::out) is det.
:- pred rptg_set_edges(rptg_edges::in,
    rpt_graph::in, rpt_graph::out) is det.
:- pred rptg_set_outedges(rptg_outedges::in,
    rpt_graph::in, rpt_graph::out) is det.

rptg_set_node_supply(NS, !G) :-
    !G ^ rptg_node_supply := NS.
rptg_set_edge_supply(ES, !G) :-
    !G ^ rptg_edge_supply := ES.
rptg_set_nodes(Nodes, !G) :-
    !G ^ rptg_nodes := Nodes.
rptg_set_edges(Edges, !G) :-
    !G ^ rptg_edges := Edges.
rptg_set_outedges(OutEdges, !G) :-
    !G ^ rptg_outedges := OutEdges.

%---------------------------------------------------------------------------%

rptg_get_nodes_as_list(Graph) = NodeList :-
    map.keys(rptg_get_nodes(Graph), NodeList).

%---------------------%

rptg_get_next_node_id(G) = NextNodeId :-
    NodeSupply = rptg_get_node_supply(G),
    counter.allocate(NextNodeId, NodeSupply, _).

%---------------------%

rptg_get_node_content(Graph, Node) = NodeContent :-
    map.lookup(rptg_get_nodes(Graph), Node, NodeContent).

%---------------------%

rptg_set_node_content(Node, NodeContent, !Graph) :-
    Nodes0 = rptg_get_nodes(!.Graph),
    map.det_update(Node, NodeContent, Nodes0, Nodes),
    rptg_set_nodes(Nodes, !Graph).

%---------------------%

rptg_set_node_is_allocated(Node, IsAlloc, !Graph) :-
    NodeContent0 = rptg_get_node_content(!.Graph, Node),
    rptg_node_content_set_is_allocated(IsAlloc, NodeContent0, NodeContent),
    rptg_set_node_content(Node, NodeContent, !Graph).

%---------------------%

    % After adding a node, we need to update Content0 so that the merged_from
    % set of the node contains itself.
    % Doing it this way is not completely satisfied because we are adding a
    % node with the given content but we change the content after all.
    % But without adding the node first, the node is nonexistant and we
    % cannot add it to the merged_from set.
    %
rptg_add_node(Content0, rptg_node(NodeId), !G) :-
    NS0 = rptg_get_node_supply(!.G),
    counter.allocate(NodeId, NS0, NS),
    rptg_set_node_supply(NS, !G),
    Node = rptg_node(NodeId),

    % Make the merged_from set contain this node.
    MergedFrom = set.make_singleton_set(Node),
    rptg_node_content_set_merged_from(MergedFrom, Content0, Content),

    % Add the node.
    NodeMap0 = !.G ^ rptg_nodes,
    map.set(Node, Content, NodeMap0, NodeMap),
    rptg_set_nodes(NodeMap, !G),

    % We can assume there is no outedge for this node yet.
    OutEdges0 = rptg_get_outedges(!.G),
    map.set(Node, map.init, OutEdges0, OutEdges),
    rptg_set_outedges(OutEdges, !G).

%---------------------%

rptg_get_edge_contents(G, Edge, Start, End, Content) :-
    Edges = rptg_get_edges(G),
    map.lookup(Edges, Edge, EdgeInfo),
    EdgeInfo = rptg_edge_info(Start, End, Content).

%---------------------%

rptg_set_edge(Start, End, EdgeContent, Edge, !G) :-
    ES0 = rptg_get_edge_supply(!.G),
    counter.allocate(EdgeId, ES0, ES),
    rptg_set_edge_supply(ES, !G),

    Edge = rptg_edge(EdgeId),

    Edges0 = rptg_get_edges(!.G),
    map.set(Edge, rptg_edge_info(Start, End, EdgeContent), Edges0, Edges),
    rptg_set_edges(Edges, !G),

    % Update the outedges of the Start node.
    OutEdges0 = rptg_get_outedges(!.G),
    map.lookup(OutEdges0, Start, StartOutEdges0),
    map.set(Edge, End, StartOutEdges0, StartOutEdges),
    map.set(Start, StartOutEdges, OutEdges0, OutEdges),
    rptg_set_outedges(OutEdges, !G).

%---------------------%

rptg_successors(Graph, Node) = Successors :-
    SuccessorList = rptg_lookup_list_endnodes(Graph, Node),
    set.list_to_set(SuccessorList, Successors).

%---------------------%

rptg_path(G, S, E, Path) :-
    rptg_path_2(G, S, E, [], Path).

:- pred rptg_path_2(rpt_graph, rptg_node, rptg_node, list(rptg_node),
    list(rptg_edge)).
:- mode rptg_path_2(in, in, in, in, out) is nondet.
:- mode rptg_path_2(in, in, out, in, out) is nondet.

rptg_path_2(G, S, E, Nodes0, Path) :-
    OutEdges = rptg_get_outedges(G),
    map.lookup(OutEdges, S, OutEdgesOfS),
    (
        map.member(OutEdgesOfS, Edge, E),
        not list.member(E, Nodes0),
        Path = [Edge]
    ;
        map.member(OutEdgesOfS, Edge, N),
        not list.member(N, Nodes0),
        rptg_path_2(G, N, E, [N | Nodes0], Path0),
        Path = [Edge | Path0]
    ).

%---------------------%

rptg_reachable_and_having_type(Graph, Start, EType, E) :-
    rptg_lookup_node_type(Graph, Start) = Type,
    ( if Type = EType then
        E = Start
    else
        reachable_and_having_type_2(Graph, [Start], [Start], EType, E)
    ).

    % This implementation uses breath-first search. It ensures that each node
    % becomes "Start" node at most once, therefore it will terminate.
    %
:- pred reachable_and_having_type_2(rpt_graph::in, list(rptg_node)::in,
    list(rptg_node)::in, mer_type::in, rptg_node::out) is semidet.

reachable_and_having_type_2(Graph, [StartNode | StartNodes0], VisitedNodes0,
        EType, E) :-
    Ends = rptg_lookup_list_endnodes(Graph, StartNode),
    ( if find_node_with_same_type(Ends, Graph, EType, E1) then
        % Find such a node, return it.
        E = E1
    else
        % Still not find, do breath-first search, with nodes that we have
        % never started from.
        StartNodes1 = StartNodes0 ++ Ends,
        list.remove_dups([StartNode | VisitedNodes0], VisitedNodes),
        list.delete_elems(StartNodes1, VisitedNodes, StartNodes),

        reachable_and_having_type_2(Graph, StartNodes, VisitedNodes, EType, E)
    ).

    % Find a node with the given type in the list of nodes.
    % If not found, fails.
    %
:- pred find_node_with_same_type(list(rptg_node)::in, rpt_graph::in,
    mer_type::in, rptg_node::out) is semidet.

find_node_with_same_type([N | Ns], Graph, Type, End) :-
    rptg_lookup_node_type(Graph, N) = NType,
    ( if NType = Type then
        End = N
    else
        find_node_with_same_type(Ns, Graph, Type, End)
    ).

%---------------------%

rptg_get_node_by_region_name(Graph, RegionName, Node) :-
    AllNodes = rptg_get_nodes_as_list(Graph),
    ( if
        get_node_by_region_name_from_list(Graph, AllNodes, RegionName,
            NodePrime)
    then
        Node = NodePrime
    else
        unexpected($pred, "node not found")
    ).

:- pred get_node_by_region_name_from_list(rpt_graph::in, list(rptg_node)::in,
    string::in, rptg_node::out) is semidet.

get_node_by_region_name_from_list(Graph, NodeList, RegName, Node) :-
    NodeList = [ANode | Rest],
    RegionANode = rptg_lookup_region_name(Graph, ANode),
    ( if RegionANode = RegName then
        Node = ANode
    else
        get_node_by_region_name_from_list(Graph, Rest, RegName, Node)
    ).

%---------------------%

rptg_get_node_by_vars(Graph, Vars, Node) :-
    Nodes = rptg_get_nodes_as_list(Graph),
    ( if get_node_by_vars_from_list(Graph, Nodes, Vars, NodePrime) then
        Node = NodePrime
    else
        unexpected($pred, "node not found")
    ).

:- pred get_node_by_vars_from_list(rpt_graph::in, list(rptg_node)::in,
    set(prog_var)::in, rptg_node::out) is semidet.

get_node_by_vars_from_list(Graph, List, Vars, Node) :-
    List = [ANode | Rest],
    NodeContent = rptg_get_node_content(Graph, ANode),
    ( if set.subset(Vars, NodeContent ^ rptg_nc_vars) then
        Node = ANode
    else
        get_node_by_vars_from_list(Graph, Rest, Vars, Node)
    ).

%---------------------%

    % Find a node in the graph using a variable assigned to it.
    %
rptg_get_node_by_variable(Graph, Var, Node) :-
    Vars = set.make_singleton_set(Var),
    rptg_get_node_by_vars(Graph, Vars, Node).

%---------------------%

rptg_get_node_by_node(Graph, Node, MergedNode) :-
    NodeMap = rptg_get_nodes(Graph),
    ( if map.search(NodeMap, Node, _NodeContent) then
        MergedNode = Node
    else
        % Not directly in the NodeMap, checked if it has been merged.
        AllNodes = rptg_get_nodes_as_list(Graph),
        ( if
            get_node_by_node_from_list(Graph, AllNodes, Node, MergedNode0)
        then
            MergedNode = MergedNode0
        else
            unexpected($pred, "node not found")
        )
    ).

:- pred get_node_by_node_from_list(rpt_graph::in, list(rptg_node)::in,
    rptg_node::in, rptg_node::out) is semidet.

get_node_by_node_from_list(Graph, [N | Ns], Node, MergedNode) :-
    NodeContent = rptg_get_node_content(Graph, N),
    ( if set.member(Node, NodeContent ^ rptg_nc_merged_from) then
        MergedNode = N
    else
        get_node_by_node_from_list(Graph, Ns, Node, MergedNode)
    ).

%---------------------%

rptg_lookup_region_name(Graph, Node) = RegionName :-
    NodeContent = rptg_get_node_content(Graph, Node),
    RegionName = rptg_node_content_get_region_name(NodeContent).

rptg_lookup_node_type(Graph, Node) = NodeType :-
    NodeContent = rptg_get_node_content(Graph, Node),
    NodeType = rptg_node_content_get_node_type(NodeContent).

rptg_lookup_node_vars(Graph, Node) = Vars :-
    NodeContent = rptg_get_node_content(Graph, Node),
    Vars = rptg_node_content_get_vars(NodeContent).

rptg_lookup_node_is_allocated(Graph, Node) = IsAllocated :-
    NodeContent = rptg_get_node_content(Graph, Node),
    IsAllocated = rptg_node_content_get_is_allocated(NodeContent).

%---------------------%

rptg_is_allocated_node(Graph, Region) :-
    IsAlloc = rptg_lookup_node_is_allocated(Graph, Region),
    IsAlloc = bool.yes.

rptg_lookup_list_outedges(Graph, Node) = EdgeList :-
    OutEdgesOfNode = rptg_lookup_map_outedges(Graph, Node),
    map.keys(OutEdgesOfNode, EdgeList).

rptg_lookup_map_outedges(Graph, Node) = OutEdgesOfNode :-
    OutEdges = rptg_get_outedges(Graph),
    map.lookup(OutEdges, Node, OutEdgesOfNode).

rptg_lookup_list_endnodes(Graph, Node) = EndNodeList :-
    OutEdgesOfNode = rptg_lookup_map_outedges(Graph, Node),
    map.values(OutEdgesOfNode, EndNodeList).

%---------------------------------------------------------------------------%
%
% For finding and checking edges in graph.
%

rptg_find_edge_from_node_with_same_content(N, EdgeContent, G, M) :-
    EdgeList = rptg_lookup_list_outedges(G, N),
    find_edge_with_same_content(EdgeContent, EdgeList, G, M).

:- pred find_edge_with_same_content(rptg_edge_content::in,
    list(rptg_edge)::in, rpt_graph::in, rptg_node::out) is semidet.

find_edge_with_same_content(EdgeContent, [Edge | Edges], G, M) :-
    rptg_get_edge_contents(G, Edge, _N, M0, EdgeContent0),
    ( if EdgeContent0 = EdgeContent then
        M = M0
    else
        find_edge_with_same_content(EdgeContent, Edges, G, M)
    ).

rptg_edge_in_graph(Start, Label, End, Graph) :-
    OutEdgesOfStart = rptg_lookup_map_outedges(Graph, Start),

    % Out of the above, find those that point to End.
    solutions(map.inverse_search(OutEdgesOfStart, End), EdgePointToEndList),

    find_edge_with_same_content(Label, EdgePointToEndList, Graph, _).

%---------------------------------------------------------------------------%

rptg_reach_from_a_variable(Graph, HLDS, ProcInfo, X, !Reach_X) :-
    rptg_get_node_by_variable(Graph, X, N_X),
    Node_Selector = pair(N_X, []),

    proc_info_get_var_table(ProcInfo, VarTable),
    lookup_var_type(VarTable, X, TypeX),

    % Find regions reached from X.
    reach_from_a_variable_2([Node_Selector], Graph, HLDS, TypeX, [], !Reach_X).

    % This predicate receives a (remembered) list of nodes that are
    % reached from X, along with the valid selectors to those nodes
    % from the node of X.
    % Algorithm:
    %
    % 1. each node is recorded into the reach_from_x set,
    % 2. if an target of a node's out-edge can be reached by a valid selector,
    %    , we "remember" the target as reachable from X but not record it yet,
    % 3. do until the remembered list is empty.
    %
:- pred reach_from_a_variable_2(assoc_list(rptg_node, selector)::in,
    rpt_graph::in, module_info::in, mer_type::in, list(rptg_node)::in,
    set(rptg_node)::in, set(rptg_node)::out) is det.

reach_from_a_variable_2([], _, _, _, _, !Reach_X).
reach_from_a_variable_2([Node_Selector | Node_Selectors0],
        Graph, HLDS, TypeX, Processed0, !Reach_X) :-
    Node_Selector = Node - Selector,

    % Add the "remembered" Node to reach_from_x set
    set.insert(Node, !Reach_X),

    % Add the Node to processed list so that we do not have to deal with
    % it more than once. (Node is not yet in Processed0 because if it
    % is in there it will not be in the to-be-processed list.
    Processed = [Node | Processed0],

    % Take out-edges of the Node and update the remembered list.
    EdgeList = rptg_lookup_list_outedges(Graph, Node),
    list.foldl(
        update_remembered_list(Selector, HLDS, TypeX, Graph, Processed),
        EdgeList, Node_Selectors0, Node_Selectors),

    reach_from_a_variable_2(Node_Selectors, Graph, HLDS, TypeX,
        Processed, !Reach_X).

    % A target is remembered as reachable from X if its edge's selector
    % is valid. The remembered list is appended, so it is a breadth-first
    % process.
    %
:- pred update_remembered_list(selector::in, module_info::in,
    mer_type::in, rpt_graph::in, list(rptg_node)::in, rptg_edge::in,
    assoc_list(rptg_node, selector)::in,
    assoc_list(rptg_node, selector)::out) is det.

update_remembered_list(Selector0, HLDS, TypeX, Graph, Processed, OutEdge,
        !List) :-
    rptg_get_edge_contents(Graph, OutEdge, _Start, End, EdgeContent),
    EdgeSelector = rptg_edge_content_get_label(EdgeContent),
    Selector = Selector0 ++ EdgeSelector,
    ( if check_type_of_node(HLDS, TypeX, Selector) then
        % The edge's selector is a valid one.
        ( if list.member(End, Processed) then
            % Already processed, ignore.
            true
        else
            % A non-processed node and can be reached from X by a
            % valid selector, so it is remembered.
            !:List = !.List ++ [pair(End, Selector)]
        )
    else
        % Selector is not valid, ignore.
        true
    ).

%---------------------------------------------------------------------------%
%
% Equality of region points-to graphs.
%

rptg_equal(Graph1, Graph2) :-
    Graph1 = rpt_graph(NS1, AS1, Nodes1, Edges1, OutEdges1),
    Graph2 = rpt_graph(NS2, AS2, Nodes2, Edges2, OutEdges2),
    NS1 = NS2,
    AS1 = AS2,
    simple_map_equal(Nodes1, Nodes2),
    simple_map_equal(Edges1, Edges2),
    complex_map_equal(OutEdges1, OutEdges2).

% The comparisons below may not be necessary, unification can help if it is
% sure that the elements are added to the maps in the same order.
%
    % The values of the maps are required to be comparable using
    % unification, i.e., values of type V1 can be compared using
    % unification.
    %
:- pred simple_map_equal(map(K1, V1)::in, map(K1, V1)::in) is semidet.

simple_map_equal(Map1, Map2) :-
    % Check if they have the same number of entries?
    map.count(Map1, C1),
    map.count(Map2, C2),
    C1 = C2,

    % If yes, check if all the entries are equal.
    map.keys(Map1, Ks1),
    simple_map_equal_2(Ks1, Map1, Map2).

    % With the condition that the two maps have the same number of entries,
    % verify that all keys in map 1 are also in map 2 and that their
    % corresponding values are equal.
    %
:- pred simple_map_equal_2(list(K1)::in,
    map(K1, V1)::in, map(K1, V1)::in) is semidet.

simple_map_equal_2([], _, _).
simple_map_equal_2([K | Ks], Map1, Map2) :-
    % K is also in map 2?
    map.search(Map2, K, V2),

    % Yes, so check whether the values are equal.
    map.lookup(Map1, K, V1),
    V1 = V2,
    simple_map_equal_2(Ks, Map1, Map2).

    % The maps need to be of map-in-map structure, namely
    % map(k1, map(k2, v)) and values of type V can be compared by unifying
    % (i.e., in our notion here map(k2, v) is a "simple" map).
    %
:- pred complex_map_equal(map(K1, map(K2, V))::in, map(K1, map(K2, V))::in)
    is semidet.

complex_map_equal(Map1, Map2) :-
    map.count(Map1, C1),
    map.count(Map2, C2),
    C1 = C2,
    map.keys(Map1, Ks1),
    complex_map_equal_2(Ks1, Map1, Map2).

:- pred complex_map_equal_2(list(K1)::in, map(K1, map(K2, V))::in,
    map(K1, map(K2, V))::in) is semidet.

complex_map_equal_2([], _, _).
complex_map_equal_2([K | Ks], Map1, Map2) :-
    map.search(Map2, K, V2),

    % V2 is "simple" map, so compare it with V1.
    map.lookup(Map1, K, V1),
    simple_map_equal(V1, V2),
    complex_map_equal_2(Ks, Map1, Map2).

%---------------------------------------------------------------------------%
%
% The two graph-manipulating operators, i.e., unify and edge.
%

unify_operator(Node1, Node2, !Graph) :-
    Nodes0 = rptg_get_nodes(!.Graph),
    NodeContent1 = rptg_get_node_content(!.Graph, Node1),
    NodeContent2 = rptg_get_node_content(!.Graph, Node2),

    % The vars need to be unioned.
    set.union(NodeContent1 ^ rptg_nc_vars, NodeContent2 ^ rptg_nc_vars,
        UnionVars),
    rptg_node_content_set_vars(UnionVars, NodeContent1, NewContent0),

    % Union the merged_from sets.
    set.union(NodeContent1 ^ rptg_nc_merged_from,
        NodeContent2 ^ rptg_nc_merged_from, UnionMergedFrom),
    rptg_node_content_set_merged_from(UnionMergedFrom,
        NewContent0, NewContent1),

    % The unified node is marked allocated if
    % at least one of them is allocated.
    IsAllocated = bool.or(NodeContent1 ^ rptg_nc_is_allocated,
        NodeContent2 ^ rptg_nc_is_allocated),
    rptg_node_content_set_is_allocated(IsAllocated,
        NewContent1, NewContent),

    map.det_update(Node1, NewContent, Nodes0, Nodes),

    !Graph ^ rptg_nodes := Nodes,

    % Copy all out-edges of node 2 to node 1.
    transfer_out_edges(Node1, Node2, !Graph),

    % Copy all in-edges of node 2 to node 1.
    transfer_in_edges(Node1, Node2, !Graph),

    % Remove node 2.
    delete_node(Node2, !Graph).

    % This predicate receives a graph and returns a new graph in which
    % for all the out-edges of node2 in the first graph are copied to
    % node1, as out-edges of node1.
    %
:- pred transfer_out_edges(rptg_node::in, rptg_node::in, rpt_graph::in,
    rpt_graph::out) is det.

transfer_out_edges(Node1, Node2, !Graph) :-
    % Out-edges from node 2.
    EdgeList = rptg_lookup_list_outedges(!.Graph, Node2),

    % Transfer them to node 1.
    transfer_out_edges_2(EdgeList, Node1, !Graph).

    % This predicate receives a list of out-edges of node2 and returns a
    % graph with all the edges in the list copied to Node1, but it
    % maintains the invariant that "there is only one edge with a
    % specific label from a specific node to another specific node".
    % The algorithm is as follows.
    % for each edge (Node2, Content, Node) in EdgeList:
    %   if (Node1, Content, Node) exists
    %       ignore the edge.
    %   else
    %       copy the edge to Node1.
    %
:- pred transfer_out_edges_2(list(rptg_edge)::in, rptg_node::in,
    rpt_graph::in, rpt_graph::out) is det.

transfer_out_edges_2([], _, !Graph).
transfer_out_edges_2([Edge | Edges], Node1, !Graph) :-
    rptg_get_edge_contents(!.Graph, Edge, _Node2, Node, EdgeContent),
    ( if rptg_edge_in_graph(Node1, EdgeContent, Node, !.Graph) then
        true
    else
        % Not existed, copy the Edge as an out-edge of Node1.
        rptg_set_edge(Node1, Node, EdgeContent, _Edge, !Graph)
    ),
    transfer_out_edges_2(Edges, Node1, !Graph).

    % This predicate receives a graph and returns a new graph in which
    % all the in-edges of node2 in the first graph are copied as in-edges
    % of node1.
    %
:- pred transfer_in_edges(rptg_node::in, rptg_node::in, rpt_graph::in,
    rpt_graph::out) is det.

transfer_in_edges(Node1, Node2, !Graph) :-
    % In-edges of node 2.
    rptg_get_in_edges(!.Graph, Node2, InEdges),

    % Copy them to node 1.
    transfer_in_edges_2(InEdges, Node1, !Graph).

    % Finding incoming edges to a node is not direct as finding outcoming
    % ones, we have to scan all the edges in the graph and explicitly
    % check their ending node.
    % XXX This potentially is very inefficient. We might consider storing
    % InEdges explicitly like OutEdges.
    %
:- pred rptg_get_in_edges(rpt_graph::in, rptg_node::in, list(rptg_edge)::out)
    is det.

rptg_get_in_edges(Graph, Node, InEdges) :-
    Edges = rptg_get_edges(Graph),
    map.foldl(edge_points_to_node(Node), Edges, [], InEdges).

:- pred edge_points_to_node(rptg_node::in, rptg_edge::in, rptg_edge_info::in,
    list(rptg_edge)::in, list(rptg_edge)::out) is det.

edge_points_to_node(End, Edge, EdgeInfo, !L) :-
    EdgeInfo = rptg_edge_info(_S, E, _C),
    ( if E = End then
        !:L = [Edge | !.L]
    else
        true
    ).

    % This predicate is very similar to transfer_out_edges_2, except that
    % the edges now point to Node1, instead of going out from it.
    %
:- pred transfer_in_edges_2(list(rptg_edge)::in, rptg_node::in,
    rpt_graph::in, rpt_graph::out) is det.

transfer_in_edges_2([], _, !Graph).
transfer_in_edges_2([Edge | Edges], Node1, !Graph) :-
    rptg_get_edge_contents(!.Graph, Edge, Node, _Node2, EdgeContent),
    ( if rptg_edge_in_graph(Node, EdgeContent, Node1, !.Graph) then
        true
    else
        % No, copy the Edge as an in-edge of Node1.
        rptg_set_edge(Node, Node1, EdgeContent, _Edge, !Graph)
    ),
    transfer_in_edges_2(Edges, Node1, !Graph).

    % Delete a node from the graph.
    % We also need to delete all the edges from and to the Node.
    %
:- pred delete_node(rptg_node::in, rpt_graph::in, rpt_graph::out) is det.

delete_node(Node,
    rpt_graph(NS, AS, !.Nodes, !.Edges, !.OutEdges),
    rpt_graph(NS, AS, !:Nodes, !:Edges, !:OutEdges)) :-
    map.delete(Node, !Nodes),
    delete_all_outedges_and_edges(Node, !Edges, !OutEdges),
    delete_all_inedges_and_edges(Node, !Edges, !OutEdges).

    % This predicate deletes all the outedges of Node.
    % Note: it works as a helper for delete_node so it does not proceed
    % on a graph but on the edges map and outedges map.
    %
:- pred delete_all_outedges_and_edges(rptg_node::in,
    rptg_edges::in, rptg_edges::out,
    rptg_outedges::in, rptg_outedges::out) is det.

delete_all_outedges_and_edges(Node, !Edges, !OutEdges) :-
    % Delete the edges themselves.
    map.lookup(!.OutEdges, Node, OutEdgesOfNode),
    map.keys(OutEdgesOfNode, TheEdges),
    map.delete_list(TheEdges, !Edges),

    % Delete the info about outcoming edges.
    map.delete(Node, !OutEdges).

    % This predicate deletes all the incoming edges of the input node (Node).
    % We only store outcoming edges therefore to remove incoming ones of Node
    % we need to check all the outcoming edges and remove those point to Node.
    %
:- pred delete_all_inedges_and_edges(rptg_node::in,
    rptg_edges::in, rptg_edges::out, rptg_outedges::in, rptg_outedges::out)
    is det.

delete_all_inedges_and_edges(Node, !Edges, !OutEdges) :-
    map.keys(!.OutEdges, StartNodes),

    % For each node: find the outcoming edges from it
    % and delete ones pointing to Node.
    delete_all_inedges_and_edges_2(StartNodes, Node, !Edges, !OutEdges).

    % This predicate receives a node (Node) and a list of (start) nodes.
    % It deletes all the start nodes' outcoming edges and corresponding edges
    % which point to the Node.
    %
:- pred delete_all_inedges_and_edges_2(list(rptg_node)::in, rptg_node::in,
    rptg_edges::in, rptg_edges::out, rptg_outedges::in, rptg_outedges::out)
    is det.

delete_all_inedges_and_edges_2([], _, !Edges, !OutEdges).
delete_all_inedges_and_edges_2([N | Ns], Node, !Edges, !OutEdges) :-
    map.lookup(!.OutEdges, N, OutEdgesOfN0),

    % Find the edges that point to Node.
    solutions(map.inverse_search(OutEdgesOfN0, Node), EdgesFromNPointToNode),

    % Delete the edges themselves.
    map.delete_list(EdgesFromNPointToNode, !Edges),

    % Delete the info about outedges.
    map.delete_list(EdgesFromNPointToNode, OutEdgesOfN0, OutEdgesOfN),
    map.set(N, OutEdgesOfN, !OutEdges),
    delete_all_inedges_and_edges_2(Ns, Node, !Edges, !OutEdges).

edge_operator(Start, End, Info, !G) :-
    rptg_set_edge(Start, End, Info, _Edge, !G).

%---------------------------------------------------------------------------%

rptg_node_content_get_vars(NC) = NC ^ rptg_nc_vars.
rptg_node_content_get_region_name(NC) = NC ^ rptg_nc_reg_var_name.
rptg_node_content_get_merged_from(NC) = NC ^ rptg_nc_merged_from.
rptg_node_content_get_node_type(NC) = NC ^ rptg_nc_node_type.
rptg_node_content_get_is_allocated(NC) = NC ^ rptg_nc_is_allocated.

rptg_node_content_set_vars(Vars, !NC) :-
    !NC ^ rptg_nc_vars := Vars.
rptg_node_content_set_region_name(Name, !NC) :-
    !NC ^ rptg_nc_reg_var_name := Name.
rptg_node_content_set_merged_from(Nodes, !NC) :-
    !NC ^ rptg_nc_merged_from := Nodes.
rptg_node_content_set_node_type(NodeType, !NC) :-
    !NC ^ rptg_nc_node_type := NodeType.
rptg_node_content_set_is_allocated(IsAllocated, !NC) :-
    !NC ^ rptg_nc_is_allocated := IsAllocated.

%---------------------------------------------------------------------------%

rptg_edge_content_get_label(AC) = AC ^ rptg_ec_label.
rptg_edge_content_set_label(Label, !AC) :-
    !AC ^ rptg_ec_label := Label.

%---------------------------------------------------------------------------%
:- end_module transform_hlds.rbmm.points_to_graph.
%---------------------------------------------------------------------------%
