%%% This file is part of RefactorErl.
%%%
%%% RefactorErl is free software: you can redistribute it and/or modify
%%% it under the terms of the GNU Lesser General Public License as published
%%% by the Free Software Foundation, either version 3 of the License, or
%%% (at your option) any later version.
%%%
%%% RefactorErl is distributed in the hope that it will be useful,
%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%%% GNU Lesser General Public License for more details.
%%%
%%% You should have received a copy of the GNU Lesser General Public License
%%% along with RefactorErl.  If not, see <http://plc.inf.elte.hu/erlang/>.
%%%
%%% The Original Code is RefactorErl.
%%%
%%% The Initial Developer of the Original Code is Eötvös Loránd University.
%%% Portions created  by Eötvös Loránd University and ELTE-Soft Ltd.
%%% are Copyright 2007-2025 Eötvös Loránd University, ELTE-Soft Ltd.
%%% and Ericsson Hungary. All Rights Reserved.


%%% ============================================================================
%%% Module information

%%% @doc Utilities of CFG server.
%%%
%%% @author Istvan Bozo <bozo_i@inf.elte.hu>

-module(refsc_cfg_utils).

-vsn("$Rev: 17551 $ ").

%% Interface function for building the CFG for a given function form.
-export([build_cfg/1]).

%% Visualization of the graph.
-export([draw_graph/1]).

-export_type([cfg_node/0, cfg_edge/0]).

-include("slicer.hrl").

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Interface functions provided to the CFG server
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

-type cfg_node() :: tuple().

-type cfg_edge() :: tuple().

-spec build_cfg(Form :: cfg_node()) -> {Edges :: [cfg_edge()], [cfg_node()]}.
%% @doc Builds the intrafunctional CFG (it does not follow function
%% calls, only makes a note about that) for the given function form.
build_cfg(Form) ->
    Clauses = ?Query:exec(Form, ?Form:clauses()),
    {PandBPairs, CoverInfo} = branch_info(Clauses, []),
    build_branches(PandBPairs, Form, {ret, Form}, Form, CoverInfo, yes).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Auxiliary functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% A record is defined for return values to eliminate nested tuples.
-record(ret, {s_node, %% Start node
              e_node, %% End node
              f_label = "", %% Edge label, especially to carry contex info
                           %% from subgraph.
              edges = [],
              app_nodes = [] %% app nodes for further processing
             }).

%% Extracting functions for the `ret' record.
-define(s_node(R),    R#ret.s_node).
-define(e_node(R),    R#ret.e_node).
-define(f_label(R),   R#ret.f_label).
-define(edges(R),     R#ret.edges).
-define(app_nodes(R), R#ret.app_nodes).

%% It takes a list of {pattern ++ guard, body node list} tuples and
%% connects the branches. It also determines connections among the
%% patterns of the branches, especially if one of the patterns does
%% not match it connects the patterns of the following branch with
%% `no' labeled edges. The function is used for multiple function
%% branches, case expressions etc.

%% The case when the function/expression (case expr etc) has only one
%% caluse and it has no formal parameters and guards.
build_branches([{{[],[]}, BNodes}], PrevNode, NextNode, _TopNode, _CoverInfo,
               PrevLabel) ->
    Res = build_flow(BNodes),
    E1  = create_edge(PrevNode, ?s_node(Res), PrevLabel),
    E2  = create_edge(?e_node(Res), NextNode, ?f_label(Res)),
    {[E1, E2 | ?edges(Res)], ?app_nodes(Res)};

%% The case when the function/expression (case expr etc.) has only one
%% caluse and it a formal argument or a guard expression.
build_branches([{{PatternL, GuardL}, BNodes}], PrevNode, NextNode,
               TopNode, CoverInfo, PrevLabel) ->
    Res      = build_flow(BNodes),
    PGList   = PatternL ++ GuardL,
    ConPandG = connect_patterns(PGList),
    %% If the branch may mismatch, creates an error node
    ErrorE   = create_clause_error_node(CoverInfo, {PatternL, GuardL}, TopNode),

    E1 = create_edge(PrevNode, hd(PGList), PrevLabel),
    E2 = create_edge(lists:last(PGList), ?s_node(Res), yes),
    E3 = create_edge(?e_node(Res), NextNode, ?f_label(Res)),
    {[E1, E2, E3| lists:append([ErrorE, ConPandG, ?edges(Res)])],
     ?app_nodes(Res)};

%% The case when the function/expression (case expr etc.) has more
%% caluses.
build_branches([HdPAndBPairs = {{HdPL, HdGL}, _HdBL} | TlPAndBPairs],
               PrevNode, NextNode, TopNode, CoverInfo, PrevLabel) ->
    %% connecting patterns with `no' edges, in case these do not match
    HdPAndGList = HdPL ++ HdGL,
    ConHdPandG  = connect_patterns(HdPAndGList),
    {_, ConTlPandG}  =
        lists:foldl(
          fun({{PL, GL}, _}, {PGNPrev, PrevEdges})->
                  PaGL = PL ++ GL,
                  ConPandG = connect_patterns(PaGL),
                  {_, NonMatchEdges} =
                      lists:foldl(
                        fun(P, {HdPrevPaGL, PEdges}) ->
                                Edge = create_edge(P, HdPrevPaGL, no),
                                {HdPrevPaGL, [Edge | PEdges]}
                        end, {hd(PaGL), []}, PGNPrev),
                  {PaGL, lists:append([ConPandG, NonMatchEdges, PrevEdges])}
          end, {HdPAndGList, []}, TlPAndBPairs),

    %% If the branch may mismatch, creates an error node
    ErrorE = create_clause_error_node(CoverInfo,
                                      element(1, lists:last(TlPAndBPairs)),
                                      TopNode),

    %% building the body and connecting with patterns and with the
    %% return node
    BodyEdgeAppNodeLists =
        [begin
             Res = build_flow(B),
             E1  = create_edge(lists:last(Pl++Gl),
                               ?s_node(Res), yes),
             E2  = create_edge(?e_node(Res), NextNode, ?f_label(Res)),
             {[E1, E2 | ?edges(Res)], ?app_nodes(Res)}
         end || {{Pl, Gl}, B} <- [HdPAndBPairs | TlPAndBPairs]],

    E = create_edge(PrevNode, hd(HdPAndGList), PrevLabel),
    {BodyEdgeLists, AppNodeLists} = lists:unzip(BodyEdgeAppNodeLists),
    {[E | lists:append([ErrorE, ConHdPandG, ConTlPandG | BodyEdgeLists])],
     lists:append(AppNodeLists)}.

%% Dealer function for building the CFG from node sequences. Returns a
%% record #ret{} with two nodes (referl_node()) and label (context
%% information from the subnodes) and a list of edges from the
%% subgraph.

build_flow([Node]) ->
    Subs = get_sub(Node),
    case Subs of
        [] ->
            #ret{s_node = Node, e_node = Node};
        _ ->
            Type = ?Expr:type(Node),
            build_rule(Type, Node)
    end;
build_flow(NList) when is_list(NList) ->
    [HdRet | TlRets] = [build_flow([Node]) || Node <- NList],
    Res =
        lists:foldl(
          fun(ActRet = #ret{}, AccRet = #ret{}) ->
                  E = create_edge(?e_node(AccRet), ?s_node(ActRet),
                                  ?f_label(AccRet)),
                  ActRet#ret{edges = [E | ?edges(ActRet)] ++ ?edges(AccRet),
                            app_nodes = ?app_nodes(ActRet)++?app_nodes(AccRet)}
          end, HdRet, TlRets),
    #ret{s_node = ?s_node(HdRet), e_node = ?e_node(Res),
         f_label = ?f_label(Res), edges = ?edges(Res),
         app_nodes = ?app_nodes(Res)}.

%% Rules for building subgraps for specific nodes. It takes a node
%% type as its first argument and the node as second argument. For
%% building subgarps, it calls the build_flow/1 function.
build_rule(application, Node) ->
    Res = build_flow(get_sub(Node)),
    E   = create_edge(?e_node(Res), Node, ?f_label(Res)),
    #ret{s_node = ?s_node(Res), e_node= Node, f_label = funcall,
         edges = [E | ?edges(Res)], app_nodes = [Node | ?app_nodes(Res)]};
build_rule(block_expr, Node) ->
    BodyNodes = ?Query:exec(Node, ?Query:seq(?Expr:clauses(), ?Clause:body())),
    Res = build_flow(BodyNodes),
    E   = create_edge(?e_node(Res), Node),
    Res#ret{e_node = Node, edges = [E|?edges(Res)]};
build_rule(case_expr, Node) ->
    [HeadCl|Clauses] = ?Query:exec(Node, ?Expr:clauses()),
    HeadExpr = ?Query:exec(HeadCl, ?Clause:body()),
    Res      = build_flow(HeadExpr),
    E1       = create_edge(Node, ?s_node(Res)),
    {PatternAndBodyPairs, CoverInfo} = branch_info(Clauses, []),
    {BEdges, AppNodes} = build_branches(PatternAndBodyPairs, ?e_node(Res),
                                        {ret, Node}, Node, CoverInfo, yes),
    #ret{s_node = Node, e_node = {ret, Node},
         edges = [E1 | ?edges(Res) ++ BEdges],
         app_nodes = ?app_nodes(Res) ++ AppNodes};
build_rule(cons, Node) ->
    ListNodes =
        lists:flatten([case ?Expr:type(SN) of
                           list -> get_sub(SN);
                           _    -> SN
                       end || SN <-get_sub(Node)]),
    Res       = build_flow(ListNodes),
    E1        = create_edge(?e_node(Res), Node, ?f_label(Res)),
    #ret{s_node = ?s_node(Res), e_node = Node,
         edges = [E1 | ?edges(Res)], app_nodes = ?app_nodes(Res)};
build_rule(filter, Node) ->
    Body = ?Query:exec(Node, ?Query:seq(?Expr:clauses(), ?Clause:body())),
    Res  = build_flow(Body),
    #ret{s_node = ?s_node(Res), e_node = ?e_node(Res), edges=?edges(Res),
         f_label = yes, app_nodes = ?app_nodes(Res)};
build_rule(fun_expr, Node) ->
    Clauses = ?Query:exec(Node, ?Expr:clauses()),
    {PatternAndBodyPairs, CoverInfo} = branch_info(Clauses, []),
    {BEdges, AppNodes} =
        build_branches(PatternAndBodyPairs, Node, {ret, Node}, Node,
                       CoverInfo, yes),
    #ret{s_node = Node, e_node = {ret, Node},
         edges = BEdges, app_nodes = AppNodes, f_label = []};
build_rule(if_expr, Node) ->
    Clauses = ?Query:exec(Node, ?Expr:clauses()),
    {_, ExtEdges, AppNodes, _} =
        lists:foldl(
          fun(Clause, {PrevG, AccEdges, AccApps, Label}) ->
                  [Guard]   = ?Query:exec(Clause, ?Clause:guard()),
                  BodyNodes = ?Query:exec(Clause, ?Clause:body()),

                  Res = build_flow(BodyNodes),
                  E1  = create_edge(Guard, ?s_node(Res), yes),
                  E2  = create_edge(?e_node(Res), {ret,Node}, ret),
                  %% if prev guard failed
                  E3  = create_edge(PrevG, Guard ,Label),
                  {Guard, [E1, E2, E3 | ?edges(Res) ++ AccEdges],
                   ?app_nodes(Res) ++ AccApps, no}
          end, {Node, [], [], ""}, Clauses),
    #ret{s_node = Node, e_node = {ret, Node}, edges = ExtEdges,
         app_nodes = AppNodes};
build_rule(infix_expr, Node) ->
    Fun =
        fun() ->
                [LCl, RCl] = ?Query:exec(Node, ?Expr:clauses()),
                LBody = ?Query:exec(LCl, ?Clause:body()),
                RBody = ?Query:exec(RCl, ?Clause:body()),
                LRes  = build_flow(LBody),
                RRes  = build_flow(RBody),
                {LRes, RRes}
        end,
    case ?Expr:value(Node) of
        'andalso' ->
            {LRes, RRes} = Fun(),

            E1 = create_edge(?e_node(LRes), Node, no),
            E2 = create_edge(?e_node(LRes), ?s_node(RRes), yes),
            E3 = create_edge(?e_node(RRes), Node),
            #ret{s_node = ?s_node(LRes), e_node = Node,
                 edges = [E1,E2,E3| ?edges(LRes) ++ ?edges(RRes)],
                 app_nodes = ?app_nodes(LRes) ++ ?app_nodes(RRes)};
        'orelse' ->
            {LRes, RRes} = Fun(),

            E1 = create_edge(?e_node(LRes), Node, yes),
            E2 = create_edge(?e_node(LRes), ?s_node(RRes), no),
            E3 = create_edge(?e_node(RRes), Node),
            #ret{s_node = ?s_node(LRes), e_node = Node,
                 edges=[E1,E2,E3| ?edges(LRes) ++ ?edges(RRes)],
                 app_nodes = ?app_nodes(LRes) ++ ?app_nodes(RRes)};
        _ ->
            build_rule_general(Node)
    end;
build_rule(list_comp, Node) ->
    [HExprClause, ComprClause] = ?Query:exec(Node,?Expr:clauses()),
    ComprBodyNodes = ?Query:exec(ComprClause, ?Clause:body()),
    CRes = build_flow(ComprBodyNodes),

    HeadBody = ?Query:exec(HExprClause, ?Clause:body()),
    HRes     = build_flow(HeadBody),

    E0 = create_edge(?e_node(CRes), ?s_node(HRes), ?f_label(CRes)),

    Fun =
        fun(N, {LCons, FList, EAcc}) ->
                [SNode] = ?Query:exec(N, ?Query:seq([?Expr:clauses(),
                                                     ?Clause:body()])),
                case ?Expr:type(N) of
                    list_gen ->
                        E1 = [create_edge(Lc, SNode, ret) || Lc <- LCons],
                        E2 = [create_edge(F, SNode, no)   || F <- FList],
                        {[SNode], [], E1 ++ E2 ++ EAcc};
                    filter ->
                        {LCons, [SNode | FList], EAcc}
                end
        end,

    {FirstNode, Filters, Edges1} =
        lists:foldl(Fun, {[], [], []}, lists:reverse(ComprBodyNodes)),

    Edges2 =
        case ?Expr:type(hd(ComprBodyNodes)) of
            list_gen ->
                [create_edge(hd(FirstNode), Node, ret)];
            filter ->
                [create_edge(F, Node, no) || F <- Filters]
        end,
    E1 = case FirstNode of
             [] ->
                 create_edge(?e_node(HRes), Node, ret);
             _ ->
                 create_edge(?e_node(HRes), hd(FirstNode))
         end,

    #ret{s_node = ?s_node(CRes), e_node = Node,
         edges = [E0, E1 | ?edges(HRes) ++ ?edges(CRes) ++ Edges1 ++ Edges2],
         app_nodes = ?app_nodes(HRes) ++ ?app_nodes(CRes)};
build_rule(list_gen, Node) ->
    [PExprClause, ExprClause] = ?Query:exec(Node, ?Expr:clauses()),

    ExprClBody = ?Query:exec(ExprClause, ?Clause:body()),
    Res1       = build_flow(ExprClBody),
    Pattern    = ?Query:exec(PExprClause, ?Clause:patterns()),
    Res2       = build_flow(Pattern),

    E1 = create_edge(?e_node(Res1), ?s_node(Res2)),
    E2 = create_edge(?e_node(Res2), ?s_node(Res1), no),
    #ret{s_node = ?s_node(Res1), e_node = ?e_node(Res2),
         edges = [E1, E2| ?edges(Res1) ++ ?edges(Res2)], f_label = yes,
         app_nodes = ?app_nodes(Res1) ++ ?app_nodes(Res2)};
build_rule(receive_expr, Node) ->
    Clauses  = ?Query:exec(Node, ?Expr:clauses()),
    {PatternAndBodyPairs, CoverInfo} = branch_info(Clauses, []),
    {BEdges, AppNodes}   = build_branches(PatternAndBodyPairs, Node,
                                          {ret, Node}, Node, CoverInfo, []),
    #ret{s_node = Node, e_node = {ret, Node}, edges=BEdges, f_label = halt,
         app_nodes = AppNodes};
build_rule(send_expr, Node) ->
    Subs = lists:reverse(get_sub(Node)),
    Res  = build_flow(Subs),

    E    = create_edge(?e_node(Res), Node, ?f_label(Res)),
    #ret{s_node = ?s_node(Res), e_node = Node, f_label = send,
         edges = [E | ?edges(Res)], app_nodes = ?app_nodes(Res)};
%% general building rule (also for other, already not covered cases)
build_rule(_Type, Node) ->
    build_rule_general(Node).

build_rule_general(Node) ->
    case get_sub(Node) of
        [] ->
            #ret{s_node = Node, e_node = Node};
        [H|Tail] ->
            Res = build_flow([H|Tail]),
            E   = create_edge(?e_node(Res), Node,?f_label(Res)),
            #ret{s_node = ?s_node(Res), e_node = Node,
                 edges = [E | ?edges(Res)], app_nodes = ?app_nodes(Res)}
    end.


%% The function checks wether the pattermatching may fail or not.
analyse_patterns_guards({PList, GList}) ->
    PB = lists:all(fun(N) ->
                           Type = ?Expr:type(N),
                           Type == variable orelse Type == joker
                   end, PList),
    case {PB, GList} of
        {true, []} ->
            %% further analysis
            VarList  = ?Query:exec(PList, ?Expr:variables()),
            VarNames = [?Var:name(Var) || Var <- VarList],
            case is_var_bound_and_accessed_in_pattern(VarNames) of
                true ->
                    peculiar;
                _    ->
                    not_peculiar
            end;
        {true, _}  ->
            %% For more precise analysis check guard
            peculiar;
        {false, _} ->
            peculiar
    end.

is_var_bound_and_accessed_in_pattern([]) ->
    false;
is_var_bound_and_accessed_in_pattern([A | VarNames]) ->
    lists:member(A, VarNames) orelse
        is_var_bound_and_accessed_in_pattern(VarNames).

branch_info([], Acc) ->
    {lists:reverse(Acc), may_fail};
branch_info([Clause| TClauses], Acc) ->
    Patterns  = ?Query:exec(Clause, ?Clause:patterns()),
    Guard     = ?Query:exec(Clause, ?Clause:guard()),
    BodyNList = ?Query:exec(Clause, ?Clause:body()),
    case analyse_patterns_guards({Patterns, Guard}) of
        peculiar     ->
            branch_info(TClauses, [{{Patterns, Guard}, BodyNList} | Acc]);
        not_peculiar ->
            {lists:reverse([{{Patterns, Guard}, BodyNList} | Acc]), not_fails}
    end.

connect_patterns([]) ->
    [];
connect_patterns([HPG | TPG]) ->
    {_, Edges} =
        lists:foldl(fun(Node, {AccNode, AccEdges}) ->
                            E = create_edge(AccNode, Node, yes),
                            {Node, [E | AccEdges]}
                    end, {HPG, []}, TPG),
    Edges.

%% if the clause may fail, it creates an error node and the returns
%% edges
create_clause_error_node(may_fail, {P, G}, TopNode) ->
    [create_edge(N, {error, TopNode}, no)
     || N <- P ++ G];
create_clause_error_node(not_fails, _, _) ->
    [].

%% returns only syntax nodes
get_sub(Node) ->
    [ N || {L, N} <- ?Syn:children(Node), L=/=elex, L=/=clex, L=/=flex].

create_edge(SNode, ENode) ->
    {SNode, ENode, ""}.

create_edge(SNode, ENode, Label) ->
    {SNode, ENode, Label}.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Drawing utilities
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

draw_graph(Form) ->
    {Form, CFG, _} = refsc_cfg_server:get_cfg(Form),
    refsc_utils:draw_graph(cfg, text, CFG).
