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
   76aux_cohesive_module(M, F, A, CohM, CohesiveModule) :-
   77    format(atom(CT), '__aux_cohm_~w:~w/~w', [M, F, A]),
   78    CohesiveModule =.. [CT, CohM].
   79
   80aux_cohesive_pred(H, CohM, Scope, HExt) :-
   81    H =.. [F|Args],
   82    atom_concat('__aux_cohp_', F, FExt),
   83    HExt =.. [FExt, CohM, Scope|Args].
   84    % extend_args('__aux_cohp_', H, [CohM, Scope], HExt).
   85
   86aux_cohesive_wrap(H, CM, CohM, HWrp) :-
   87    extend_args('__aux_cohw_', H, [CM, CohM], HWrp).
   88
   89/* Note that if cohesive_module_rt/6 is called from the wrong context you will
   90 * get a run-time error since CheckCohM will not be defined, therefore you don't
   91 * need to implement a run-time check here, just let the predicate fail --EMM
   92*/
   93
   94call_check_cohesive_module(H, Context, M, CohM, CheckCohM) :-
   95    ( % First, try with fast precompiled checker
   96      '$defined_predicate'(Context:CheckCohM)
   97    ->Context:CheckCohM
   98    ; % Second, use the slower alternative, it works at compile time
   99      '$defined_predicate'(Context:H),
  100      cohesive_module(H, Context, M, CohM)
  101    ).
  102
  103cohesive_module_rt(_, user, _, _, _, _) :- !.
  104cohesive_module_rt(_, _, _, _, spublic, _).
  105cohesive_module_rt(H, Context, M, CohM, sexport, CheckCohM) :-
  106    call_check_cohesive_module(H, Context, M, CohM, CheckCohM).
  107cohesive_module_rt(_, C, _, C, sprivat, _).
  108
  109cohesive_pred_pi(CM, PI) -->
  110    { normalize_head(CM:PI, M:H),
  111      aux_cohesive_pred(H, CohM, Scope, HExt),
  112      functor(H, F, A),
  113      aux_cohesive_module(M, F, A, CohM, CheckCohM),
  114      aux_cohesive_wrap(H, Context, CohM, HWrp),
  115      functor(HExt, FExt, AExt)
  116    },
  117    [ cohesive:'$cohesive'(H, M),
  118      (:- module_transparent M:F/A),
  119      (:- multifile M:FExt/AExt)
  120    ],
  121    ( {'$predicate_property'((discontiguous), M:H)}
  122    ->[(:- discontiguous M:FExt/AExt)]
  123    ; []
  124    ),
  125    [ ( H :- context_module(Context),
  126             call(CM:HWrp)
  127      ),
  128      ( HWrp :-
  129            freeze_cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM),
  130            HExt
  131      )
  132    ].
  133
  134freeze_cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM) :-
  135    ignore(( Context \= user,
  136             % if called in the user context, asume all (equivalent to multifile)
  137             freeze(CohM, freeze(Scope, once(cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM))))
  138           )).
 call_cm(:Goal, +Context, -CohesiveModule) is multi
  142%   Calls Goal and returns the module where the current clause was implemented from.
  143
  144call_cm(Goal, Context, CohM, HWrp, IM) :-
  145    strip_module(Goal, _, Head),
  146    predicate_property(Goal, implementation_module(IM)),
  147    aux_cohesive_wrap(Head, Context, CohM, HWrp).
  148
  149call_cm(Goal, Context, CohM) :-
  150    call_cm(Goal, Context, CohM, HWrp, IM),
  151    IM:HWrp.
  152
  153coh_head_expansion(Scope, Head, IM:HeadExt) :-
  154    prolog_load_context(module, CM),
  155    predicate_property(CM:Head, implementation_module(IM)),
  156    '$cohesive'(Head, IM),
  157    % scope_module(Scope, CM, VM),
  158    aux_cohesive_pred(Head, CM, Scope, HeadExt).
  159
  160% sprivat: can not be used externally
  161% sexport: needs use_module to use it (default)
  162% spublic: available to all (like user context)
  163
  164scope_t(spublic).
  165scope_t(sexport).
  166scope_t(sprivat).
  167
  168check_cohm_clause(Context, H, IM, Clause) :-
  169    predicate_property(Context:H, implementation_module(IM)),
  170    functor(H, F, A),
  171    aux_cohesive_module(IM, F, A, CohM, CheckCohM),
  172    ( % Note: CheckCohM must not be multifile, otherwise it will
  173      % remain defined on recompilation and the compilation result
  174      % will not be correct --EMM
  175      Clause = Context:CheckCohM,
  176      aux_cohesive_pred(H, CohM, _Scope, HExt),
  177      cohesive_module(H, Context, IM, CohM),
  178      ( CohM \= Context
  179      ->once(clause(IM:HExt, _))
  180      ; true
  181      )
  182    ).
  183
  184check_cohm_clauses(Context, ClauseL) :-
  185    findall(Clause,
  186            ( '$cohesive'(H, IM),
  187              check_cohm_clause(Context, H, IM, Clause)
  188            ), ClauseL, [end_of_file]).
  189
  190term_expansion(end_of_file, ClauseL) :-
  191    prolog_load_context(module, Context),
  192    module_property(Context, file(File)),
  193    prolog_load_context(source, File),
  194    check_cohm_clauses(Context, ClauseL).
  195term_expansion((:- cohesive_pred PIs), ClauseL) :-
  196    prolog_load_context(module, CM),
  197    sequence_list(PIs, PIL, []),
  198    foldl(cohesive_pred_pi(CM), PIL, ClauseL, []).
  199term_expansion(Scope::Head :- Body, HeadExt :- Body) :-
  200    scope_t(Scope),
  201    coh_head_expansion(Scope, Head, HeadExt).
  202term_expansion(Scope::Head, HeadExt) :-
  203    scope_t(Scope),
  204    coh_head_expansion(Scope, Head, HeadExt).
  205term_expansion((::Head :- Body), (HeadExt :- Body)) :-
  206    coh_head_expansion(sexport, Head, HeadExt).
  207term_expansion(::Head, HeadExt) :-
  208    coh_head_expansion(sexport, Head, HeadExt).
  209term_expansion((Head :- Body), (HeadExt :- Body)) :-
  210    coh_head_expansion(sprivat, Head, HeadExt).
  211term_expansion(Head, HeadExt) :-
  212    coh_head_expansion(sprivat, Head, HeadExt).
  213
  214:- thread_local
  215    cm_db/2.
 cohesive_module(+H, +Context, +IM, -CohM) is multi
  219cohesive_module(H, Context, IM, CohM) :-
  220    setup_call_cleanup(
  221        prolog_current_choice(CP),
  222        cohesive_module_1st(CP, H, Context, IM, CohM),
  223        retractall(cm_db(_, CP))).
  224
  225cohesive_module_1st(CP, _, Context, _, Context) :-
  226    assertz(cm_db(Context, CP)).
  227cohesive_module_1st(CP, H, Context, IM, CM) :-
  228    '$load_context_module'(File, Context, _),
  229    module_property(M, file(File)),
  230    \+ cm_db(M, CP),
  231    predicate_property(M:H, implementation_module(IM)),
  232    cohesive_module_rec(CP, H, M, IM, CM).
  233
  234cohesive_module_rec(CP, _, Context, _, Context) :-
  235    assertz(cm_db(Context, CP)).
  236cohesive_module_rec(CP, H, C, IM, CM) :-
  237    '$load_context_module'(File, C, Options),
  238    option(reexport(true), Options),
  239    module_property(M, file(File)),
  240    \+ cm_db(M, CP),
  241    predicate_property(M:H, implementation_module(IM)),
  242    cohesive_module_rec(CP, H, M, IM, CM)