mercury/compiler/rbmm.points_to_analysis.m

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% Copyright (C) 2017 The Mercury Team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File rbmm.points_to_analysis.m.
% Main author: Quan Phan.
%
% This module implements the region points-to analysis (rpta), which collects
% for each procedure a region points-to graph representing the splitting of
% the heap used by the procedure into regions, i.e., which variables are
% stored in which regions. Because the region model is polymorphic, i.e., we
% can pass different actual regions for region arguments, the analysis also
% gathers the alpha mapping, which maps formal region parameters to actual
% ones at each call site in a procedure. So there are 2 sorts of information:
% region points-to graph (rptg) and alpha mapping.
%
% The analysis is composed of 2 phases:
%
%   1. intraprocedural analysis: only analyses unifications and compute only
%      rptgs.
%   2. interprocedural analysis: only analyses (plain) procedure calls,
%      compute both rptgs and alpha mappings.
%
% Currently the analysis ONLY collects the information, do NOT record it into
% the HLDS.
%
%-----------------------------------------------------------------------------%

:- module transform_hlds.rbmm.points_to_analysis.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module transform_hlds.rbmm.points_to_info.

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

:- pred region_points_to_analysis(rpta_info_table::out,
    module_info::in, module_info::out) is det.

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

:- implementation.

:- import_module hlds.goal_path.
:- import_module hlds.hlds_dependency_graph.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module libs.
:- import_module libs.dependency_graph.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_pragma.
:- import_module transform_hlds.rbmm.points_to_graph.
:- import_module transform_hlds.smm_common.
:- import_module transform_hlds.ctgc.
:- import_module transform_hlds.ctgc.fixpoint_table.

:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.

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

region_points_to_analysis(InfoTable, !ModuleInfo) :-
    rpta_info_table_init = InfoTable0,
    intra_proc_rpta(!.ModuleInfo, InfoTable0, InfoTable1),
    inter_proc_rpta(!.ModuleInfo, InfoTable1, InfoTable).

%----------------------------------------------------------------------------%
%
% Phase 1: intraprocedural region points-to analysis
%

:- pred intra_proc_rpta(module_info::in,
    rpta_info_table::in, rpta_info_table::out) is det.

intra_proc_rpta(ModuleInfo, !InfoTable) :-
    module_info_get_valid_pred_ids(ModuleInfo, PredIds),
    list.foldl(intra_proc_rpta_pred(ModuleInfo), PredIds, !InfoTable).

:- pred intra_proc_rpta_pred(module_info::in, pred_id::in,
    rpta_info_table::in, rpta_info_table::out) is det.

intra_proc_rpta_pred(ModuleInfo, PredId, !InfoTable) :-
    module_info_pred_info(ModuleInfo, PredId, PredInfo),
    ProcIds = pred_info_non_imported_procids(PredInfo),
    list.foldl(intra_proc_rpta_proc(ModuleInfo, PredId), ProcIds, !InfoTable).

:- pred intra_proc_rpta_proc(module_info::in, pred_id::in, proc_id::in,
    rpta_info_table::in, rpta_info_table::out) is det.

intra_proc_rpta_proc(ModuleInfo, PredId, ProcId, !InfoTable) :-
    PPId = proc(PredId, ProcId),
    ( if some_are_special_preds([PPId], ModuleInfo) then
        true
    else
        module_info_proc_info(ModuleInfo, PPId, ProcInfo),
        RptaInfo0 = rpta_info_init(ProcInfo),
        proc_info_get_goal(ProcInfo, Goal),
        intra_analyse_goal(Goal, RptaInfo0, RptaInfo),
        rpta_info_table_set_rpta_info(PPId, RptaInfo, !InfoTable)
    ).

:- pred intra_analyse_goal(hlds_goal::in, rpta_info::in, rpta_info::out)
    is det.

intra_analyse_goal(Goal, !RptaInfo) :-
    Goal = hlds_goal(GoalExpr, _),
    intra_analyse_goal_expr(GoalExpr, !RptaInfo).

:- pred intra_analyse_goal_expr(hlds_goal_expr::in,
    rpta_info::in, rpta_info::out) is det.

intra_analyse_goal_expr(conj(_ConjType, Goals), !RptaInfo) :-
    list.foldl(intra_analyse_goal, Goals, !RptaInfo).

    % Calls (of all types) are not considered during the intraprocedural
    % analysis.
    %
intra_analyse_goal_expr(plain_call(_, _, _, _, _, _), !RptaInfo).
intra_analyse_goal_expr(generic_call(_, _, _, _, _), !RptaInfo).
intra_analyse_goal_expr(call_foreign_proc(_, _, _, _, _, _, _), !RptaInfo).

intra_analyse_goal_expr(switch(_, _, Cases), !RptaInfo) :-
    list.foldl(intra_analyse_case, Cases, !RptaInfo).
intra_analyse_goal_expr(disj(Goals), !RptaInfo) :-
    list.foldl(intra_analyse_goal, Goals, !RptaInfo).
intra_analyse_goal_expr(negation(Goal), !RptaInfo) :-
    intra_analyse_goal(Goal, !RptaInfo).
intra_analyse_goal_expr(unify(_, _, _, Unification, _), !RptaInfo) :-
    intra_analyse_unification(Unification, !RptaInfo).

    % scope
    % XXX: only analyse the goal. May need to take into account the Reason.
    %
intra_analyse_goal_expr(scope(_Reason, Goal), !RptaInfo) :-
%    (
%       ( Reason = exist_quant(_)
%        ; Reason = promise_solutions(_, _)      % XXX ???
%        ; Reason = promise_purity(_, _)
%        ; Reason = commit(_)                    % XXX ???
%        ; Reason = barrier(_)
%        ; Reason = trace_goal(_, _, _, _, _)
%        ; Reason = from_ground_term(_)
%        ),
        intra_analyse_goal(Goal, !RptaInfo).
%    ;
%        Msg = "intra_analyse_goal_expr: Scope's reason of from_ground_term "
%            ++ "not handled",
%        unexpected($pred, Msg)
%    ).

intra_analyse_goal_expr(if_then_else(_Vars, If, Then, Else), !RptaInfo) :-
    intra_analyse_goal(If, !RptaInfo),
    intra_analyse_goal(Then, !RptaInfo),
    intra_analyse_goal(Else, !RptaInfo).

intra_analyse_goal_expr(shorthand(_), _, _) :-
    % These should have been expanded out by now.
    unexpected($pred, "shorthand").

:- pred intra_analyse_case(case::in, rpta_info::in, rpta_info::out) is det.

intra_analyse_case(Case, !RptaInfo) :-
    Case = case(_, _, Goal),
    intra_analyse_goal(Goal, !RptaInfo).

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

    % For construction and deconstruction unifications, add an edge from
    % the node of the variable on the LHS to that of each variable on the RHS.
    % For construction, also mark the node of lhs variable allocated.
    %
    % For assignment unifications we merge the nodes corresponding to
    % the variables on either side.
    %
    % For simple test unifications we do nothing.
    %
:- pred intra_analyse_unification(unification::in,
    rpta_info::in, rpta_info::out) is det.

intra_analyse_unification(construct(LVar, ConsId, RVars, _, _, _, _),
        rpta_info(!.Graph, AlphaMapping), rpta_info(!:Graph, AlphaMapping)) :-
    % Mark allocated.
    rptg_get_node_by_variable(!.Graph, LVar, LNode),
    LNodeContent0 = rptg_get_node_content(!.Graph, LNode),
    LNodeContent0 = rptg_node_content(A, B, C, D, _IsAlloc),
    LNodeContent = rptg_node_content(A, B, C, D, bool.yes),
    rptg_set_node_content(LNode, LNodeContent, !Graph),

    % Add edges.
    list.foldl2(process_cons_and_decons(LVar, ConsId), RVars, 1, _, !Graph).

intra_analyse_unification(deconstruct(LVar, ConsId, RVars, _, _, _),
        rpta_info(!.Graph, AlphaMapping), rpta_info(!:Graph, AlphaMapping)) :-
    list.foldl2(process_cons_and_decons(LVar, ConsId), RVars, 1, _, !Graph).
intra_analyse_unification(assign(ToVar, FromVar),
    rpta_info(!.Graph, AlphaMapping), rpta_info(!:Graph, AlphaMapping)) :-
    rptg_get_node_by_variable(!.Graph, ToVar, ToNode),
    rptg_get_node_by_variable(!.Graph, FromVar, FromNode),
    ( if ToNode = FromNode then
        true
    else
        unify_operator(ToNode, FromNode, !Graph),
        % After merging the two nodes, apply rule P1 to restore the
        % RPTG's invariants.
        rule_1(ToNode, !Graph)
    ).
intra_analyse_unification(simple_test(_, _), !RptaInfo).
intra_analyse_unification(complicated_unify(_, _, _), _, _) :-
    unexpected($pred, "complicated_unify").

:- pred process_cons_and_decons(prog_var::in, cons_id::in, prog_var::in,
    int::in, int::out, rpt_graph::in, rpt_graph::out) is det.

process_cons_and_decons(LVar, ConsId, RVar, !Component, !Graph) :-
    rptg_get_node_by_variable(!.Graph, LVar, LNode),
    rptg_get_node_by_variable(!.Graph, RVar, RNode),
    Sel = [termsel(ConsId, !.Component)],
    EdgeLabel = rptg_edge_content(Sel),

    % Only add the edge if it is not in the graph.
    % It is more suitable to the edge_operator's semantics if we check
    % this inside the edge_operator. But we also want to know if the edge
    % is actually added or not so it is convenient to check the edge's
    % existence outside edge_operator. Otherwise we can extend edge_operator
    % with one more argument to indicate that.
    ( if rptg_edge_in_graph(LNode, EdgeLabel, RNode, !.Graph) then
        true
    else
        edge_operator(LNode, RNode, EdgeLabel, !Graph),

        % After an edge is added, rules P2 and P3 are applied to ensure
        % the invariants of the graph.
        rule_2(LNode, RNode, ConsId, !.Component, !Graph),

        % In case the node containing RVar might have changed.
        rptg_get_node_by_variable(!.Graph, RVar, RVarNode),
        rule_3(RVarNode, !Graph)
    ),
    !:Component = !.Component + 1.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Phase 2: interprocedural region points-to analysis
%

    % The interprocedural analysis requires fixpoint computation,
    % so we will compute a fixpoint for each strongly connected component.
    %
:- pred inter_proc_rpta(module_info::in,
    rpta_info_table::in, rpta_info_table::out) is det.

inter_proc_rpta(ModuleInfo0, !InfoTable) :-
    module_info_ensure_dependency_info(ModuleInfo0, ModuleInfo, DepInfo),
    BottomUpSCCs = dependency_info_get_bottom_up_sccs(DepInfo),
    run_with_dependencies(BottomUpSCCs, ModuleInfo, !InfoTable).

:- pred run_with_dependencies(hlds_bottom_up_dependency_sccs::in,
    module_info::in, rpta_info_table::in, rpta_info_table::out) is det.

run_with_dependencies(BottomUpSCCs, ModuleInfo, !InfoTable) :-
    list.foldl(run_with_dependency(ModuleInfo), BottomUpSCCs, !InfoTable).

:- pred run_with_dependency(module_info::in, set(pred_proc_id)::in,
    rpta_info_table::in, rpta_info_table::out) is det.

run_with_dependency(ModuleInfo, SCC, !InfoTable) :-
    set.to_sorted_list(SCC, SCCProcs),
    ( if some_are_special_preds(SCCProcs, ModuleInfo) then
        % Analysis ignores special predicates.
        true
    else
        % Run the fixpoint computation on the SCC.
        FPTable = init_rpta_fixpoint_table(SCCProcs, !.InfoTable),
        run_with_dependency_until_fixpoint(SCC, FPTable, ModuleInfo,
            !InfoTable)
    ).

:- pred run_with_dependency_until_fixpoint(scc::in,
    rpta_fixpoint_table::in, module_info::in, rpta_info_table::in,
    rpta_info_table::out) is det.

run_with_dependency_until_fixpoint(SCC, FPTable0, ModuleInfo, !InfoTable) :-
    set.foldl(inter_analyse_proc(ModuleInfo, !.InfoTable), SCC,
        FPTable0, FPTable1),
    ( if fixpoint_reached(FPTable1) then
        % If we have reached a fixpoint for this SCC then update the
        % RPTA info table.
        set.foldl(update_rpta_info_in_rpta_info_table(FPTable1), SCC,
            !InfoTable)
    else
        % Otherwise, begin the next iteration.
        new_run(FPTable1, FPTable),
        run_with_dependency_until_fixpoint(SCC, FPTable, ModuleInfo,
            !InfoTable)
    ).

:- pred inter_analyse_proc(module_info::in, rpta_info_table::in,
    pred_proc_id::in, rpta_fixpoint_table::in, rpta_fixpoint_table::out)
    is det.

inter_analyse_proc(ModuleInfo, InfoTable, PPId, !FPTable) :-
    % Look up the procedure's rpta_info.
    % If this is the first iteration then the rtpa_info we use is the
    % one computed for this procedure during the intraprocedural analysis.
    %
    lookup_rpta_info(PPId, InfoTable, !FPTable, ProcRptaInfo0, _),

    % Start the analysis of the procedure's body.
    %
    % We will need the information about program point for storing alpha
    % mapping.
    %
    % XXX we should only fill goal path slots once, not once per iteration.
    %
    module_info_proc_info(ModuleInfo, PPId, ProcInfo0),
    fill_goal_path_slots_in_proc(ModuleInfo, ProcInfo0, ProcInfo),

    proc_info_get_goal(ProcInfo, Goal),
    inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPTable,
        ProcRptaInfo0, ProcRptaInfo),

    % Put the result of this iteration into the fixpoint table.
    %
    rpta_fixpoint_table_new_rpta_info(PPId, ProcRptaInfo, !FPTable).

%-----------------------------------------------------------------------------%
%
% Code for interprocedural analysis of goals.
%

    % Analyse a given goal, with module_info and fixpoint table
    % to lookup extra information, starting from an initial abstract
    % substitution, and creating a new one. During this process,
    % the fixpoint table might change (when recursive predicates are
    % encountered).
    %
:- pred inter_analyse_goal(module_info::in,
    rpta_info_table::in, hlds_goal::in,
    rpta_fixpoint_table::in, rpta_fixpoint_table::out,
    rpta_info::in, rpta_info::out) is det.

inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPtable, !RptaInfo) :-
    Goal = hlds_goal(GoalExpr, GoalInfo),
    inter_analyse_goal_expr(GoalExpr, GoalInfo, ModuleInfo, InfoTable,
        !FPtable, !RptaInfo).

:- pred inter_analyse_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
    module_info::in, rpta_info_table::in, rpta_fixpoint_table::in,
    rpta_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.

inter_analyse_goal_expr(conj(_ConjType, Goals), _, ModuleInfo,
        InfoTable, !FPTable, !RptaInfo) :-
    list.foldl2(inter_analyse_goal(ModuleInfo, InfoTable), Goals,
        !FPTable, !RptaInfo).

    % There are two rpta_info's:
    % one is of the currently-analysed procedure (caller) which we are going
    % to update, the other is of the called procedure (callee).
    %
    % The input RptaInfo is caller's, if the procedure calls itself then
    % this is also that of the callee but we will retrieve it again from the
    % InfoTable.
    %
inter_analyse_goal_expr(Goal, GoalInfo, ModuleInfo, InfoTable,
        !FPTable, !CallerRptaInfo) :-
    Goal = plain_call(PredId, ProcId, ActualParams, _, _, _),
    CalleePPId = proc(PredId, ProcId),

    % Get callee's rpta_info.
    % As what I assume now, after the intraprocedural analysis we have all
    % the rpta_info's of all the procedures in the InfoTable, therefore
    % this lookup cannot fail. But it sometimes fails because the callee
    % can be imported procedures, built-ins and so forth which are not
    % analysed by the intraprocedural analysis. In such cases, I assume that
    % the rpta_info of the caller is not updated, because no information is
    % available from the callee.
    % When IsInit = no, the CalleeRptaInfo is dummy.
    lookup_rpta_info(CalleePPId, InfoTable, !FPTable, CalleeRptaInfo, IsInit),
    (
        IsInit = yes
    ;
        IsInit = no,
        CallSite = program_point_init(GoalInfo),
        CalleeRptaInfo = rpta_info(CalleeGraph, _),

        % Collect alpha mapping at this call site.
        module_info_proc_info(ModuleInfo, CalleePPId, CalleeProcInfo),
        proc_info_get_headvars(CalleeProcInfo, FormalParams),
        !.CallerRptaInfo = rpta_info(CallerGraph0, CallerAlphaMappings0),
        alpha_mapping_at_call_site(FormalParams, ActualParams, CalleeGraph,
            CallerGraph0, CallerGraph,
            map.init, CallerAlphaMappingAtCallSite),
        map.set(CallSite, CallerAlphaMappingAtCallSite,
            CallerAlphaMappings0, CallerAlphaMappings),
        CallerRptaInfo1 = rpta_info(CallerGraph, CallerAlphaMappings),

        % Follow the edges from the nodes rooted at the formal parameters
        % (in the callee's graph) and apply the interprocedural rules to
        % complete the alpha mapping and update the caller's graph with
        % the information from the callee's graph.
        map.keys(CallerAlphaMappingAtCallSite, FormalNodes),
        apply_rules(FormalNodes, CallSite, [], CalleeRptaInfo,
            CallerRptaInfo1, !:CallerRptaInfo)
    ).

inter_analyse_goal_expr(generic_call(_, _, _, _, _), _, _, _, !FPTable,
        !RptaInfo) :-
    sorry($pred, "generic_call not handled").

inter_analyse_goal_expr(switch(_, _, Cases), _, ModuleInfo, InfoTable,
        !FPTable, !RptaInfo) :-
    list.foldl2(inter_analyse_case(ModuleInfo, InfoTable), Cases,
        !FPTable, !RptaInfo).

    % Unifications are ignored in interprocedural analysis
    %
inter_analyse_goal_expr(unify(_, _, _, _, _), _, _, _, !FPTable, !RptaInfo).

inter_analyse_goal_expr(disj(Disjs), _, ModuleInfo, InfoTable,
        !FPTable, !RptaInfo) :-
    list.foldl2(inter_analyse_goal(ModuleInfo, InfoTable), Disjs,
        !FPTable, !RptaInfo).

inter_analyse_goal_expr(negation(Goal), _, ModuleInfo, InfoTable,
        !FPTable, !RptaInfo) :-
    inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPTable, !RptaInfo).

    % XXX: may need to take into account the Reason.
    % for now just analyse the goal.
    %
inter_analyse_goal_expr(scope(_Reason, Goal), _, ModuleInfo, InfoTable,
        !FPTable, !RptaInfo) :-
%    (
%        ( Reason = exist_quant(_)
%        ; Reason = promise_solutions(_, _)      % XXX ???
%        ; Reason = promise_purity(_, _)
%        ; Reason = commit(_)                    % XXX ???
%        ; Reason = barrier(_)
%        ; Reason = trace_goal(_, _, _, _, _)
%        ; Reason = from_ground_term(_)
%        ),
        inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPTable, !RptaInfo).
%    ;
%        Msg = "inter_analyse_goal_expr: Scope's reason of from_ground_term "
%            ++ "not handled",
%        unexpected($pred, Msg)
%    ).

inter_analyse_goal_expr(if_then_else(_Vars, If, Then, Else), _, ModuleInfo,
        InfoTable, !FPTable, !RptaInfo) :-
    inter_analyse_goal(ModuleInfo, InfoTable, If, !FPTable, !RptaInfo),
    inter_analyse_goal(ModuleInfo, InfoTable, Then, !FPTable, !RptaInfo),
    inter_analyse_goal(ModuleInfo, InfoTable, Else, !FPTable, !RptaInfo).

inter_analyse_goal_expr(GoalExpr, _, _, _, !FPTable, !RptaInfo) :-
    GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
    sorry($pred, "foreign code").

inter_analyse_goal_expr(shorthand(_), _, _, _, !FPTable, !RptaInfo) :-
    unexpected($pred, "shorthand").

:- pred inter_analyse_case(module_info::in,
    rpta_info_table::in, case::in, rpta_fixpoint_table::in,
    rpta_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.

inter_analyse_case(ModuleInfo, InfoTable, Case, !FPtable, !RptaInfo) :-
    Case = case(_, _, Goal),
    inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPtable, !RptaInfo).

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

    % As said above, the rpta_info of a procedure when it is looked
    % up in interprocedural analysis is either in the InfoTable or in the
    % fixpoint table. If the procedure happens to be imported ones, built-ins,
    % and so on, we returns no and initialize the lookup value to a dummy
    % value.
    %
:- pred lookup_rpta_info(pred_proc_id::in, rpta_info_table::in,
    rpta_fixpoint_table::in, rpta_fixpoint_table::out,
    rpta_info::out, bool::out) is det.

lookup_rpta_info(PPId, InfoTable, !FPtable, RptaInfo, Init) :-
    ( if
        % First look up in the current fixpoint table, ...
        get_from_fixpoint_table(PPId, RptaInfo0, !.FPtable, FPtable1)
    then
        RptaInfo  = RptaInfo0,
        !:FPtable = FPtable1,
        Init = bool.no
    else
        % ... second look up among already recorded rpta_info.
        ( if
            RptaInfo0 = rpta_info_table_search_rpta_info(PPId, InfoTable)
        then
            RptaInfo = RptaInfo0,
            Init = bool.no
        else
            % Initialize a dummy.
            RptaInfo = rpta_info(rpt_graph_init, map.init),
            Init = bool.yes
        )
    ).

:- pred update_rpta_info_in_rpta_info_table(rpta_fixpoint_table::in,
    pred_proc_id::in, rpta_info_table::in, rpta_info_table::out) is det.

update_rpta_info_in_rpta_info_table(FPTable, PPId, !InfoTable) :-
    RptaInfo = get_from_fixpoint_table_final(PPId, FPTable),
    rpta_info_table_set_rpta_info(PPId, RptaInfo, !InfoTable).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Invariants for RPTGs.
%

    % Rule P1:
    % After two nodes are unified, it can happen that the unified node has
    % two edges with the same label pointing to 2 different nodes. This rule
    % ensures that if it happens the 2 nodes will also be unified.
    %
    % The algorithm is as follows.
    % 1. If the node has no or one outedge we have to do nothing and the
    %    predicate quits.
    % 2. The node has > 1 outedges, take one of them,
    %    find in the rest another edge that has the same label,
    %    unify the end nodes of the two edges.
    %    Because of this unification of the end nodes,
    %    more unifications are probably triggered.
    % 3. If a unification happens, start all over again with the same node
    %    and the *updated* graph that has one less outedge from the node.
    %
:- pred rule_1(rptg_node::in, rpt_graph::in, rpt_graph::out) is det.

rule_1(Node, !Graph) :-
    % XXX This might not be needed because we have just unified into Node.
    rptg_get_node_by_node(!.Graph, Node, UnifiedNode),

    OutEdgesOfUnifiedNode = rptg_lookup_list_outedges(!.Graph, UnifiedNode),
    (
        OutEdgesOfUnifiedNode = [E | Es],
        merge_nodes_reached_by_same_labelled_edges(E, Es, Es, !Graph,
            Happened),
        (
            Happened = bool.no
        ;
            % Some nodes have been merged, so size of !:Graph is strictly
            % smaller than that of !.Graph and at some point this predicate
            % will end up in the then-branch.
            Happened = bool.yes,
            rule_1(UnifiedNode, !Graph)
        )
    ;
        OutEdgesOfUnifiedNode = []
    ).

    % merge_nodes_reached_by_same_labelled_edges(Edge, EdgeList, Rest,
    % !Graph, Happened) unifies the end nodes of Edge and of an edge
    % in EdgeList that has the same label as the input edge.
    % When one such an edge found,
    % the predicate will not look further in the list.
    % The unification of nodes, if happends (Happened = yes),
    % will be propagated by calling rule_1 predicate mutually recursively.
    %
    % The loop in this predicate is similar to
    % for i = ... to N - 1
    %    for j = i+1 to N ...
    % ...
    %
:- pred merge_nodes_reached_by_same_labelled_edges(rptg_edge::in,
    list(rptg_edge)::in, list(rptg_edge)::in, rpt_graph::in, rpt_graph::out,
    bool::out) is det.

    % This clause is reached when no unification of nodes happened and
    % all the out-edges have been considered (Rest = []).
    %
merge_nodes_reached_by_same_labelled_edges(_, [], [], !Graph, bool.no).

    % This clause is reached when some out-edges still need to be processed.
    %
merge_nodes_reached_by_same_labelled_edges(_, [], [E | Es], !Graph,
        Happened) :-
    merge_nodes_reached_by_same_labelled_edges(E, Es, Es, !Graph, Happened).

merge_nodes_reached_by_same_labelled_edges(Edge, [Ed | Eds], Rest, !Graph,
        Happened) :-
    % We do not allow two edges with the same label from one node to another.
    % So End and E below must be definitely different nodes and we only need
    % to compare labels.
    rptg_get_edge_contents(!.Graph, Edge, _Start, End, EdgeContent),
    rptg_get_edge_contents(!.Graph, Ed, _S, E, EdC),
    ( if
        EdgeContent = EdC
    then
        % Unify the two end nodes.
        unify_operator(End, E, !.Graph, Graph1),

        % Apply rule 1 after the above unification.
        rule_1(End, Graph1, !:Graph),
        Happened = bool.yes
    else
        % Still not found an edge with the same label, continue the
        % inner loop.
        merge_nodes_reached_by_same_labelled_edges(Edge, Eds, Rest, !Graph,
            Happened)
    ).

    % Rule P2:
    % After an edge (N, Label, M) is added to a graph, it may happen
    % that there exists another edge from N with the same label but
    % pointing to a node different from M. This rule ensures that if that
    % the case the node will be unified with M.
    %
    % This predicate is called whenever a new edge has been added to the
    % graph. So when it is called there is at most one existing edge with
    % the same label to a different node. Because of that the predicate
    % need not be recursive.
    %
:- pred rule_2(rptg_node::in, rptg_node::in, cons_id::in, int::in,
    rpt_graph::in, rpt_graph::out) is det.

rule_2(Node1, Node2, ConsId, Component, !Graph) :-
    rptg_get_node_by_node(!.Graph, Node1, N),
    rptg_get_node_by_node(!.Graph, Node2, M),
    Sel = [termsel(ConsId, Component)],
    OutEdgeList = rptg_lookup_list_outedges(!.Graph, N),
    merge_nodes_reached_by_same_labelled_edge(Sel, M, OutEdgeList, !Graph).

    % If an edge (E) in OutEdgeList has the same label Sel then merge M
    % with the node (MPrime) that E points to.
    %
:- pred merge_nodes_reached_by_same_labelled_edge(selector::in,
    rptg_node::in, list(rptg_edge)::in, rpt_graph::in, rpt_graph::out) is det.

merge_nodes_reached_by_same_labelled_edge(_, _, [], !Graph).
merge_nodes_reached_by_same_labelled_edge(Sel, M, [Ed | Eds], !Graph) :-
    rptg_get_edge_contents(!.Graph, Ed, _, MPrime, EdgeContent),
    ( if
        EdgeContent = rptg_edge_content(Selector),
        Selector = Sel,
        MPrime \= M
    then
        unify_operator(M, MPrime, !Graph),
        rule_1(M, !Graph)
    else
        % Still not found an edge with the same label, continue the loop.
        merge_nodes_reached_by_same_labelled_edge(Sel, M, Eds, !Graph)
    ).

    % Rule P3:
    % This rule is applied after an edge is added TO the Node to enforce
    % the invariant that a subterm of the same type as the compounding
    % term is stored in the same region as the compounding term. In
    % the context of region points-to graph it means that there exists
    % a path between 2 nodes of the same type. In that case, this rule
    % will unify the 2 nodes.
    %
    % This algorithm may not be an efficient one because it checks all
    % the nodes in the graph one by one to see if a node can reach the
    % node or not.
    %
    % We enforce the invariant (in the sense that whenever the invariant
    % is made invalid this rule will correct it) therefore whenever we
    % find a satisfied node and unify it with Node we can stop. This is
    % indicated by Happened.
    %
:- pred rule_3(rptg_node::in, rpt_graph::in, rpt_graph::out) is det.

rule_3(Node, !Graph) :-
    NodeMap = rptg_get_nodes(!.Graph),
    map.keys(NodeMap, Nodes),
    (
        Nodes = [_N | _NS],
        % The graph has some node(s), so check each node to see if it
        % satisfies the condition of rule 3 or not, if yes unify it
        % with NY. (NY is the node that Node may be merged into.)
        rptg_get_node_by_node(!.Graph, Node, NY),
        rule_3_2(Nodes, NY, !Graph, Happened),

        % This predicate will quit when Happened = no, i.e. no more
        % nodes need to be unified.
        (
            Happened = bool.yes,
            % A node in Nodes has been unified with NY, so we start all
            % over again. Note that the node that has been unified has
            % been removed, so it will not be in the Graph1 in the below
            % call. So this predicate can terminate at some point (due
            % to the fact that the "size" of !.Graph is smaller than that
            % of !:Graph).
            rule_3(Node, !Graph)
          ;
            % No node in Nodes has been unified with NY, which means that
            % no more nodes need to be unified, so just quit.
            Happened = bool.no
        )
    ;
        Nodes = [],
        % No node in the graph, impossible.
        unexpected($pred, "impossible having no node in graph")
    ).

    % Check each node in the list to see if it satisfies the condition of
    % rule 3 or not, i.e., link to another node with the same type.
    %   1. If the predicate finds out such a node, it unifies it with NY
    %   (also apply rule 1 here) and quit with Happend = 1.
    %   2. if no such a node found, it processes the rest of the list. The
    %   process continues like that until either 1. happens (the case above)
    %   or the list becomes empty and the predicate quits with Happened = 0.
    %
:- pred rule_3_2(list(rptg_node)::in, rptg_node::in, rpt_graph::in,
    rpt_graph::out, bool::out) is det.

rule_3_2([], _, !Graph, bool.no).
rule_3_2([NZ | NZs], NY, !Graph, Happened) :-
    ( if
        rule_3_condition(NZ, NY, !.Graph, NZ1)
    then
        unify_operator(NZ, NZ1, !Graph),

        % Apply rule 1.
        rule_1(NZ, !Graph),
        Happened = bool.yes
    else
        % Try with the rest, namely NS.
        rule_3_2(NZs, NY, !Graph, Happened)
    ).

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

rule_3_condition(NZ, NY, Graph, NZ1) :-
    rptg_path(Graph, NZ, NY, _),
    rptg_lookup_node_type(Graph, NZ) = NZType,
    % A node reachable from NY, with the same type as NZ, the node can
    % be exactly NY.
    rptg_reachable_and_having_type(Graph, NY, NZType, NZ1),
    NZ \= NZ1.

%-----------------------------------------------------------------------------%
%
% Rule P4 and alpha mapping.
%

    % Build up the alpha mapping (node -> node) and apply rule P4
    % to ensure that it is actually a function.
    %
:- pred alpha_mapping_at_call_site(list(prog_var)::in, list(prog_var)::in,
    rpt_graph::in, rpt_graph::in, rpt_graph::out,
    rpt_call_alpha_mapping::in, rpt_call_alpha_mapping::out) is det.

alpha_mapping_at_call_site([], [], _, !CallerGraph, !AlphaMap).
alpha_mapping_at_call_site([], [_ | _], _, _, _, _, _) :-
    unexpected($pred, "mismatched lists").
alpha_mapping_at_call_site([_ | _], [], _, _, _, _, _) :-
    unexpected($pred, "mismatched lists").
alpha_mapping_at_call_site([Xi | Xs], [Yi | Ys], CalleeGraph,
        !CallerGraph, !AlphaMap) :-
    % Xi's are formal arguments, Yi's are actual arguments at the call site.
    rptg_get_node_by_variable(CalleeGraph, Xi, N_Xi),
    rptg_get_node_by_variable(!.CallerGraph, Yi, N_Yi),
    ( if map.search(!.AlphaMap, N_Xi, N_Y) then
        % alpha(N_Xi) = N_Y, alpha(N_Xi) = N_Yi, N_Y != N_Yi.
        %
        ( if N_Y = N_Yi then
            true
        else
            % Apply rule P4.
            unify_operator(N_Y, N_Yi, !CallerGraph),

            % Apply rule P1 after some nodes are unified.
            rule_1(N_Y, !CallerGraph)
        )
    else
        map.set(N_Xi, N_Yi, !AlphaMap),

        % If N_Xi's is_allocated then N_Yi is also allocated.
        % Otherwise leave N_Yi alone.
        ( if rptg_is_allocated_node(CalleeGraph, N_Xi) then
            rptg_set_node_is_allocated(N_Yi, bool.yes, !CallerGraph)
        else
           true
        )
    ),
    alpha_mapping_at_call_site(Xs, Ys, CalleeGraph, !CallerGraph, !AlphaMap).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Rules P5-P8 complete the alpha mapping at a call site and integrate the
% parts rooted at the formal parameters in the callee's graph into the
% caller's graph.
%
% The application of those rules happens at a call site, so related to a
% caller and a callee.
%
% We will start from the rooted nodes, follow each outcoming edge in the
% callee's graph exactly once and apply the rules.
%

:- pred apply_rules(list(rptg_node)::in, program_point::in,
    list(rptg_node)::in, rpta_info::in, rpta_info::in,
    rpta_info::out) is det.

apply_rules([], _, _, _, !CallerRptaInfo).
apply_rules([CalleeNode | CalleeNodes0], CallSite, Processed, CalleeRptaInfo,
        !CallerRptaInfo) :-
    % The caller node corresponding to the callee node at this call site.
    !.CallerRptaInfo = rpta_info(_, CallerAlphaMapping0),
    map.lookup(CallerAlphaMapping0, CallSite, AlphaAtCallSite),
    map.lookup(AlphaAtCallSite, CalleeNode, CallerNode),

    % Follow CalleeNode and apply rules when traversing its edges.
    apply_rules_node(CallSite, CalleeNode, CalleeRptaInfo, CallerNode,
        !CallerRptaInfo),

    % Continue with the nodes reached from Callee Node.
    CalleeRptaInfo = rpta_info(CalleeGraph, _),
    SuccessorsCalleeNode = rptg_successors(CalleeGraph, CalleeNode),
    set.to_sorted_list(SuccessorsCalleeNode, SsList),
    list.delete_elems(SsList, Processed, ToBeProcessed),
    CalleeNodes = ToBeProcessed ++ CalleeNodes0,
    apply_rules(CalleeNodes, CallSite, [CalleeNode | Processed],
        CalleeRptaInfo, !CallerRptaInfo).

:- pred apply_rules_node(program_point::in, rptg_node::in, rpta_info::in,
    rptg_node::in, rpta_info::in, rpta_info::out) is det.

apply_rules_node(CallSite, CalleeNode, CalleeRptaInfo, CallerNode,
        !CallerRptaInfo) :-
    CalleeRptaInfo = rpta_info(CalleeGraph, _),

    % Apply rules P5-P8 for each out-edge of CalleeNode.
    CalleeNodeOutEdges = rptg_lookup_list_outedges(CalleeGraph, CalleeNode),
    apply_rules_outedges(CalleeNodeOutEdges, CallerNode, CallSite,
        CalleeRptaInfo, !CallerRptaInfo).

:- pred apply_rules_outedges(list(rptg_edge)::in, rptg_node::in,
    program_point::in, rpta_info::in, rpta_info::in, rpta_info::out) is det.

apply_rules_outedges([], _, _, _, !RptaInfoR).
apply_rules_outedges([Edge | Edges], CallerNode, CallSite, CalleeRptaInfo,
        !CallerRptaInfo) :-
    rule_5(Edge, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
    rule_6(Edge, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
    rule_7(Edge, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
    rule_8(Edge, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
    apply_rules_outedges(Edges, CallerNode, CallSite, CalleeRptaInfo,
        !CallerRptaInfo).

:- pred rule_5(rptg_edge::in, program_point::in, rpta_info::in,
    rptg_node::in, rpta_info::in, rpta_info::out) is det.

rule_5(Edge, CallSite, CalleeRptaInfo, CallerNode,
        rpta_info(!.CallerGraph, CallerAlphaMapping),
        rpta_info(!:CallerGraph, CallerAlphaMapping)) :-
    % Find an out-edge in the caller's graph that has a same label
    % the label of the out-edge in callee's graph.
    CalleeRptaInfo = rpta_info(CalleeGraph, _),
    rptg_get_edge_contents(CalleeGraph, Edge, _CalleeNode, CalleeM, Label),
    %!.CallerRptaInfo = rpta_info(CallerGraph0, CallerAlphaMapping),
    rptg_get_node_by_node(!.CallerGraph, CallerNode, RealCallerNode),
    ( if
        rptg_find_edge_from_node_with_same_content(RealCallerNode, Label,
            !.CallerGraph, CallerMPrime),
        map.search(CallerAlphaMapping, CallSite, AlphaAtCallSite),
        map.search(AlphaAtCallSite, CalleeM, CallerM),
        rptg_get_node_by_node(!.CallerGraph, CallerM, RealCallerM),
        CallerMPrime \= RealCallerM
    then
        % When the conditions of rule P5 are satisfied, nodes are unified and
        % rule P1 applied to ensure invariants.
        unify_operator(RealCallerM, CallerMPrime, !CallerGraph),

        % Apply rule P1 after the unification.
        rule_1(RealCallerM, !CallerGraph)
    else
        true
    ).

:- pred rule_6(rptg_edge::in, program_point::in, rpta_info::in,
    rptg_node::in, rpta_info::in, rpta_info::out) is det.

rule_6(Edge, CallSite, CalleeRptaInfo, CallerNode,
        rpta_info(!.CallerGraph, !.CallerAlphaMapping),
        rpta_info(!:CallerGraph, !:CallerAlphaMapping)) :-
    % Find an out-edge in the caller's graph that has a same label
    % the label of the out-edge in callee's graph.
    CalleeRptaInfo = rpta_info(CalleeGraph, _),
    rptg_get_edge_contents(CalleeGraph, Edge, _CalleeNode, CalleeM, Label),
    rptg_get_node_by_node(!.CallerGraph, CallerNode, RealCallerNode),
    ( if
        rptg_find_edge_from_node_with_same_content(RealCallerNode, Label,
            !.CallerGraph, CallerM)
    then
        % (CallerNode, sel, CallerM) in the graph.
        map.lookup(!.CallerAlphaMapping, CallSite, AlphaAtCallSite0),
        ( if map.search(AlphaAtCallSite0, CalleeM, _) then
            % alpha(CalleeM) = CallerM so ignore.
            true
        else
            % Apply rule P6: when its conditions are satisfied
            % record alpha(CalleeM) = CallerM.
            map.set(CalleeM, CallerM, AlphaAtCallSite0, AlphaAtCallSite1),
            map.set(CallSite, AlphaAtCallSite1, !CallerAlphaMapping),

            % If CalleeM's is_allocated then CallerM is also allocated.
            % Otherwise leave CallerM alone.
            ( if rptg_is_allocated_node(CalleeGraph, CalleeM) then
                rptg_set_node_is_allocated(CallerM, bool.yes, !CallerGraph)
            else
                true
            )
        )
    else
        true
    ).

:- pred rule_7(rptg_edge::in, program_point::in, rpta_info::in,
    rptg_node::in, rpta_info::in, rpta_info::out) is det.

rule_7(Edge, CallSite, CalleeRptaInfo, CallerNode,
        rpta_info(!.CallerGraph, CallerAlphaMapping),
        rpta_info(!:CallerGraph, CallerAlphaMapping)) :-
    % Find an out-edge in the caller's graph that has a same label
    % the label of the out-edge in callee's graph.
    CalleeRptaInfo = rpta_info(CalleeGraph, _),
    rptg_get_edge_contents(CalleeGraph, Edge, _CalleeNode, CalleeM, Label),
    rptg_get_node_by_node(!.CallerGraph, CallerNode, RealCallerNode),
    ( if
        rptg_find_edge_from_node_with_same_content(RealCallerNode, Label,
            !.CallerGraph, _)
    then
        true
    else
        % No edge from CallerNode with the label exists.
        ( if
            map.lookup(CallerAlphaMapping, CallSite, AlphaAtCallSite),
            map.search(AlphaAtCallSite, CalleeM, CallerM)
        then
            % Reach here means all the conditions of rule P7 are satisfied,
            % add (CallerNode, sel, CallerM).
            rptg_get_node_by_node(!.CallerGraph, CallerM, RealCallerM),
            edge_operator(RealCallerNode, RealCallerM, Label, !CallerGraph),

            % Need to apply rule 3.
            rule_3(RealCallerM, !CallerGraph)
        else
            true
        )
    ).

:- pred rule_8(rptg_edge::in, program_point::in, rpta_info::in,
    rptg_node::in, rpta_info::in, rpta_info::out) is det.

rule_8(Edge, CallSite, CalleeRptaInfo, CallerNode,
        rpta_info(!.CallerGraph, !.CallerAlphaMapping),
        rpta_info(!:CallerGraph, !:CallerAlphaMapping)) :-
    % Find an out-edge in the caller's graph that has a same label
    % the label of the out-edge in callee's graph.
    CalleeRptaInfo = rpta_info(CalleeGraph, _),
    rptg_get_edge_contents(CalleeGraph, Edge, _CalleeNode, CalleeM, Label),
    rptg_get_node_by_node(!.CallerGraph, CallerNode, RealCallerNode),
    ( if
        rptg_find_edge_from_node_with_same_content(RealCallerNode, Label,
            !.CallerGraph, _)
    then
        true
    else
        % No edge from CallerNode with the label exists.
        ( if
            map.lookup(!.CallerAlphaMapping, CallSite, AlphaAtCallSite0),
            map.search(AlphaAtCallSite0, CalleeM, _)
        then
            true
        else
            % rule 8: add node CallerM, alpha(CalleeM) = CallerM,
            % edge(CallerNode, sel, CallerM)
            %
            CallerNextNodeId = rptg_get_next_node_id(!.CallerGraph),
            string.append("R", string.int_to_string(CallerNextNodeId),
                RegName),
            CallerMContent = rptg_node_content(set.init, RegName, set.init,
                rptg_lookup_node_type(CalleeGraph, CalleeM),
                rptg_lookup_node_is_allocated(CalleeGraph, CalleeM)),
            rptg_add_node(CallerMContent, CallerM, !CallerGraph),
            edge_operator(RealCallerNode, CallerM, Label, !CallerGraph),

            map.lookup(!.CallerAlphaMapping, CallSite, AlphaAtCallSite0),
            map.set(CalleeM, CallerM, AlphaAtCallSite0, AlphaAtCallSite),
            map.set(CallSite, AlphaAtCallSite, !CallerAlphaMapping),

            rule_3(CallerM, !CallerGraph)
        )
    ).

%-----------------------------------------------------------------------------%
%
% Fixpoint table used in region points-to analysis.
%

    % The fixpoint table used by the region points-to analysis.
    %
:- type rpta_fixpoint_table == fixpoint_table(pred_proc_id, rpta_info).

    % Initialise the fixpoint table for the given set of pred_proc_ids.
    %
:- func init_rpta_fixpoint_table(list(pred_proc_id), rpta_info_table)
    = rpta_fixpoint_table.

init_rpta_fixpoint_table(Keys, InfoTable) = Table :-
    Table = init_fixpoint_table(wrapped_init(InfoTable), Keys).

    % Enter the newly computed region points-to information for a given
    % procedure.
    % If the description is different from the one that was already stored
    % for that procedure, the stability of the fixpoint table is set to
    % "unstable".
    % Aborts if the procedure is not already in the fixpoint table.
    %
:- pred rpta_fixpoint_table_new_rpta_info(
    pred_proc_id::in, rpta_info::in,
    rpta_fixpoint_table::in, rpta_fixpoint_table::out) is det.

rpta_fixpoint_table_new_rpta_info(PPId, RptaInfo, !Table) :-
    EqualityTest = (pred(TabledElem::in, Elem::in) is semidet :-
        rpta_info_equal(Elem, TabledElem)
    ),
    add_to_fixpoint_table(EqualityTest, PPId, RptaInfo, !Table).

:- func wrapped_init(rpta_info_table, pred_proc_id) = rpta_info.

wrapped_init(InfoTable, PPId) = Entry :-
    ( if Entry0 = rpta_info_table_search_rpta_info(PPId, InfoTable) then
        Entry = Entry0
    else
        % The information we are looking for should be there after the
        % intraprocedural analysis.
        unexpected($pred, "no rpta_info")
    ).

%-----------------------------------------------------------------------------%
:- end_module transform_hlds.rbmm.points_to_analysis.
%-----------------------------------------------------------------------------%