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            module_uses/3,
   42            preds_uses/3,
   43            update_depends_of/0,
   44            cleanup_depends_of/0
   45          ]).   46
   47:- use_module(library(lists)).   48:- use_module(library(calls_to)).   49:- use_module(library(solution_sequences)).   50
   51:- multifile
   52        update_depends_of_hook/0.   53
   54ref_head('<assertion>'(M:H), M, H).
   55ref_head(M:H, M, H).
   56ref_head(clause(Ref), M, H) :-
   57    freeze(Ref, clause(M:H, _, Ref)).
   58
   59pred_calls_to(AH, AM, H, CM) :-
   60    ref_head(Ref, AM, AH),
   61    calls_to(Ref, CM, H).
   62
   63:- dynamic
   64    depends_of_db/6.   65
   66update_depends_of :-
   67    update_depends_of_1,
   68    forall(update_depends_of_hook, true),
   69    update_depends_of_n.
   70
   71cleanup_depends_of :-
   72    retractall(depends_of_db(_, _, _, _, _, _)).
   73
   74update_depends_of_1 :-
   75    forall(( pred_calls_to(AH, AM, TH, CM),
   76             predicate_property(CM:TH, implementation_module(TM)),
   77             \+ depends_of_db(AH, AM, TH, TM, CM, _)
   78           ),
   79           ( functor(AH, AF, AA), functor(AP, AF, AA),
   80             functor(TH, TF, TA), functor(TP, TF, TA),
   81             assertz(depends_of_db(AP, AM, TP, TM, CM, 1))
   82           )).
   83
   84% resolve recursion explicitly for those dependencies inside the same module to
   85% avoid performance issues: we use tabling, but we also use an index to prevent
   86% performance problems, otherwise it will try all the possible paths between two
   87% predicates, which is not needed actually
   88
   89update_depends_of_n :-
   90    update_depends_of_n(1).
   91
   92update_depends_of_n(N1) :-
   93    succ(N1, N),
   94    forall(( depends_of_db(AH, AM, IH, IM, CM, N1),
   95             depends_of_db(IH, IM, TH, TM, CM, 1),
   96             \+ depends_of_db(AH, AM, TH, TM, CM, _)
   97           ),
   98           assertz(depends_of_db(AH, AM, TH, TM, CM, N))),
   99    ( depends_of_db(_, _, _, _, _, N)
  100    ->update_depends_of_n(N)
  101    ; true
  102    ).
  103
  104module_pred_links(ModuleL1, PILL) :-
  105    % Create a circular linked list:
  106    append(ModuleL1, ModuleL, ModuleL),
  107    findall(PI, module_pred_1st(forw, ModuleL, PI), PIU),
  108    sort(PIU, PI1),
  109    module_pred_link_loop(ModuleL, PI1, [], PILL).
  110
  111module_pred_link_loop([Module1, Module2|ModuleL], PI1, PILL1, PILL) :-
  112    % Fixpoint algorithm, it will stop when PI2 is an empty list or
  113    % when PI2 was already obtained in a previous iteraction:
  114    module_pred(forw, Module1, Module2, PI1, PI2),
  115    ( PI2 = []
  116    ->PILL = [Module2:PI2, Module1:PI1|PILL1]
  117    ; member(Module2:PI2, PILL1)
  118    ->PILL = [Module1:PI1|PILL1]
  119    ; module_pred_link_loop([Module2|ModuleL], PI2, [Module1:PI1|PILL1], PILL)
  120    ).
  121
  122module_pred_chains(forw, M1, M2, C, PILL, PIL) :-
  123    module_pred_chains_2(forw, M2, M1, C, PILR, PIL),
  124    reverse(PILR, PILL).
  125module_pred_chains(back, M2, M3, C, PILL, PIL) :-
  126    reverse(C, R),
  127    module_pred_chains_2(back, M2, M3, R, PILR, PIL),
  128    reverse(PILR, PILL).
  129
  130module_pred_chains_2(D, M2, M1, P1, [M1:PI1|PILL], PIL) :-
  131    append(P1, [M2], P2),
  132    findall(PI, module_pred_1st(D, [M1|P2], PI), PIU),
  133    sort(PIU, PI1),
  134    foldl(module_pred(D), [M1|P1], P2, PILL, PI1, PIL).
  135
  136module_pred_1st(back, [Module3, Module2|_], F3/A3) :-
  137    depends_of_db(_, _, H3, Module3, Module2, 1),
  138    functor(H3, F3, A3).
  139module_pred_1st(forw, [Module1, Module2|_], PI) :-
  140    depends_of_db(H1, M1, _, Module2, Module1, 1),
  141    functor(H1, F1, A1),
  142    ( M1 \= Module1
  143    ->PI = M1:F1/A1
  144    ; PI = F1/A1
  145    ).
  146
  147module_pred(D, Module1, Module2, Module2:PIL2, PIL1, PIL2) :-
  148    module_pred(D, Module1, Module2, PIL1, PIL2).
  149
  150module_pred(D, Module1, Module2, PIL1, PIL2) :-
  151    findall(PI,
  152            ( member(PI1, PIL1),
  153              get_module_pred(D, Module1, Module2, PI1, PI)
  154            ), PIU2),
  155    sort(PIU2, PIL2).
  156
  157get_module_pred(back, Module3, Module2, F3/A3, PI) :-
  158    % note we are ignoring M3:F3/A3, since they have no effect in dependencies
  159    functor(H3, F3, A3),
  160    depends_of_db(H2, M2, H3, Module3, Module2, _),
  161    functor(H2, F2, A2),
  162    ( M2 \= Module2
  163    ->PI = M2:F2/A2
  164    ; PI = F2/A2
  165    ).
  166get_module_pred(forw, Module1, Module2, PI1, F2/A2) :-
  167    ( PI1 = F1/A1
  168    ->M1 = Module1
  169    ; PI1 = M1:F1/A1
  170    ),
  171    functor(H1, F1, A1),
  172    depends_of_db(H1, M1, H2, Module2, Module1, _),
  173    functor(H2, F2, A2).
  174
  175loop_to_chain(ModuleL1, ModuleL) :-
  176    last(ModuleL1, Last),
  177    ModuleL1 = [First|_],
  178    append([Last|ModuleL1], [First], ModuleL).
  179
  180current_chain_link(ModuleL, Module1, Module2, Module3) :-
  181    append(_, [Module1, Module2, Module3|_], ModuleL).
  182
  183pred_uses(M, PI, H) :-
  184    ( PI = M2:F2/A2
  185    ->true
  186    ; PI = F2/A2,
  187      M2 = M
  188    ),
  189    functor(H2, F2, A2),
  190    depends_of_db(H2, M2, H, M, M, _).
  191
  192preds_uses(Module, PIL, RIL) :-
  193    findall(F/A,
  194            ( member(PI, PIL),
  195              pred_uses(Module, PI, H),
  196              functor(H, F, A)
  197            ), RIU, PIL),
  198    sort(RIU, RIL).
  199
  200% Like module_uses/3 in [library(module_uses)], but using depends_of_db/6 database:
  201
  202module_uses(LoadedIn, Module, Uses) :-
  203    findall(F/A, module_uses(LoadedIn, Module, F, A), Uses).
  204
  205module_uses(LoadedIn, Module, F, A) :-
  206    distinct(H, depends_of_db(_, _, H, Module, LoadedIn, 1)),
  207    functor(H, F, A)