1/*  Part of Refactoring Tools for SWI-Prolog
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/refactor
    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(move_preds,
   36          [ move_preds/4,
   37            update_move_preds/4,
   38            source_module/2,
   39            target_file_module/4
   40          ]).   41
   42:- use_module(library(list_sequence)).   43:- use_module(library(module_links)).   44:- use_module(library(sequence_list)).   45:- use_module(library(pretty_decl)).   46:- use_module(library(refactor)).   47
   48:- multifile
   49        cond_move_pred_hook/4,
   50        move_preds_hook/6.   51
   52:- dynamic
   53        target_file_module/2.   54
   55depends_of(AH, AM, H, M, CM, N) :-
   56    depends_of_db(AH, AM, H, M, CM, N).
   57
   58module_from_file(File, M) :-
   59    ( module_property(M, file(File))
   60    ->true
   61    ; target_file_module(File, M)
   62    ).
   63
   64defined_predicate(M:H) :-
   65    once(( depends_of_db(H, M, _, _, _, 1)
   66         ; depends_of_db(_, _, H, M, _, 1)
   67         % ; predicate_property(M:H, defined)
   68         )).
   69
   70cond_move_pred(Term, _, _, _, _) :-
   71    var(Term),
   72    !,
   73    fail.
   74cond_move_pred(Term, MSource, _FTarget, PredList, Into) :-
   75    cond_move_pred_hook(Term, MSource, PredList, Into),
   76    !.
   77cond_move_pred(Term, M, _, PredList, []) :-
   78    memberchk(Term,
   79              [ G --> _
   80              ]),
   81    !,
   82    strip_module(M:G, CM, P),
   83    functor(P, F, D),
   84    A is D + 2,
   85    memberchk(CM:F/A, PredList).
   86cond_move_pred(Term, M, _, PredList, []) :-
   87    memberchk(Term,
   88              [ (H :- _)
   89              ]),
   90    !,
   91    strip_module(M:H, CM, P),
   92    nonvar(P),
   93    functor(P, F, A),
   94    memberchk(CM:F/A, PredList).
   95cond_move_pred((:- module(_, _)), _, _, _, _) :-
   96    !,
   97    fail.
   98cond_move_pred((:- include(Alias)), _, _, _, (:- include(Alias))) :-
   99    % We asume you don't use include to add predicates... do you???
  100    !.
  101cond_move_pred((:- Decl), MSource, _, PredList, Into) :-
  102    Decl =.. [DeclF, Sequence],
  103    memberchk(DeclF, [(meta_predicate), (multifile), (discontiguous),
  104                      (dynamic), (thread_local), (public), (export)]),
  105    !,
  106    sequence_list(Sequence, List, []),
  107    findall(Elem,
  108            ( member(Elem, List),
  109              \+ ( strip_module(MSource:Elem, M, H),
  110                   ( H = F/A
  111                   ->true
  112                   ; H = F//D
  113                   ->A is D + 2
  114                   ; functor(H, F, A)
  115                   ),
  116                   memberchk(M:F/A, PredList)
  117                 )
  118            ), Diff),
  119    Diff \= List,
  120    ( Diff = []
  121    ->Into = []
  122    ; list_sequence(Diff, ISeq),
  123      Decl2 =.. [DeclF, ISeq],
  124      Into = (:- Decl2)
  125    ).
  126cond_move_pred((:- use_module(Alias)), MSource, FTarget, PredList, Into) :-
  127    !,
  128    absolute_file_name(Alias, File, [file_errors(fail), access(exist), file_type(prolog)]),
  129    File \= FTarget,
  130    module_from_file(File, M),
  131    once(( depends_of(H2, M2, _, M, MSource, 1),
  132           functor(H2, F2, A2),
  133           memberchk(M2:F2/A2, PredList)
  134         )),
  135    ( depends_of(H1, M1, _, M, MSource, 1),
  136      functor(H1, F1, A1),
  137      \+ memberchk(M1:F1/A1, PredList)
  138    ->Into = (:- use_module(Alias))
  139    ; Into = []
  140    ).
  141cond_move_pred((:- use_module(Alias, ExL1)), MSource, FTarget, PredList, Into) :-
  142    !,
  143    absolute_file_name(Alias, File, [file_errors(fail), access(exist), file_type(prolog)]),
  144    File \= FTarget,
  145    module_from_file(File, M),
  146    \+ \+ ( member(F/A, ExL1),
  147            functor(H, F, A),
  148            once(( depends_of(H2, M2, H, M, MSource, _),
  149                   functor(H2, F2, A2),
  150                   memberchk(M2:F2/A2, PredList)
  151                 ))
  152          ),
  153    findall(F/A,
  154            ( member(F/A, ExL1),
  155              functor(H, F, A),
  156              once(( depends_of(H1, M1, H, M, MSource, _),
  157                     functor(H1, F1, A1),
  158                     \+ memberchk(M1:F1/A1, PredList)
  159                   ))
  160            ), ExL),
  161    ( ExL = []
  162    ->Into = []
  163    ; Into = (:- use_module(Alias, ExL))
  164    ).
  165cond_move_pred(H, M, _, PredList, []) :-  % This must be the last clause
  166    functor(H, F, A),
  167    memberchk(M:F/A, PredList).
  168
  169add_exports_module(MSource, Target, PredList, Options) :-
  170    pretty_decl((:- module(MTarget, L)), Decl),
  171    replace_sentence((:- module(MTarget, L1)), Decl,
  172                     ( findall(F/A,
  173                               ( member(MSource:F/A, PredList),
  174                                 functor(H, F, A),
  175                                 once(( depends_of(H2, M2, H, MSource, CM, 1),
  176                                        CM \= MTarget,
  177                                        functor(H2, F2, A2),
  178                                        \+ memberchk(M2:F2/A2, PredList)
  179                                      ))
  180                               ), U, L1),
  181                       sort(U, L)
  182                     ),
  183                     [file(Target)|Options]).
  184
  185cleanup_use_module(MSource, PredList, Options) :-
  186    replace_sentence((:- use_module(Alias, ExL1)), (:- use_module(Alias, ExL)),
  187                     ( absolute_file_name(Alias, File, [access(exist), file_type(prolog)]),
  188                       module_from_file(File, M),
  189                       findall(F/A,
  190                               ( member(F/A, ExL1),
  191                                 functor(H, F, A),
  192                                 once(( depends_of(H2, M2, H, M, MSource, 1),
  193                                        functor(H2, F2, A2),
  194                                        memberchk(M2:F2/A2, PredList)
  195                                      ))
  196                               ), ExL)
  197                     ), Options).
  198
  199cleanup_declaration(MSource, MTarget, PredList, Decl, Into) :-
  200    Decl =.. [DeclF, Sequence],
  201    memberchk(DeclF, [(meta_predicate), (multifile), (discontiguous),
  202                      (dynamic), (thread_local), (public), (export)]),
  203    sequence_list(Sequence, List, []),
  204    findall(Elem,
  205            ( member(Elem, List),
  206              ( Elem = M:P
  207              ->M1 = M,
  208                M3 = M,
  209                ( P = F/A
  210                ->true
  211                ; functor(P, F, A)
  212                )
  213              ; M1 = MSource,
  214                M3 = MTarget,
  215                ( Elem = F/A
  216                ->true
  217                ; functor(Elem, F, A)
  218                )
  219              ),
  220              functor(H, F, A),
  221              ( defined_predicate(M3:H)
  222              ->true
  223              ; defined_predicate(M1:H)
  224              ->memberchk(M1:F/A, PredList)
  225              )
  226            ), List2),
  227    List \= List2,
  228    ( List2 = []
  229    ->Into = []
  230    ; list_sequence(List2, Sequence2),
  231      Decl2 =.. [DeclF, Sequence2],
  232      Into = (:- Decl2)
  233    ).
  234
  235cleanup_declarations(MSource, MTarget, PredList, Options) :-
  236    replace_sentence((:- Decl), Into,
  237                     cleanup_declaration(MSource, MTarget, PredList, Decl, Into),
  238                     Options).
  239
  240:- dynamic
  241    declared_db/3.  242
  243add_new_use_module(MSource, MTarget, Source, Target, PredList, Options) :-
  244    findall(CM,
  245            ( depends_of_db(_, _, H, MSource, CM, 1),
  246              CM \= MSource,
  247              CM \= MTarget,
  248              functor(H, F, A),
  249              memberchk(MSource:F/A, PredList),
  250              \+ ( depends_of_db(_, _, H, MSource, CM, 1),
  251                   CM \= MSource,
  252                   functor(H, F, A),
  253                   \+ memberchk(MSource:F/A, PredList)
  254                 )
  255            ), CMU),
  256    sort(CMU, CML),
  257    forall(member(CM, CML), add_use_mod(Target, [module(CM), below(Source)|Options])),
  258    replace_sentence((:- use_module(Source)), [],
  259                     \+ ( depends_of_db(_, _, H, MSource, CM, 1),
  260                          CM \= MSource,
  261                          functor(H, F, A),
  262                          \+ memberchk(MSource:F/A, PredList)
  263                        ), [module(CM), modules([MSource|CML])|Options]),
  264    del_dup_use_module([modules([MSource|CML])|Options]),
  265    del_dup_use_module([files([Target])|Options]).
  266
  267del_dup_use_module(Options) :-
  268    replace_sentence((:- Decl), [],
  269                     ( memberchk(Decl, [include(_), use_module(_), use_module(_, _)]),
  270                       ( declared_db(CM, File, Decl)
  271                       ->true
  272                       ; assertz(declared_db(CM, File, Decl)),
  273                         fail
  274                       )
  275                     ), [file(File), module(CM)|Options]),
  276    retractall(declared_db(_, _, _)).
  277
  278extern_dependency(target, H2, M2, H, M) :- depends_of_db(H2, M2, H, M, M, 1).
  279extern_dependency(source, H2, M,  H, M) :- depends_of_db(H,  M, H2, M, M, 1). % for source, M = M2
  280
  281add_use_mod(Type, M, Alias, PredList, Options) :-
  282    ( member(M:F/A, PredList),
  283      functor(H, F, A),
  284      extern_dependency(Type, H2, M2, H, M),
  285      functor(H2, F2, A2),
  286      \+ memberchk(M2:F2/A2, PredList)
  287    ->add_use_mod(Alias, Options)
  288    ; true
  289    ).
  290
  291add_use_mod(Alias, Options1) :-
  292    Options = [max_changes(1), changes(C)|Options1],
  293    once(( ( ( option(below(Prev), Options),
  294               member(Decl, [(:- use_module(Prev)), (:- use_module(Prev, _))]),
  295               replace_sentence(Decl, [Decl, (:- use_module(Alias))], Options)
  296             ; replace_sentence([(:- use_module(Prev)), Next],
  297                                [(:- use_module(Prev)), (:- use_module(Alias)), Next],
  298                                \+ memberchk(Next, [(:- use_module(_)),(:- use_module(_, _))]),
  299                                Options)
  300             )
  301           ; member(Term, [(:- include(_)), (:- module(_, _))]),
  302             replace_sentence(Term, [Term, (:- use_module(Alias))], Options)
  303           ),
  304           C \= 0
  305         )).
  306
  307normalize_pred_id(M1, PI, M:F/A) :-
  308    ( PI = M:F/A
  309    ->true
  310    ; PI = F/A,
  311      M = M1
  312    ).
  313
  314update_db(PredList, MSource, MTarget, FTarget) :-
  315    assertz(target_file_module(FTarget, MTarget)),
  316    forall(( member(M:F/A, PredList),
  317             functor(H, F, A)
  318           ),
  319           ( forall(retract(depends_of_db(AH, AM, H, M, CM, N)),
  320                    ( ( M = MSource
  321                      ->TM = MTarget
  322                      ; TM = M
  323                      ),
  324                      assertz(depends_of_db(AH, AM, H, TM, CM, N))
  325                    )),
  326             forall(retract(depends_of_db(H, M, TH, TM, MSource, N)),
  327                    ( ( M = MSource
  328                      ->AM = MTarget
  329                      ; AM = M
  330                      ),
  331                      assertz(depends_of_db(H, AM, TH, TM, MTarget, N))
  332                    ))
  333           )).
  334
  335update_move_preds(PredList1, Source, Target, Options) :-
  336    process_args(PredList1, Source, Target, PredList, MSource, MTarget, FTarget, Options),
  337    update_db(PredList, MSource, MTarget, FTarget).
  338
  339target_file_module(Target, Options, FTarget, MTarget) :-
  340    absolute_file_name(Target, FTarget, [file_type(prolog)]),
  341    option(target_module(MTarget), Options, MTarget),
  342    ( nonvar(MTarget)
  343    ->true
  344    ; module_from_file(FTarget, MTarget)
  345    ->true
  346    ; file_name_extension(BaseDir, _, FTarget),
  347      directory_file_path(_, MTarget, BaseDir)
  348    ).
  349
  350source_module(Source, MSource) :-
  351    % FSource should exist
  352    absolute_file_name(Source, FSource, [file_type(prolog), access(exist)]),
  353    module_from_file(FSource, MSource).
  354
  355process_args(PredList1, Source, Target, PredList, MSource, MTarget, FTarget, Options) :-
  356    source_module(Source, MSource),
  357    maplist(normalize_pred_id(MSource), PredList1, PredList),
  358    target_file_module(Target, Options, FTarget, MTarget).
  359
  360move_preds(PredList1, Source, Target, Options) :-
  361    process_args(PredList1, Source, Target, PredList, MSource, MTarget, FTarget, Options),
  362    ( exists_file(FTarget)
  363    ->true
  364    ; tell(FTarget),
  365      told
  366    ),
  367    ( size_file(FTarget, 0 )
  368    ->replace_sentence([], (:- module(MTarget, [])), [file(Target)|Options])
  369    ; true
  370    ),
  371    pretty_decl((:- module(M, L)), Decl),
  372    replace_sentence((:- module(M, L1)), Decl,
  373                     ( MSource = TM,
  374                       findall(TPI,
  375                               ( ( member(TPI, L1),
  376                                   ( TPI = TF/TA
  377                                   ; TPI = TF//TA1,
  378                                     TA is TA1 + 2
  379                                   )
  380                                 ),
  381                                 \+ memberchk(TM:TF/TA, PredList)
  382                               ; member(TM:AF/AA, PredList),
  383                                 once(( functor(AH, AF, AA),
  384                                        depends_of_db(AH, TM, TH, TM, TM, 1),
  385                                        functor(TH, TF, TA),
  386                                        \+ memberchk(TM:TF/TA, PredList)
  387                                      )),
  388                                 TPI = TF/TA
  389                               ), U),
  390                       sort(U, L)
  391                     ),
  392                     [file(Source)|Options]),
  393    move_term(Term,
  394              Into,
  395              end_of_file,
  396              cond_move_pred(Term, MSource, FTarget, PredList, Into),
  397              [file(Source)], true, [file(Target)], Options),
  398    forall(move_preds_hook(PredList, MSource, Source, MTarget, Target, Options), true),
  399    cleanup_use_module(MSource, PredList, [file(Target)|Options]),
  400    cleanup_declarations(MSource, MTarget, PredList, [file(Target)|Options]),
  401    add_exports_module(MSource, Target, PredList, Options),
  402    add_use_mod(target, MSource, Target, PredList, [file(Source)|Options]),
  403    add_use_mod(source, MSource, Source, PredList, [file(Target)|Options]),
  404    add_new_use_module(MSource, MTarget, Source, Target, PredList, Options),
  405    ( option(update_db(true), Options)
  406    ->update_db(PredList, MSource, MTarget, FTarget)
  407    ; true
  408    )