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

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

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

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

  233cohesive_module(H, Context, IM, CohM) :-
  234    setup_call_cleanup(
  235        prolog_current_choice(CP),
  236        cohesive_module_1st(CP, H, Context, IM, CohM),
  237        retractall(cm_db(_, CP))).
  238
  239cohesive_module_1st(CP, _, Context, _, Context) :-
  240    assertz(cm_db(Context, CP)).
  241cohesive_module_1st(CP, H, Context, IM, CM) :-
  242    '$load_context_module'(File, Context, _),
  243    module_property(M, file(File)),
  244    \+ cm_db(M, CP),
  245    predicate_property(M:H, implementation_module(IM)),
  246    cohesive_module_rec(CP, H, M, IM, CM).
  247
  248cohesive_module_rec(CP, _, Context, _, Context) :-
  249    assertz(cm_db(Context, CP)).
  250cohesive_module_rec(CP, H, C, IM, CM) :-
  251    '$load_context_module'(File, C, Options),
  252    option(reexport(true), Options),
  253    module_property(M, file(File)),
  254    \+ cm_db(M, CP),
  255    predicate_property(M:H, implementation_module(IM)),
  256    cohesive_module_rec(CP, H, M, IM, CM)