1/*  Part of Extended Tools for SWI-Prolog
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/xtools
    6    Copyright (C): 2022, Process Design Center, Breda, The Netherlands.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(module_links,
   36          [ current_chain_link/4,
   37            depends_of_db/6,
   38            loop_to_chain/2,
   39            module_pred_chains/6,
   40            module_pred_links/2,
   41            link_module_uses/3,
   42            preds_uses/3,
   43            update_depends_of/0,
   44            cleanup_depends_of/0
   45          ]).   46
   47:- use_module(library(apply)).   48:- use_module(library(lists)).   49:- use_module(library(calls_to)).   50:- use_module(library(solution_sequences)).   51
   52:- multifile
   53        update_depends_of_hook/0.   54
   55ref_head('<assertion>'(M:H), M, H).
   56ref_head(M:H, M, H).
   57ref_head(clause(Ref), M, H) :-
   58    freeze(Ref, clause(M:H, _, Ref)).
   59
   60pred_calls_to(AH, AM, H, CM) :-
   61    ref_head(Ref, AM, AH),
   62    calls_to(Ref, CM, H).
   63
   64:- dynamic
   65    depends_of_db/6.   66
   67update_depends_of :-
   68    update_depends_of_1,
   69    forall(update_depends_of_hook, true),
   70    update_depends_of_n.
   71
   72cleanup_depends_of :-
   73    retractall(depends_of_db(_, _, _, _, _, _)).
   74
   75update_depends_of_1 :-
   76    forall(( pred_calls_to(AH, AM, TH, CM),
   77             predicate_property(CM:TH, implementation_module(TM)),
   78             \+ depends_of_db(AH, AM, TH, TM, CM, _)
   79           ),
   80           ( functor(AH, AF, AA), functor(AP, AF, AA),
   81             functor(TH, TF, TA), functor(TP, TF, TA),
   82             assertz(depends_of_db(AP, AM, TP, TM, CM, 1))
   83           )).
   84
   85% resolve recursion explicitly for those dependencies inside the same module to
   86% avoid performance issues: we use tabling, but we also use an index to prevent
   87% performance problems, otherwise it will try all the possible paths between two
   88% predicates, which is not needed actually
   89
   90update_depends_of_n :-
   91    update_depends_of_n(1).
   92
   93update_depends_of_n(N1) :-
   94    succ(N1, N),
   95    forall(( depends_of_db(AH, AM, IH, IM, CM, N1),
   96             depends_of_db(IH, IM, TH, TM, CM, 1),
   97             \+ depends_of_db(AH, AM, TH, TM, CM, _)
   98           ),
   99           assertz(depends_of_db(AH, AM, TH, TM, CM, N))),
  100    ( depends_of_db(_, _, _, _, _, N)
  101    ->update_depends_of_n(N)
  102    ; true
  103    ).
  104
  105module_pred_links(ModuleL1, PILL) :-
  106    % Create a circular linked list:
  107    append(ModuleL1, ModuleL, ModuleL),
  108    findall(PI, module_pred_1st(forw, ModuleL, PI), PIU),
  109    sort(PIU, PI1),
  110    module_pred_link_loop(ModuleL, PI1, [], PILL).
  111
  112module_pred_link_loop([Module1, Module2|ModuleL], PI1, PILL1, PILL) :-
  113    % Fixpoint algorithm, it will stop when PI2 is an empty list or
  114    % when PI2 was already obtained in a previous iteraction:
  115    module_pred(forw, Module1, Module2, PI1, PI2),
  116    ( PI2 = []
  117    ->PILL = [Module2:PI2, Module1:PI1|PILL1]
  118    ; member(Module2:PI2, PILL1)
  119    ->PILL = [Module1:PI1|PILL1]
  120    ; module_pred_link_loop([Module2|ModuleL], PI2, [Module1:PI1|PILL1], PILL)
  121    ).
  122
  123module_pred_chains(forw, M1, M2, C, PILL, PIL) :-
  124    module_pred_chains_2(forw, M2, M1, C, PILR, PIL),
  125    reverse(PILR, PILL).
  126module_pred_chains(back, M2, M3, C, PILL, PIL) :-
  127    reverse(C, R),
  128    module_pred_chains_2(back, M2, M3, R, PILR, PIL),
  129    reverse(PILR, PILL).
  130
  131module_pred_chains_2(D, M2, M1, P1, [M1:PI1|PILL], PIL) :-
  132    append(P1, [M2], P2),
  133    findall(PI, module_pred_1st(D, [M1|P2], PI), PIU),
  134    sort(PIU, PI1),
  135    foldl(module_pred(D), [M1|P1], P2, PILL, PI1, PIL).
  136
  137module_pred_1st(back, [Module3, Module2|_], F3/A3) :-
  138    depends_of_db(_, _, H3, Module3, Module2, 1),
  139    functor(H3, F3, A3).
  140module_pred_1st(forw, [Module1, Module2|_], PI) :-
  141    depends_of_db(H1, M1, _, Module2, Module1, 1),
  142    functor(H1, F1, A1),
  143    ( M1 \= Module1
  144    ->PI = M1:F1/A1
  145    ; PI = F1/A1
  146    ).
  147
  148module_pred(D, Module1, Module2, Module2:PIL2, PIL1, PIL2) :-
  149    module_pred(D, Module1, Module2, PIL1, PIL2).
  150
  151module_pred(D, Module1, Module2, PIL1, PIL2) :-
  152    findall(PI,
  153            ( member(PI1, PIL1),
  154              get_module_pred(D, Module1, Module2, PI1, PI)
  155            ), PIU2),
  156    sort(PIU2, PIL2).
  157
  158get_module_pred(back, Module3, Module2, F3/A3, PI) :-
  159    % note we are ignoring M3:F3/A3, since they have no effect in dependencies
  160    functor(H3, F3, A3),
  161    depends_of_db(H2, M2, H3, Module3, Module2, _),
  162    functor(H2, F2, A2),
  163    ( M2 \= Module2
  164    ->PI = M2:F2/A2
  165    ; PI = F2/A2
  166    ).
  167get_module_pred(forw, Module1, Module2, PI1, F2/A2) :-
  168    ( PI1 = F1/A1
  169    ->M1 = Module1
  170    ; PI1 = M1:F1/A1
  171    ),
  172    functor(H1, F1, A1),
  173    depends_of_db(H1, M1, H2, Module2, Module1, _),
  174    functor(H2, F2, A2).
  175
  176loop_to_chain(ModuleL1, ModuleL) :-
  177    last(ModuleL1, Last),
  178    ModuleL1 = [First|_],
  179    append([Last|ModuleL1], [First], ModuleL).
  180
  181current_chain_link(ModuleL, Module1, Module2, Module3) :-
  182    append(_, [Module1, Module2, Module3|_], ModuleL).
  183
  184pred_uses(M, PI, H) :-
  185    ( PI = M2:F2/A2
  186    ->true
  187    ; PI = F2/A2,
  188      M2 = M
  189    ),
  190    functor(H2, F2, A2),
  191    depends_of_db(H2, M2, H, M, M, _).
  192
  193preds_uses(Module, PIL, RIL) :-
  194    findall(F/A,
  195            ( member(PI, PIL),
  196              pred_uses(Module, PI, H),
  197              functor(H, F, A)
  198            ), RIU, PIL),
  199    sort(RIU, RIL).
  200
  201% Like module_uses/3 in [library(module_uses)], but using depends_of_db/6 database:
  202
  203link_module_uses(LoadedIn, Module, Uses) :-
  204    findall(F/A, module_uses(LoadedIn, Module, F, A), Uses).
  205
  206module_uses(LoadedIn, Module, F, A) :-
  207    distinct(H, depends_of_db(_, _, H, Module, LoadedIn, 1)),
  208    functor(H, F, A)