1/*  Part of Extended Libraries for SWI-Prolog
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/xlibrary
    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(cohesive,
   36          [ cohesive_module/4,
   37            cohesive_module_rt/6,
   38            freeze_cohesive_module_rt/6,
   39            scope_t/1,
   40            call_cm/3,
   41            call_cm/5,
   42            '$cohesive'/2
   43          ]).   44
   45:- use_module(library(apply)).   46:- use_module(library(extend_args)).   47:- use_module(library(normalize_head)).   48:- use_module(library(option)).   49:- use_module(library(sequence_list)).   50:- reexport(library(cohesive_op)).   51:- reexport(library(compound_expand)).   52:- init_expansors.   53
   54/* <module> Cohesive predicates
   55
   56   This module provides support for cohesive predicates, those are like
   57   multifiles, but in order to use them, we need to import the predicates that
   58   define their clauses.  If two or more modules are imported, they are added
   59   up.  This provides certain level of encapsulation, but at the same time
   60   allows extensibility.  It also pays attention to reexported modules so that
   61   clauses in reexported modules of cohesive predicates become available in the
   62   importing module.
   63
   64@author Edison Mera
   65
   66*/
   67
   68:- multifile
   69    '$cohesive'/2.   70
   71:- meta_predicate
   72        call_cm(0, +, -),
   73        call_cm(0, +, ?, -, -).   74
   75:- public freeze_cohesive_module_rt/6.   76
   77aux_cohesive_module(M, F, A, CohM, CohesiveModule) :-
   78    format(atom(CT), '__aux_cohm_~w:~w/~w', [M, F, A]),
   79    CohesiveModule =.. [CT, CohM].
   80
   81aux_cohesive_pred(H, CohM, Scope, HExt) :-
   82    H =.. [F|Args],
   83    atom_concat('__aux_cohp_', F, FExt),
   84    HExt =.. [FExt, CohM, Scope|Args].
   85    % extend_args('__aux_cohp_', H, [CohM, Scope], HExt).
   86
   87aux_cohesive_wrap(H, CM, CohM, HWrp) :-
   88    extend_args('__aux_cohw_', H, [CM, CohM], HWrp).
   89
   90/* Note that if cohesive_module_rt/6 is called from the wrong context you will
   91 * get a run-time error since CheckCohM will not be defined, therefore you don't
   92 * need to implement a run-time check here, just let the predicate fail --EMM
   93*/
   94
   95call_check_cohesive_module(H, Context, M, CohM, CheckCohM) :-
   96    ( % First, try with fast precompiled checker
   97      '$defined_predicate'(Context:CheckCohM)
   98    ->Context:CheckCohM
   99    ; % Second, use the slower alternative, it works at compile time
  100      '$defined_predicate'(Context:H),
  101      cohesive_module(H, Context, M, CohM)
  102    ).
  103
  104cohesive_module_rt(_, user, _, _, _, _) :- !.
  105cohesive_module_rt(_, _, _, _, spublic, _).
  106cohesive_module_rt(H, Context, M, CohM, sexport, CheckCohM) :-
  107    call_check_cohesive_module(H, Context, M, CohM, CheckCohM).
  108cohesive_module_rt(_, C, _, C, sprivat, _).
  109
  110cohesive_pred_pi(CM, PI) -->
  111    { normalize_head(CM:PI, M:H),
  112      aux_cohesive_pred(H, CohM, Scope, HExt),
  113      functor(H, F, A),
  114      aux_cohesive_module(M, F, A, CohM, CheckCohM),
  115      aux_cohesive_wrap(H, Context, CohM, HWrp),
  116      functor(HExt, FExt, AExt)
  117    },
  118    [ cohesive:'$cohesive'(H, M),
  119      (:- module_transparent M:F/A),
  120      (:- multifile M:FExt/AExt)
  121    ],
  122    ( {'$predicate_property'((discontiguous), M:H)}
  123    ->[(:- discontiguous M:FExt/AExt)]
  124    ; []
  125    ),
  126    [ ( H :- context_module(Context),
  127             call(CM:HWrp)
  128      ),
  129      ( HWrp :-
  130            freeze_cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM),
  131            HExt
  132      )
  133    ].
  134
  135freeze_cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM) :-
  136    ignore(( Context \= user,
  137             % if called in the user context, asume all (equivalent to multifile)
  138             freeze(CohM, freeze(Scope, once(cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM))))
  139           )).

 call_cm(:Goal, +Context, -CohesiveModule) is multi

  143%   Calls Goal and returns the module where the current clause was implemented from.
  144
  145call_cm(Goal, Context, CohM, HWrp, IM) :-
  146    strip_module(Goal, _, Head),
  147    predicate_property(Goal, implementation_module(IM)),
  148    aux_cohesive_wrap(Head, Context, CohM, HWrp).
  149
  150call_cm(Goal, Context, CohM) :-
  151    call_cm(Goal, Context, CohM, HWrp, IM),
  152    IM:HWrp.
  153
  154coh_head_expansion(Scope, Head, IM:HeadExt) :-
  155    prolog_load_context(module, CM),
  156    predicate_property(CM:Head, implementation_module(IM)),
  157    '$cohesive'(Head, IM),
  158    % scope_module(Scope, CM, VM),
  159    aux_cohesive_pred(Head, CM, Scope, HeadExt).
  160
  161% sprivat: can not be used externally
  162% sexport: needs use_module to use it (default)
  163% spublic: available to all (like user context)
  164
  165scope_t(spublic).
  166scope_t(sexport).
  167scope_t(sprivat).
  168
  169check_cohm_clause(Context, H, IM, Clause) :-
  170    predicate_property(Context:H, implementation_module(IM)),
  171    functor(H, F, A),
  172    aux_cohesive_module(IM, F, A, CohM, CheckCohM),
  173    ( % Note: CheckCohM must not be multifile, otherwise it will
  174      % remain defined on recompilation and the compilation result
  175      % will not be correct --EMM
  176      Clause = Context:CheckCohM,
  177      aux_cohesive_pred(H, CohM, _Scope, HExt),
  178      cohesive_module(H, Context, IM, CohM),
  179      ( CohM \= Context
  180      ->once(clause(IM:HExt, _))
  181      ; true
  182      )
  183    ).
  184
  185check_cohm_clauses(Context, ClauseL) :-
  186    findall(Clause,
  187            ( '$cohesive'(H, IM),
  188              check_cohm_clause(Context, H, IM, Clause)
  189            ), ClauseL, [end_of_file]).
  190
  191term_expansion(end_of_file, ClauseL) :-
  192    prolog_load_context(module, Context),
  193    module_property(Context, file(File)),
  194    prolog_load_context(source, File),
  195    check_cohm_clauses(Context, ClauseL).
  196term_expansion((:- cohesive_pred PIs), ClauseL) :-
  197    prolog_load_context(module, CM),
  198    sequence_list(PIs, PIL, []),
  199    foldl(cohesive_pred_pi(CM), PIL, ClauseL, []).
  200term_expansion(Scope::Head :- Body, HeadExt :- Body) :-
  201    scope_t(Scope),
  202    coh_head_expansion(Scope, Head, HeadExt).
  203term_expansion(Scope::Head, HeadExt) :-
  204    scope_t(Scope),
  205    coh_head_expansion(Scope, Head, HeadExt).
  206term_expansion((::Head :- Body), (HeadExt :- Body)) :-
  207    coh_head_expansion(sexport, Head, HeadExt).
  208term_expansion(::Head, HeadExt) :-
  209    coh_head_expansion(sexport, Head, HeadExt).
  210term_expansion((Head :- Body), (HeadExt :- Body)) :-
  211    coh_head_expansion(sprivat, Head, HeadExt).
  212term_expansion(Head, HeadExt) :-
  213    coh_head_expansion(sprivat, Head, HeadExt).
  214
  215:- thread_local
  216    cm_db/2.

 cohesive_module(+H, +Context, +IM, -CohM) is multi

  220cohesive_module(H, Context, IM, CohM) :-
  221    setup_call_cleanup(
  222        prolog_current_choice(CP),
  223        cohesive_module_1st(CP, H, Context, IM, CohM),
  224        retractall(cm_db(_, CP))).
  225
  226cohesive_module_1st(CP, _, Context, _, Context) :-
  227    assertz(cm_db(Context, CP)).
  228cohesive_module_1st(CP, H, Context, IM, CM) :-
  229    '$load_context_module'(File, Context, _),
  230    module_property(M, file(File)),
  231    \+ cm_db(M, CP),
  232    predicate_property(M:H, implementation_module(IM)),
  233    cohesive_module_rec(CP, H, M, IM, CM).
  234
  235cohesive_module_rec(CP, _, Context, _, Context) :-
  236    assertz(cm_db(Context, CP)).
  237cohesive_module_rec(CP, H, C, IM, CM) :-
  238    '$load_context_module'(File, C, Options),
  239    option(reexport(true), Options),
  240    module_property(M, file(File)),
  241    \+ cm_db(M, CP),
  242    predicate_property(M:H, implementation_module(IM)),
  243    cohesive_module_rec(CP, H, M, IM, CM)