1/*  Part of SWI-Prolog
    2
    3    Author:        Benoit Desouter <Benoit.Desouter@UGent.be>
    4                   Jan Wielemaker (SWI-Prolog port)
    5                   Fabrizio Riguzzi (mode directed tabling)
    6    Copyright (c) 2016-2021, Benoit Desouter,
    7                             Jan Wielemaker,
    8                             Fabrizio Riguzzi
    9                             SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module('$tabling',
   39          [ (table)/1,                  % :PI ...
   40            untable/1,                  % :PI ...
   41
   42            (tnot)/1,                   % :Goal
   43            not_exists/1,               % :Goal
   44            undefined/0,
   45            answer_count_restraint/0,
   46            radial_restraint/0,
   47
   48            current_table/2,            % :Variant, ?Table
   49            abolish_all_tables/0,
   50            abolish_private_tables/0,
   51            abolish_shared_tables/0,
   52            abolish_table_subgoals/1,   % :Subgoal
   53            abolish_module_tables/1,    % +Module
   54            abolish_nonincremental_tables/0,
   55            abolish_nonincremental_tables/1, % +Options
   56            abolish_monotonic_tables/0,
   57
   58            start_tabling/3,            % +Closure, +Wrapper, :Worker
   59            start_subsumptive_tabling/3,% +Closure, +Wrapper, :Worker
   60            start_abstract_tabling/3,   % +Closure, +Wrapper, :Worker
   61            start_moded_tabling/5,      % +Closure, +Wrapper, :Worker,
   62                                        % :Variant, ?ModeArgs
   63
   64            '$tbl_answer'/4,            % +Trie, -Return, -ModeArgs, -Delay
   65
   66            '$wrap_tabled'/2,		% :Head, +Mode
   67            '$moded_wrap_tabled'/5,	% :Head, +Opts, +ModeTest, +Varnt, +Moded
   68            '$wfs_call'/2,              % :Goal, -Delays
   69
   70            '$set_table_wrappers'/1,    % :Head
   71            '$start_monotonic'/2        % :Head, :Wrapped
   72          ]).   73
   74:- meta_predicate
   75    table(:),
   76    untable(:),
   77    tnot(0),
   78    not_exists(0),
   79    tabled_call(0),
   80    start_tabling(+, +, 0),
   81    start_abstract_tabling(+, +, 0),
   82    start_moded_tabling(+, +, 0, +, ?),
   83    current_table(:, -),
   84    abolish_table_subgoals(:),
   85    '$wfs_call'(0, :).

   97% Enable debugging using debug(tabling(Topic)) when compiled with
   98% -DO_DEBUG
   99goal_expansion(tdebug(Topic, Fmt, Args), Expansion) :-
  100    (   current_prolog_flag(prolog_debug, true)
  101    ->  Expansion = debug(tabling(Topic), Fmt, Args)
  102    ;   Expansion = true
  103    ).
  104goal_expansion(tdebug(Goal), Expansion) :-
  105    (   current_prolog_flag(prolog_debug, true)
  106    ->  Expansion = (   debugging(tabling(_))
  107                    ->  (   Goal
  108                        ->  true
  109                        ;   print_message(error,
  110                                          format('goal_failed: ~q', [Goal]))
  111                        )
  112                    ;   true
  113                    )
  114    ;   Expansion = true
  115    ).
  116
  117:- if(current_prolog_flag(prolog_debug, true)).  118wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
  119    !,
  120    '$tbl_wkl_table'(WorkList, ATrie),
  121    trie_goal(ATrie, Goal, Skeleton).
  122wl_goal(WorkList, Goal, Skeleton) :-
  123    '$tbl_wkl_table'(WorkList, ATrie),
  124    trie_goal(ATrie, Goal, Skeleton).
  125
  126trie_goal(ATrie, Goal, Skeleton) :-
  127    '$tbl_table_status'(ATrie, _Status, M:Variant, Skeleton),
  128    (   M:'$table_mode'(Goal0, Variant, _Moded)
  129    ->  true
  130    ;   Goal0 = Variant                 % dynamic IDG nodes
  131    ),
  132    unqualify_goal(M:Goal0, user, Goal).
  133
  134delay_goals(List, Goal) :-
  135    delay_goals(List, user, Goal).
  136
  137user_goal(Goal, UGoal) :-
  138    unqualify_goal(Goal, user, UGoal).
  139
  140:- multifile
  141    prolog:portray/1.  142
  143user:portray(ATrie) :-
  144    '$is_answer_trie'(ATrie, _),
  145    trie_goal(ATrie, Goal, _Skeleton),
  146    (   '$idg_falsecount'(ATrie, FalseCount)
  147    ->  (   '$idg_forced'(ATrie)
  148        ->  format('~q [fc=~d/F] for ~p', [ATrie, FalseCount, Goal])
  149        ;   format('~q [fc=~d] for ~p', [ATrie, FalseCount, Goal])
  150        )
  151    ;   format('~q for ~p', [ATrie, Goal])
  152    ).
  153user:portray(Cont) :-
  154    compound(Cont),
  155    compound_name_arguments(Cont, '$cont$', [_Context, Clause, PC | Args]),
  156    clause_property(Clause, file(File)),
  157    file_base_name(File, Base),
  158    clause_property(Clause, line_count(Line)),
  159    clause_property(Clause, predicate(PI)),
  160    format('~q at ~w:~d @PC=~w, ~p', [PI, Base, Line, PC, Args]).
  161
  162:- endif.

 table :PredicateIndicators

Prepare the given PredicateIndicators for tabling. This predicate is normally used as a directive, but SWI-Prolog also allows runtime conversion of non-tabled predicates to tabled predicates by calling table/1. The example below prepares the predicate edge/2 and the non-terminal statement//1 for tabled execution.

:- table edge/2, statement//1.

In addition to using predicate indicators, a predicate can be declared for mode directed tabling using a term where each argument declares the intended mode. For example:

:- table connection(_,_,min).

Mode directed tabling is discussed in the general introduction section about tabling.

  187table(M:PIList) :-
  188    setup_call_cleanup(
  189        '$set_source_module'(OldModule, M),
  190        expand_term((:- table(PIList)), Clauses),
  191        '$set_source_module'(OldModule)),
  192    dyn_tabling_list(Clauses, M).
  193
  194dyn_tabling_list([], _).
  195dyn_tabling_list([H|T], M) :-
  196    dyn_tabling(H, M),
  197    dyn_tabling_list(T, M).
  198
  199dyn_tabling(M:Clause, _) :-
  200    !,
  201    dyn_tabling(Clause, M).
  202dyn_tabling((:- multifile(PI)), M) :-
  203    !,
  204    multifile(M:PI),
  205    dynamic(M:PI).
  206dyn_tabling(:- initialization(Wrap, now), M) :-
  207    !,
  208    M:Wrap.
  209dyn_tabling('$tabled'(Head, TMode), M) :-
  210    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  211        (   OMode \== TMode
  212        ->  erase(Ref),
  213            fail
  214        ;   true
  215        )
  216    ->  true
  217    ;   assertz(M:'$tabled'(Head, TMode))
  218    ).
  219dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  220    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  221    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  222        ->  true
  223        ;   erase(Ref),
  224            assertz(M:'$table_mode'(Head, Variant, Moded))
  225        )
  226    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  227    ).
  228dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  229    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  230    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  231        ->  true
  232        ;   erase(Ref),
  233            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  234        )
  235    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  236    ).

 untable(M:PIList) is det

Remove tabling for the predicates in PIList. This can be used to undo the effect of table/1 at runtime. In addition to removing the tabling instrumentation this also removes possibly associated tables using abolish_table_subgoals/1.

Arguments:

PIList

- is a comma-list that is compatible ith table/1.

  247untable(M:PIList) :-
  248    untable(PIList, M).
  249
  250untable(Var, _) :-
  251    var(Var),
  252    !,
  253    '$instantiation_error'(Var).
  254untable(M:Spec, _) :-
  255    !,
  256    '$must_be'(atom, M),
  257    untable(Spec, M).
  258untable((A,B), M) :-
  259    !,
  260    untable(A, M),
  261    untable(B, M).
  262untable(Name//Arity, M) :-
  263    atom(Name), integer(Arity), Arity >= 0,
  264    !,
  265    Arity1 is Arity+2,
  266    untable(Name/Arity1, M).
  267untable(Name/Arity, M) :-
  268    !,
  269    functor(Head, Name, Arity),
  270    (   '$get_predicate_attribute'(M:Head, tabled, 1)
  271    ->  abolish_table_subgoals(M:Head),
  272        dynamic(M:'$tabled'/2),
  273        dynamic(M:'$table_mode'/3),
  274        retractall(M:'$tabled'(Head, _TMode)),
  275        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  276        unwrap_predicate(M:Name/Arity, table),
  277        '$set_predicate_attribute'(M:Head, tabled, false),
  278        '$set_predicate_attribute'(M:Head, opaque, false),
  279        '$set_predicate_attribute'(M:Head, incremental, false),
  280        '$set_predicate_attribute'(M:Head, monotonic, false),
  281        '$set_predicate_attribute'(M:Head, lazy, false)
  282    ;   true
  283    ).
  284untable(Head, M) :-
  285    callable(Head),
  286    !,
  287    functor(Head, Name, Arity),
  288    untable(Name/Arity, M).
  289untable(TableSpec, _) :-
  290    '$type_error'(table_desclaration, TableSpec).
  291
  292untable_reconsult(PI) :-
  293    print_message(informational, untable(PI)),
  294    untable(PI).
  295
  296:- initialization
  297   prolog_listen(untable, untable_reconsult).  298
  299
  300'$wrap_tabled'(Head, Options) :-
  301    get_dict(mode, Options, subsumptive),
  302    !,
  303    set_pattributes(Head, Options),
  304    '$wrap_predicate'(Head, table, Closure, Wrapped,
  305                      start_subsumptive_tabling(Closure, Head, Wrapped)).
  306'$wrap_tabled'(Head, Options) :-
  307    get_dict(subgoal_abstract, Options, _Abstract),
  308    !,
  309    set_pattributes(Head, Options),
  310    '$wrap_predicate'(Head, table, Closure, Wrapped,
  311                      start_abstract_tabling(Closure, Head, Wrapped)).
  312'$wrap_tabled'(Head, Options) :-
  313    !,
  314    set_pattributes(Head, Options),
  315    '$wrap_predicate'(Head, table, Closure, Wrapped,
  316                      start_tabling(Closure, Head, Wrapped)).

 set_pattributes(:Head, +Options) is det

Set all tabling attributes for Head. These have been collected using table_options/3 from the :- table Head as (Attr1,...) directive.

  323set_pattributes(Head, Options) :-
  324    '$set_predicate_attribute'(Head, tabled, true),
  325    (   tabled_attribute(Attr),
  326        get_dict(Attr, Options, Value),
  327        '$set_predicate_attribute'(Head, Attr, Value),
  328        fail
  329    ;   current_prolog_flag(table_monotonic, lazy),
  330        '$set_predicate_attribute'(Head, lazy, true),
  331        fail
  332    ;   true
  333    ).
  334
  335tabled_attribute(incremental).
  336tabled_attribute(dynamic).
  337tabled_attribute(tshared).
  338tabled_attribute(max_answers).
  339tabled_attribute(subgoal_abstract).
  340tabled_attribute(answer_abstract).
  341tabled_attribute(monotonic).
  342tabled_attribute(opaque).
  343tabled_attribute(lazy).

 start_tabling(:Closure, :Wrapper, :Implementation)

Execute Implementation using tabling. This predicate should not be called directly. The table/1 directive causes a predicate to be translated into a renamed implementation and a wrapper that involves this predicate.

Arguments:

Closure

- is the wrapper closure to find the predicate quickly. It is also allowed to pass nothing. In that cases the predicate is looked up using Wrapper. We suggest to pass 0 in this case.

Compatibility

- This interface may change or disappear without notice from future versions.

  359start_tabling(Closure, Wrapper, Worker) :-
  360    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton, IsMono),
  361    (   IsMono == true
  362    ->  shift(dependency(Skeleton, Trie, Mono)),
  363        (   Mono == true
  364        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  365        ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  366        )
  367    ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  368    ).
  369
  370start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
  371    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  372    (   Status == complete
  373    ->  trie_gen_compiled(Trie, Skeleton)
  374    ;   functor(Status, fresh, 2)
  375    ->  catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
  376              deadlock,
  377              restart_tabling(Closure, Wrapper, Worker))
  378    ;   Status == invalid
  379    ->  reeval(Trie, Wrapper, Skeleton)
  380    ;   % = run_follower, but never fresh and Status is a worklist
  381        shift_for_copy(call_info(Skeleton, Status))
  382    ).
  383
  384create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
  385    tdebug(Fresh = fresh(SCC, WorkList)),
  386    tdebug(wl_goal(WorkList, Goal, _)),
  387    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  388    setup_call_catcher_cleanup(
  389        '$idg_set_current'(OldCurrent, Trie),
  390        run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
  391        Catcher,
  392        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  393    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  394    done_leader(LStatus, Fresh, Skeleton, Clause).

 restart_tabling(+Closure, +Wrapper, +Worker)

We were aborted due to a deadlock. Simply retry. We sleep a very tiny amount to give the thread against which we have deadlocked the opportunity to grab our table. Without, it is common that we re-grab the table within our time slice and before the kernel managed to wakeup the other thread.

  404restart_tabling(Closure, Wrapper, Worker) :-
  405    tdebug(user_goal(Wrapper, Goal)),
  406    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  407    sleep(0.000001),
  408    start_tabling(Closure, Wrapper, Worker).
  409
  410restart_abstract_tabling(Closure, Wrapper, Worker) :-
  411    tdebug(user_goal(Wrapper, Goal)),
  412    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  413    sleep(0.000001),
  414    start_abstract_tabling(Closure, Wrapper, Worker).

 start_subsumptive_tabling(:Closure, :Wrapper, :Implementation)

(*) We should not use trie_gen_compiled/2 here as this will enumerate all answers while '$tbl_answer_update_dl'/2 uses the available trie indexing to only fetch the relevant answer(s).

To be done

- In the end '$tbl_answer_update_dl'/2 is problematic with incremental and shared tabling as we do not get the consistent update view from the compiled result.

  426start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  427    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  428    ->  (   Status == complete
  429        ->  trie_gen_compiled(Trie, Skeleton)
  430        ;   Status == invalid
  431        ->  reeval(Trie, Wrapper, Skeleton),
  432            trie_gen_compiled(Trie, Skeleton)
  433        ;   shift_for_copy(call_info(Skeleton, Status))
  434        )
  435    ;   more_general_table(Wrapper, ATrie),
  436        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  437    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  438    ;   more_general_table(Wrapper, ATrie),
  439        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  440    ->  (   Status == invalid
  441        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  442            Wrapper = GenWrapper,
  443            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  444        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  445            shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  446            unify_subsumptive(Skeleton, GenSkeleton)
  447        )
  448    ;   start_tabling(Closure, Wrapper, Worker)
  449    ).

 wrapper_skeleton(+GenWrapper, +GenSkeleton, +Wrapper, -Skeleton)

Skeleton is a specialized version of GenSkeleton for the subsumed new consumer.

  456wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  457    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  458    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  459           [GenSkeleton+Skeleton]).
  460
  461unify_subsumptive(X,X).

 start_abstract_tabling(:Closure, :Wrapper, :Worker)

Deal with table p/1 as subgoal_abstract(N). This is a merge between variant and subsumptive tabling. If the goal is not abstracted this is simple variant tabling. If the goal is abstracted we must solve the more general goal and use answers from the abstract table.

Wrapper is e.g., user:p(s(s(s(X))),Y) Worker is e.g., call(<closure>(p/2)(s(s(s(X))),Y))

  474start_abstract_tabling(Closure, Wrapper, Worker) :-
  475    '$tbl_abstract_table'(Closure, Wrapper, Trie, _Abstract, Status, Skeleton),
  476    tdebug(abstract, 'Wrapper=~p, Worker=~p, Skel=~p',
  477           [Wrapper, Worker, Skeleton]),
  478    (   is_most_general_term(Skeleton)           % TBD: Fill and test Abstract
  479    ->  start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  480    ;   Status == complete
  481    ->  '$tbl_answer_update_dl'(Trie, Skeleton)
  482    ;   functor(Status, fresh, 2)
  483    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  484        abstract_worker(Worker, GenWrapper, GenWorker),
  485        catch(create_abstract_table(Trie, Status, Skeleton, GenSkeleton, GenWrapper,
  486                                    GenWorker),
  487              deadlock,
  488              restart_abstract_tabling(Closure, Wrapper, Worker))
  489    ;   Status == invalid
  490    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  491        reeval(ATrie, GenWrapper, GenSkeleton),
  492        Wrapper = GenWrapper,
  493        '$tbl_answer_update_dl'(ATrie, Skeleton)
  494    ;   shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  495        unify_subsumptive(Skeleton, GenSkeleton)
  496    ).
  497
  498create_abstract_table(Trie, Fresh, Skeleton, GenSkeleton, Wrapper, Worker) :-
  499    tdebug(Fresh = fresh(SCC, WorkList)),
  500    tdebug(wl_goal(WorkList, Goal, _)),
  501    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  502    setup_call_catcher_cleanup(
  503        '$idg_set_current'(OldCurrent, Trie),
  504        run_leader(GenSkeleton, Worker, Fresh, LStatus, _Clause),
  505        Catcher,
  506        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  507    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  508    Skeleton = GenSkeleton,
  509    done_abstract_leader(LStatus, Fresh, GenSkeleton, Trie).
  510
  511abstract_worker(_:call(Term), _M:GenWrapper, call(GenTerm)) :-
  512    functor(Term, Closure, _),
  513    GenWrapper =.. [_|Args],
  514    GenTerm =.. [Closure|Args].
  515
  516:- '$hide'((done_abstract_leader/4)).  517
  518done_abstract_leader(complete, _Fresh, Skeleton, Trie) :-
  519    !,
  520    '$tbl_answer_update_dl'(Trie, Skeleton).
  521done_abstract_leader(final, fresh(SCC, _Worklist), Skeleton, Trie) :-
  522    !,
  523    '$tbl_free_component'(SCC),
  524    '$tbl_answer_update_dl'(Trie, Skeleton).
  525done_abstract_leader(_,_,_,_).

 done_leader(+Status, +Fresh, +Skeleton, -Clause)

Called on completion of a table. Possibly destroys the component and generates the answers from the complete table. The last cases deals with leaders that are merged into a higher SCC (and thus no longer a leader).

  534:- '$hide'((done_leader/4, finished_leader/4)).  535
  536done_leader(complete, _Fresh, Skeleton, Clause) :-
  537    !,
  538    trie_gen_compiled(Clause, Skeleton).
  539done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  540    !,
  541    '$tbl_free_component'(SCC),
  542    trie_gen_compiled(Clause, Skeleton).
  543done_leader(_,_,_,_).
  544
  545finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  546    '$idg_set_current'(OldCurrent),
  547    (   Catcher == exit
  548    ->  true
  549    ;   Catcher == fail
  550    ->  true
  551    ;   Catcher = exception(_)
  552    ->  Fresh = fresh(SCC, _),
  553        '$tbl_table_discard_all'(SCC)
  554    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  555    ).

 run_leader(+Skeleton, +Worker, +Fresh, -Status, -Clause) is det

Run the leader of a (new) SCC, storing instantiated copies of Wrapper into Trie. Status is the status of the SCC when this predicate terminates. It is one of complete, in which case local completion finished or merged if running the completion finds an open (not completed) active goal that resides in a parent component. In this case, this SCC has been merged with this parent.

If the SCC is merged, the answers it already gathered are added to the worklist and we shift (suspend), turning our leader into an internal node for the upper SCC.

  570run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  571    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  572    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  573    activate(Skeleton, Worker, Worklist),
  574    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  575    completion(SCC, Status, Clause),
  576    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  577    (   Status == merged
  578    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  579        '$tbl_wkl_make_follower'(Worklist),
  580        shift_for_copy(call_info(Skeleton, Worklist))
  581    ;   true                                    % completed
  582    ).
  583
  584activate(Skeleton, Worker, WorkList) :-
  585    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  586    (   reset_delays,
  587        delim(Skeleton, Worker, WorkList, []),
  588        fail
  589    ;   true
  590    ).

 delim(+Skeleton, +Worker, +WorkList, +Delays)

Call WorkList and add all instances of Skeleton as answer to WorkList, conditional according to Delays.

Arguments:

Skeleton	- is the return skeleton (ret/N term)
Worker	- is either the (wrapped) tabled goal or a continuation
WorkList	- is the work list associated with Worker (or its continuation).
Delays	- is the current delay list. Note that the actual delay also include the internal global delay list. '$tbl_wkl_add_answer'/4 joins the two. For a dependency we join the two explicitly.

  606delim(Skeleton, Worker, WorkList, Delays) :-
  607    reset(Worker, SourceCall, Continuation),
  608    tdebug(wl_goal(WorkList, Goal, _)),
  609    (   Continuation == 0
  610    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  611        tdebug(delay_goals(AllDelays, Cond)),
  612        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  613               [Skeleton, Goal, Cond]),
  614        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  615        Complete == !,
  616        !
  617    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  618    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  619        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  620        tdebug(wl_goal(WorkList, DstGoal, _)),
  621        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  622        '$tbl_wkl_add_suspension'(
  623            SourceWL,
  624            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  625    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  626    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  627        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  628        tdebug(wl_goal(WorkList, DstGoal, _)),
  629        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  630        '$tbl_wkl_add_suspension'(
  631            SourceWL,
  632            InstSkeleton,
  633            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  634    ;   '$tbl_wkl_table'(WorkList, ATrie),
  635        mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
  636    ->  delim(Skeleton, Continuation, WorkList, Delays)
  637    ).

 start_moded_tabling(+Closure, :Wrapper, :Implementation, +Variant, +ModeArgs)

As start_tabling/2, but in addition separates the data stored in the answer trie in the Variant and ModeArgs.

  644'$moded_wrap_tabled'(Head, Options, ModeTest, WrapperNoModes, ModeArgs) :-
  645    set_pattributes(Head, Options),
  646    '$wrap_predicate'(Head, table, Closure, Wrapped,
  647                      (   ModeTest,
  648                          start_moded_tabling(Closure, Head, Wrapped,
  649                                              WrapperNoModes, ModeArgs)
  650                      )).
  651
  652
  653start_moded_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  654    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie,
  655                               Status, Skeleton, IsMono),
  656    (   IsMono == true
  657    ->  shift(dependency(Skeleton/ModeArgs, Trie, Mono)),
  658        (   Mono == true
  659        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  660        ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  661                                  Trie, Status, Skeleton)
  662        )
  663    ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  664                              Trie, Status, Skeleton)
  665    ).
  666
  667start_moded_tabling_2(_Closure, Wrapper, Worker, ModeArgs,
  668                      Trie, Status, Skeleton) :-
  669    (   Status == complete
  670    ->  moded_gen_answer(Trie, Skeleton, ModeArgs)
  671    ;   functor(Status, fresh, 2)
  672    ->  setup_call_catcher_cleanup(
  673            '$idg_set_current'(OldCurrent, Trie),
  674            moded_run_leader(Wrapper, Skeleton/ModeArgs,
  675                             Worker, Status, LStatus),
  676            Catcher,
  677            finished_leader(OldCurrent, Catcher, Status, Wrapper)),
  678        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  679               [Wrapper, ModeArgs, LStatus]),
  680        moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
  681    ;   Status == invalid
  682    ->  reeval(Trie, Wrapper, Skeleton),
  683        moded_gen_answer(Trie, Skeleton, ModeArgs)
  684    ;   % = run_follower, but never fresh and Status is a worklist
  685        shift_for_copy(call_info(Skeleton/ModeArgs, Status))
  686    ).
  687
  688:- public
  689    moded_gen_answer/3.                         % XSB tables.pl
  690
  691moded_gen_answer(Trie, Skeleton, ModedArgs) :-
  692    trie_gen(Trie, Skeleton),
  693    '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
  694
  695'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
  696    trie_gen(ATrie, Skeleton),
  697    '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
  698
  699moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
  700    !,
  701    moded_gen_answer(Trie, Skeleton, ModeArgs).
  702moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
  703    !,
  704    '$tbl_free_component'(SCC),
  705    moded_gen_answer(Trie, Skeleton, ModeArgs).
  706moded_done_leader(_, _, _, _, _).
  707
  708moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
  709    tdebug(wl_goal(Worklist, Goal, _)),
  710    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  711    moded_activate(SkeletonMA, Worker, Worklist),
  712    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  713    completion(SCC, Status, _Clause),           % TBD: propagate
  714    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  715    (   Status == merged
  716    ->  tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
  717        '$tbl_wkl_make_follower'(Worklist),
  718        shift_for_copy(call_info(SkeletonMA, Worklist))
  719    ;   true                                    % completed
  720    ).
  721
  722moded_activate(SkeletonMA, Worker, WorkList) :-
  723    (   reset_delays,
  724        delim(SkeletonMA, Worker, WorkList, []),
  725        fail
  726    ;   true
  727    ).

 update(+Flags, +Head, +Module, +A1, +A2, -A3, -Action) is semidet

Update the aggregated value for an answer. Iff this predicate succeeds, the aggregated value is updated to A3. If Del is unified with true, A1 should be deleted.

Arguments:

Flags	- is a bit mask telling which of A1 and A2 are unconditional
Head	- is the head of the predicate
Module	- is the module of the predicate
A1	- is the currently aggregated value
A2	- is the newly produced value
Action	- is one of delete to replace the old answer with the new keep to keep the old answer and add the new done to stop the update process

  745:- public
  746    update/7.  747
  748% both unconditional
  749update(0b11, Wrapper, M, Agg, New, Next, delete) :-
  750    !,
  751    M:'$table_update'(Wrapper, Agg, New, Next),
  752    Agg \=@= Next.
  753% old unconditional, new conditional
  754update(0b10, Wrapper, M, Agg, New, Next, keep) :-
  755    !,
  756    M:'$table_update'(Wrapper, Agg, New, Next0),
  757    (   Next0 =@= Agg
  758    ->  Next = Agg
  759    ;   Next = Next0
  760    ).
  761% old conditional, new unconditional,
  762update(0b01, Wrapper, M, Agg, New, Next, keep) :-
  763    !,
  764    M:'$table_update'(Wrapper, New, Agg, Next0),
  765    (   Next0 =@= Agg
  766    ->  Next = Agg
  767    ;   Next = Next0
  768    ).
  769% both conditional
  770update(0b00, _Wrapper, _M, _Agg, New, New, keep) :-
  771    !.

 completion(+Component, -Status, -Clause) is det

Wakeup suspended goals until no new answers are generated. Status is one of merged, completed or final. If Status is not merged, Clause is a compiled representation for the answer trie of the Component leader.

  780completion(SCC, Status, Clause) :-
  781    (   reset_delays,
  782        completion_(SCC),
  783        fail
  784    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  785        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  786    ).
  787
  788completion_(SCC) :-
  789    repeat,
  790    (   '$tbl_pop_worklist'(SCC, WorkList)
  791    ->  tdebug(wl_goal(WorkList, Goal, _)),
  792        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  793        completion_step(WorkList)
  794    ;   !
  795    ).

 $tbl_wkl_work(+WorkList, -Answer, -Continuation, -Wrapper, -TargetWorklist, -Delays) is nondet

True when Continuation needs to run with Answer and possible answers need to be added to TargetWorklist. The remaining arguments are there to restore variable bindings and restore the delay list.

The suspension added by '$tbl_wkl_add_suspension'/2 is a term dependency(SrcWrapper, Continuation, Wrapper, WorkList, Delays). Note that:

• Answer and Goal must be unified to rebind the input arguments for the continuation.
• Wrapper is stored in TargetWorklist on successful completion of the Continuation.
• If Answer Subsumption is in effect, the story is a bit more complex and ModeArgs provide the binding over which we do aggregation. Otherwise, ModeArgs is the the reserved trie node produced by '$tbl_trienode'/1.

Arguments:

Answer	- is the answer term from the answer cluster (node in the answer trie). For answer subsumption it is a term Ret/ModeArgs
Goal	- to Delays are extracted from the dependency/5 term in the same order.

  826completion_step(SourceWL) :-
  827    '$tbl_wkl_work'(SourceWL,
  828                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  829    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  830    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  831    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  832    tdebug(delay_goals(AllDelays, Cond)),
  833    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  834           [TargetGoal, SourceGoal, Answer, Cond]),
  835    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  836    fail.
  837
  838
  839		 /*******************************
  840		 *     STRATIFIED NEGATION	*
  841		 *******************************/

 tnot(:Goal)

Tabled negation.

(*): Only variant tabling is allowed under tnot/1.

  849tnot(Goal0) :-
  850    '$tnot_implementation'(Goal0, Goal),        % verifies Goal is tabled
  851    (   '$tbl_existing_variant_table'(_, Goal, Trie, Status, Skeleton),
  852        Status \== invalid
  853    ->  '$idg_add_edge'(Trie),
  854        (   '$tbl_answer_dl'(Trie, _, true)
  855        ->  fail
  856        ;   '$tbl_answer_dl'(Trie, _, _)
  857        ->  tdebug(tnot, 'tnot: adding ~p to delay list', [Goal]),
  858            add_delay(Trie)
  859        ;   Status == complete
  860        ->  true
  861        ;   negation_suspend(Goal, Skeleton, Status)
  862        )
  863    ;   tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  864        (   '$wrapped_implementation'(Goal, table, Implementation), % see (*)
  865            functor(Implementation, Closure, _),
  866            start_tabling(Closure, Goal, Implementation),
  867            fail
  868        ;   '$tbl_existing_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
  869            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  870            (   '$tbl_answer_dl'(Trie, _, true)
  871            ->  fail
  872            ;   '$tbl_answer_dl'(Trie, _, _)
  873            ->  add_delay(Trie)
  874            ;   NewStatus == complete
  875            ->  true
  876            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  877            )
  878        )
  879    ).
  880
  881floundering(Goal) :-
  882    format(string(Comment), 'Floundering goal in tnot/1: ~p', [Goal]),
  883    throw(error(instantiation_error, context(_Stack, Comment))).

 negation_suspend(+Goal, +Skeleton, +Worklist)

Suspend Worklist due to negation. This marks the worklist as dealing with a negative literal and suspend.

The completion step will resume negative worklists that have no solutions, causing this to succeed.

  894negation_suspend(Wrapper, Skeleton, Worklist) :-
  895    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  896    '$tbl_wkl_negative'(Worklist),
  897    shift_for_copy(call_info(Skeleton, tnot(Worklist))),
  898    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  899    '$tbl_wkl_is_false'(Worklist).

 not_exists(:P) is semidet

Tabled negation for non-ground goals. This predicate uses the tabled meta-predicate tabled_call/1. The tables for tabled_call/1 must be cleared if `the world changes' as well as to avoid aggregating too many variants.

  908not_exists(Goal) :-
  909    ground(Goal),
  910    '$get_predicate_attribute'(Goal, tabled, 1),
  911    !,
  912    tnot(Goal).
  913not_exists(Goal) :-
  914    (   tabled_call(Goal), fail
  915    ;   tnot(tabled_call(Goal))
  916    ).
  917
  918		 /*******************************
  919		 *           DELAY LISTS	*
  920		 *******************************/
  921
  922add_delay(Delay) :-
  923    '$tbl_delay_list'(DL0),
  924    '$tbl_set_delay_list'([Delay|DL0]).
  925
  926reset_delays :-
  927    '$tbl_set_delay_list'([]).

 $wfs_call(:Goal, :Delays)

Call Goal and provide WFS delayed goals as a conjunction in Delays. This predicate is the internal version of call_delays/2 from library(wfs).

  935'$wfs_call'(Goal, M:Delays) :-
  936    '$tbl_delay_list'(DL0),
  937    reset_delays,
  938    call(Goal),
  939    '$tbl_delay_list'(DL1),
  940    (   delay_goals(DL1, M, Delays)
  941    ->  true
  942    ;   Delays = undefined
  943    ),
  944    '$append'(DL0, DL1, DL),
  945    '$tbl_set_delay_list'(DL).
  946
  947delay_goals([], _, true) :-
  948    !.
  949delay_goals([AT+AN|T], M, Goal) :-
  950    !,
  951    (   integer(AN)
  952    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  953        (   '$tbl_is_trienode'(Moded)
  954        ->  trie_term(AN, Answer)
  955        ;   true                        % TBD: Generated moded answer
  956        )
  957    ;   AN = Skeleton/ModeArgs
  958    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  959        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  960        G0 = M1:G0plain
  961    ;   '$tbl_table_status'(AT, _, G0, AN)
  962    ),
  963    GN = G0,
  964    (   T == []
  965    ->  Goal = GN
  966    ;   Goal = (GN,GT),
  967        delay_goals(T, M, GT)
  968    ).
  969delay_goals([AT|T], M, Goal) :-
  970    atrie_goal(AT, G0),
  971    unqualify_goal(G0, M, G1),
  972    GN = tnot(G1),
  973    (   T == []
  974    ->  Goal = GN
  975    ;   Goal = (GN,GT),
  976        delay_goals(T, M, GT)
  977    ).
  978
  979at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
  980    is_trie(Trie),
  981    !,
  982    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
  983at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
  984    is_trie(Trie),
  985    !,
  986    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
  987    M2:'$table_mode'(Goal0, Variant, Moded),
  988    unqualify_goal(M2:Goal0, M, Goal).
  989
  990atrie_goal(Trie, M:Goal) :-
  991    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
  992    M:'$table_mode'(Goal, Variant, _Moded).
  993
  994unqualify_goal(M:Goal, M, Goal0) :-
  995    !,
  996    Goal0 = Goal.
  997unqualify_goal(Goal, _, Goal).
  998
  999
 1000                 /*******************************
 1001                 *            CLEANUP           *
 1002                 *******************************/

 abolish_all_tables

Remove all tables. This is normally used to free up the space or recompute the result after predicates on which the result for some tabled predicates depend.

Abolishes both local and shared tables. Possibly incomplete tables are marked for destruction upon completion. The dependency graphs for incremental and monotonic tabling are reclaimed as well.

 1014abolish_all_tables :-
 1015    (   '$tbl_abolish_local_tables'
 1016    ->  true
 1017    ;   true
 1018    ),
 1019    (   '$tbl_variant_table'(VariantTrie),
 1020        trie_gen(VariantTrie, _, Trie),
 1021        '$tbl_destroy_table'(Trie),
 1022        fail
 1023    ;   true
 1024    ).
 1025
 1026abolish_private_tables :-
 1027    (   '$tbl_abolish_local_tables'
 1028    ->  true
 1029    ;   (   '$tbl_local_variant_table'(VariantTrie),
 1030            trie_gen(VariantTrie, _, Trie),
 1031            '$tbl_destroy_table'(Trie),
 1032            fail
 1033        ;   true
 1034        )
 1035    ).
 1036
 1037abolish_shared_tables :-
 1038    (   '$tbl_global_variant_table'(VariantTrie),
 1039        trie_gen(VariantTrie, _, Trie),
 1040        '$tbl_destroy_table'(Trie),
 1041        fail
 1042    ;   true
 1043    ).

 abolish_table_subgoals(:Subgoal) is det

Abolish all tables that unify with SubGoal.

To be done

- : SubGoal must be callable. Should we allow for more general patterns?

 1052abolish_table_subgoals(SubGoal0) :-
 1053    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1054    !,
 1055    '$must_be'(acyclic, SubGoal),
 1056    (   '$tbl_variant_table'(VariantTrie),
 1057        trie_gen(VariantTrie, M:SubGoal, Trie),
 1058        '$tbl_destroy_table'(Trie),
 1059        fail
 1060    ;   true
 1061    ).
 1062abolish_table_subgoals(_).

 abolish_module_tables(+Module) is det

Abolish all tables for predicates associated with the given module.

 1068abolish_module_tables(Module) :-
 1069    '$must_be'(atom, Module),
 1070    '$tbl_variant_table'(VariantTrie),
 1071    current_module(Module),
 1072    !,
 1073    forall(trie_gen(VariantTrie, Module:_, Trie),
 1074           '$tbl_destroy_table'(Trie)).
 1075abolish_module_tables(_).

 abolish_nonincremental_tables is det

Abolish all tables that are not related to incremental predicates.

 1081abolish_nonincremental_tables :-
 1082    (   '$tbl_variant_table'(VariantTrie),
 1083        trie_gen(VariantTrie, _, Trie),
 1084        '$tbl_table_status'(Trie, Status, Goal, _),
 1085        (   Status == complete
 1086        ->  true
 1087        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1088        ),
 1089        \+ predicate_property(Goal, incremental),
 1090        '$tbl_destroy_table'(Trie),
 1091        fail
 1092    ;   true
 1093    ).

 abolish_nonincremental_tables(+Options)

Allow for skipping incomplete tables while abolishing.

To be done

- Mark tables for destruction such that they are abolished when completed.

 1102abolish_nonincremental_tables(Options) :-
 1103    (   Options = on_incomplete(Action)
 1104    ->  Action == skip
 1105    ;   '$option'(on_incomplete(skip), Options)
 1106    ),
 1107    !,
 1108    (   '$tbl_variant_table'(VariantTrie),
 1109        trie_gen(VariantTrie, _, Trie),
 1110        '$tbl_table_status'(Trie, complete, Goal, _),
 1111        \+ predicate_property(Goal, incremental),
 1112        '$tbl_destroy_table'(Trie),
 1113        fail
 1114    ;   true
 1115    ).
 1116abolish_nonincremental_tables(_) :-
 1117    abolish_nonincremental_tables.
 1118
 1119
 1120                 /*******************************
 1121                 *        EXAMINE TABLES        *
 1122                 *******************************/

 current_table(:Variant, -Trie) is nondet

True when Trie is the answer table for Variant. If Variant has an unbound module or goal, all possible answer tries are generated, otherwise Variant is considered a fully instantiated variant and the predicate is semidet.

 1131current_table(Variant, Trie) :-
 1132    ct_generate(Variant),
 1133    !,
 1134    current_table_gen(Variant, Trie).
 1135current_table(Variant, Trie) :-
 1136    current_table_lookup(Variant, Trie),
 1137    !.
 1138
 1139current_table_gen(M:Variant, Trie) :-
 1140    '$tbl_local_variant_table'(VariantTrie),
 1141    trie_gen(VariantTrie, M:NonModed, Trie),
 1142    M:'$table_mode'(Variant, NonModed, _Moded).
 1143current_table_gen(M:Variant, Trie) :-
 1144    '$tbl_global_variant_table'(VariantTrie),
 1145    trie_gen(VariantTrie, M:NonModed, Trie),
 1146    \+ '$tbl_table_status'(Trie, fresh), % shared tables are not destroyed
 1147    M:'$table_mode'(Variant, NonModed, _Moded).
 1148
 1149current_table_lookup(M:Variant, Trie) :-
 1150    M:'$table_mode'(Variant, NonModed, _Moded),
 1151    '$tbl_local_variant_table'(VariantTrie),
 1152    trie_lookup(VariantTrie, M:NonModed, Trie).
 1153current_table_lookup(M:Variant, Trie) :-
 1154    M:'$table_mode'(Variant, NonModed, _Moded),
 1155    '$tbl_global_variant_table'(VariantTrie),
 1156    trie_lookup(VariantTrie, NonModed, Trie),
 1157    \+ '$tbl_table_status'(Trie, fresh).
 1158
 1159ct_generate(M:Variant) :-
 1160    (   var(Variant)
 1161    ->  true
 1162    ;   var(M)
 1163    ).
 1164
 1165                 /*******************************
 1166                 *      WRAPPER GENERATION      *
 1167                 *******************************/
 1168
 1169:- multifile
 1170    system:term_expansion/2,
 1171    tabled/2. 1172:- dynamic
 1173    system:term_expansion/2. 1174
 1175wrappers(Spec, M) -->
 1176    { tabling_defaults(
 1177          [ (table_incremental=true)            - (incremental=true),
 1178            (table_shared=true)                 - (tshared=true),
 1179            (table_subsumptive=true)            - ((mode)=subsumptive),
 1180            call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
 1181          ],
 1182          #{}, Defaults)
 1183    },
 1184    wrappers(Spec, M, Defaults).
 1185
 1186wrappers(Var, _, _) -->
 1187    { var(Var),
 1188      !,
 1189      '$instantiation_error'(Var)
 1190    }.
 1191wrappers(M:Spec, _, Opts) -->
 1192    !,
 1193    { '$must_be'(atom, M) },
 1194    wrappers(Spec, M, Opts).
 1195wrappers(Spec as Options, M, Opts0) -->
 1196    !,
 1197    { table_options(Options, Opts0, Opts) },
 1198    wrappers(Spec, M, Opts).
 1199wrappers((A,B), M, Opts) -->
 1200    !,
 1201    wrappers(A, M, Opts),
 1202    wrappers(B, M, Opts).
 1203wrappers(Name//Arity, M, Opts) -->
 1204    { atom(Name), integer(Arity), Arity >= 0,
 1205      !,
 1206      Arity1 is Arity+2
 1207    },
 1208    wrappers(Name/Arity1, M, Opts).
 1209wrappers(Name/Arity, Module, Opts) -->
 1210    { '$option'(mode(TMode), Opts, variant),
 1211      atom(Name), integer(Arity), Arity >= 0,
 1212      !,
 1213      functor(Head, Name, Arity),
 1214      '$tbl_trienode'(Reserved)
 1215    },
 1216    qualify(Module,
 1217            [ '$tabled'(Head, TMode),
 1218              '$table_mode'(Head, Head, Reserved)
 1219            ]),
 1220    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1221    ].
 1222wrappers(ModeDirectedSpec, Module, Opts) -->
 1223    { '$option'(mode(TMode), Opts, variant),
 1224      callable(ModeDirectedSpec),
 1225      !,
 1226      functor(ModeDirectedSpec, Name, Arity),
 1227      functor(Head, Name, Arity),
 1228      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1229      updater_clauses(Modes, Head, UpdateClauses),
 1230      mode_check(Moded, ModeTest),
 1231      (   ModeTest == true
 1232      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1233          TVariant = Head
 1234      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, Opts, ModeTest,
 1235                                            Module:Variant, Moded),
 1236          TVariant = Variant
 1237      )
 1238    },
 1239    qualify(Module,
 1240            [ '$tabled'(Head, TMode),
 1241              '$table_mode'(Head, TVariant, Moded)
 1242            ]),
 1243    [ (:- initialization(WrapClause, now))
 1244    ],
 1245    qualify(Module, UpdateClauses).
 1246wrappers(TableSpec, _M, _Opts) -->
 1247    { '$type_error'(table_desclaration, TableSpec)
 1248    }.
 1249
 1250qualify(Module, List) -->
 1251    { prolog_load_context(module, Module) },
 1252    !,
 1253    clist(List).
 1254qualify(Module, List) -->
 1255    qlist(List, Module).
 1256
 1257clist([])    --> [].
 1258clist([H|T]) --> [H], clist(T).
 1259
 1260qlist([], _)    --> [].
 1261qlist([H|T], M) --> [M:H], qlist(T, M).
 1262
 1263
 1264tabling_defaults([], Dict, Dict).
 1265tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
 1266    (   tabling_default(Condition)
 1267    ->  Dict1 = Dict0.put(Opt,Value)
 1268    ;   Dict1 = Dict0
 1269    ),
 1270    tabling_defaults(T, Dict1, Dict).
 1271
 1272tabling_default(Flag=FValue) :-
 1273    !,
 1274    current_prolog_flag(Flag, FValue).
 1275tabling_default(call(Term)) :-
 1276    call(Term).
 1277
 1278% Called from wrappers//2.
 1279
 1280subgoal_size_restraint(Level) :-
 1281    current_prolog_flag(max_table_subgoal_size_action, abstract),
 1282    current_prolog_flag(max_table_subgoal_size, Level).

 table_options(+Options, +OptDictIn, -OptDictOut)

Handler the ... as options ... construct.

 1288table_options(Options, _Opts0, _Opts) :-
 1289    var(Options),
 1290    '$instantiation_error'(Options).
 1291table_options((A,B), Opts0, Opts) :-
 1292    !,
 1293    table_options(A, Opts0, Opts1),
 1294    table_options(B, Opts1, Opts).
 1295table_options(subsumptive, Opts0, Opts1) :-
 1296    !,
 1297    put_dict(mode, Opts0, subsumptive, Opts1).
 1298table_options(variant, Opts0, Opts1) :-
 1299    !,
 1300    put_dict(mode, Opts0, variant, Opts1).
 1301table_options(incremental, Opts0, Opts1) :-
 1302    !,
 1303    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1304table_options(monotonic, Opts0, Opts1) :-
 1305    !,
 1306    put_dict(monotonic, Opts0, true, Opts1).
 1307table_options(opaque, Opts0, Opts1) :-
 1308    !,
 1309    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1310table_options(lazy, Opts0, Opts1) :-
 1311    !,
 1312    put_dict(lazy, Opts0, true, Opts1).
 1313table_options(dynamic, Opts0, Opts1) :-
 1314    !,
 1315    put_dict(dynamic, Opts0, true, Opts1).
 1316table_options(shared, Opts0, Opts1) :-
 1317    !,
 1318    put_dict(tshared, Opts0, true, Opts1).
 1319table_options(private, Opts0, Opts1) :-
 1320    !,
 1321    put_dict(tshared, Opts0, false, Opts1).
 1322table_options(max_answers(Count), Opts0, Opts1) :-
 1323    !,
 1324    restraint(max_answers, Count, Opts0, Opts1).
 1325table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1326    !,
 1327    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1328table_options(answer_abstract(Size), Opts0, Opts1) :-
 1329    !,
 1330    restraint(answer_abstract, Size, Opts0, Opts1).
 1331table_options(Opt, _, _) :-
 1332    '$domain_error'(table_option, Opt).
 1333
 1334restraint(Name, Value0, Opts0, Opts) :-
 1335    '$table_option'(Value0, Value),
 1336    (   Value < 0
 1337    ->  Opts = Opts0
 1338    ;   put_dict(Name, Opts0, Value, Opts)
 1339    ).

 mode_check(+Moded, -TestCode)

Enforce the output arguments of a mode-directed tabled predicate to be unbound.

 1347mode_check(Moded, Check) :-
 1348    var(Moded),
 1349    !,
 1350    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1351mode_check(Moded, true) :-
 1352    '$tbl_trienode'(Moded),
 1353    !.
 1354mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1355    Moded =.. [s|Vars],
 1356    var_check(Vars, Test).
 1357
 1358var_check([H|T], Test) :-
 1359    (   T == []
 1360    ->  Test = var(H)
 1361    ;   Test = (var(H),Rest),
 1362        var_check(T, Rest)
 1363    ).
 1364
 1365:- public
 1366    instantiated_moded_arg/1. 1367
 1368instantiated_moded_arg(Vars) :-
 1369    '$member'(V, Vars),
 1370    \+ var(V),
 1371    '$uninstantiation_error'(V).

 extract_modes(+ModeSpec, +Head, -Variant, -Modes, -ModedAnswer) is det

Split Head into its variant and term that matches the moded arguments.

Arguments:

ModedAnswer

- is a term that captures that value of all moded arguments of an answer. If there is only one, this is the value itself. If there are multiple, this is a term s(A1,A2,...)

 1383extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1384    compound(ModeSpec),
 1385    !,
 1386    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1387    compound_name_arguments(Head, Name, HeadArgs),
 1388    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1389    length(ModedArgs, Count),
 1390    atomic_list_concat([$,Name,$,Count], VName),
 1391    Variant =.. [VName|VariantArgs],
 1392    (   ModedArgs == []
 1393    ->  '$tbl_trienode'(ModedAnswer)
 1394    ;   ModedArgs = [ModedAnswer]
 1395    ->  true
 1396    ;   ModedAnswer =.. [s|ModedArgs]
 1397    ).
 1398extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1399    atomic_list_concat([$,Atom,$,0], Variant),
 1400    '$tbl_trienode'(ModedAnswer).

 separate_args(+ModeSpecArgs, +HeadArgs, -NoModesArgs, -Modes, -ModeArgs) is det

Split the arguments in those that need to be part of the variant identity (NoModesArgs) and those that are aggregated (ModeArgs).

Arguments:

Args	- seems a copy of ModeArgs, why?

 1410separate_args([], [], [], [], []).
 1411separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1412    indexed_mode(HM),
 1413    !,
 1414    separate_args(TM, TA, TNA, Modes, TMA).
 1415separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1416    separate_args(TM, TA, TNA, Modes, TMA).
 1417
 1418indexed_mode(Mode) :-                           % XSB
 1419    var(Mode),
 1420    !.
 1421indexed_mode(index).                            % YAP
 1422indexed_mode(+).                                % B

 updater_clauses(+Modes, +Head, -Clauses)

Generates a clause to update the aggregated state. Modes is a list of predicate names we apply to the state.

 1429updater_clauses([], _, []) :- !.
 1430updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1431    update_goal(P, S0,S1,S2, Body).
 1432updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1433    length(Modes, Len),
 1434    functor(S0, s, Len),
 1435    functor(S1, s, Len),
 1436    functor(S2, s, Len),
 1437    S0 =.. [_|Args0],
 1438    S1 =.. [_|Args1],
 1439    S2 =.. [_|Args2],
 1440    update_body(Modes, Args0, Args1, Args2, true, Body).
 1441
 1442update_body([], _, _, _, Body, Body).
 1443update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1444    update_goal(P, A0,A1,A2, Goal),
 1445    mkconj(Body0, Goal, Body1),
 1446    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1447
 1448update_goal(Var, _,_,_, _) :-
 1449    var(Var),
 1450    !,
 1451    '$instantiation_error'(Var).
 1452update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1453    !,
 1454    '$must_be'(atom, M),
 1455    update_goal(lattice(PI), S0,S1,S2, Goal).
 1456update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1457    !,
 1458    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1459    '$must_be'(atom, Name),
 1460    Goal =.. [Name,S0,S1,S2].
 1461update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1462    compound(Head),
 1463    !,
 1464    compound_name_arity(Head, Name, Arity),
 1465    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1466    Goal =.. [Name,S0,S1,S2].
 1467update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1468    !,
 1469    '$must_be'(atom, Name),
 1470    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1471update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1472    !,
 1473    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1474    '$must_be'(atom, Name),
 1475    Call =.. [Name, S0, S1],
 1476    Goal = (Call -> S2 = S0 ; S2 = S1).
 1477update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1478    !,
 1479    '$must_be'(atom, M),
 1480    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1481    '$must_be'(atom, Name),
 1482    Call =.. [Name, S0, S1],
 1483    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1484update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1485    !,
 1486    '$must_be'(atom, M),
 1487    '$must_be'(atom, Name),
 1488    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1489update_goal(po(Name), S0,S1,S2, Goal) :-
 1490    !,
 1491    '$must_be'(atom, Name),
 1492    update_goal(po(Name/2), S0,S1,S2, Goal).
 1493update_goal(Alias, S0,S1,S2, Goal) :-
 1494    update_alias(Alias, Update),
 1495    !,
 1496    update_goal(Update, S0,S1,S2, Goal).
 1497update_goal(Mode, _,_,_, _) :-
 1498    '$domain_error'(tabled_mode, Mode).
 1499
 1500update_alias(first, lattice('$tabling':first/3)).
 1501update_alias(-,     lattice('$tabling':first/3)).
 1502update_alias(last,  lattice('$tabling':last/3)).
 1503update_alias(min,   lattice('$tabling':min/3)).
 1504update_alias(max,   lattice('$tabling':max/3)).
 1505update_alias(sum,   lattice('$tabling':sum/3)).
 1506
 1507mkconj(true, G,  G) :- !.
 1508mkconj(G1,   G2, (G1,G2)).
 1509
 1510
 1511		 /*******************************
 1512		 *          AGGREGATION		*
 1513		 *******************************/

 first(+S0, +S1, -S) is det

 last(+S0, +S1, -S) is det

 min(+S0, +S1, -S) is det

 max(+S0, +S1, -S) is det

 sum(+S0, +S1, -S) is det

Implement YAP tabling modes.

 1523:- public first/3, last/3, min/3, max/3, sum/3. 1524
 1525first(S, _, S).
 1526last(_, S, S).
 1527min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1528max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1529sum(S0, S1, S) :- S is S0+S1.
 1530
 1531
 1532		 /*******************************
 1533		 *      DYNAMIC PREDICATES	*
 1534		 *******************************/

 $set_table_wrappers(:Head)

Clear/add wrappers and notifications to trap dynamic predicates. This is required both for incremental and monotonic tabling.

 1541'$set_table_wrappers'(Pred) :-
 1542    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1543        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1544    ->  wrap_incremental(Pred)
 1545    ;   unwrap_incremental(Pred)
 1546    ),
 1547    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1548    ->  wrap_monotonic(Pred)
 1549    ;   unwrap_monotonic(Pred)
 1550    ).
 1551
 1552		 /*******************************
 1553		 *       MONOTONIC TABLING	*
 1554		 *******************************/

 mon_assert_dep(+Dependency, +Continuation, +Skel, +ATrie) is det

Create a dependency for monotonic tabling. Skel and ATrie are the target trie for solutions of Continuation.

 1561mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1562    '$idg_add_mono_dyn_dep'(Dynamic,
 1563                            dependency(Dynamic, Cont, Skel),
 1564                            ATrie).
 1565mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1566    '$idg_add_monotonic_dep'(SrcTrie,
 1567                             dependency(SrcSkel, IsMono, Cont, Skel),
 1568                             ATrie).

 monotonic_affects(+SrcTrie, +SrcReturn, -IsMono, -Continuation, -Return, -Atrie)

Dependency between two monotonic tables. If SrcReturn is added to SrcTrie we must add all answers for Return of Continuation to Atrie. IsMono shares with Continuation and is used in start_tabling/3 to distinguish normal tabled call from propagation.

 1578monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1579    '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1580                              dependency(SrcSkel, IsMono, Cont, Skel)).

 monotonic_dyn_affects(:Head, -Continuation, -Return, -ATrie)

Dynamic predicate that maintains the dependency from a monotonic

 1586monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1587    dyn_affected(Head, DTrie),
 1588    '$idg_mono_affects_eager'(DTrie, ATrie,
 1589                              dependency(Head, Cont, Skel)).

 wrap_monotonic(:Head)

Prepare the dynamic predicate Head for monotonic tabling. This traps calls to build the dependency graph and updates to propagate answers from new clauses through the dependency graph.

 1597wrap_monotonic(Head) :-
 1598    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1599                      '$start_monotonic'(Head, Wrapped)),
 1600    '$pi_head'(PI, Head),
 1601    prolog_listen(PI, monotonic_update).

 unwrap_monotonic(+Head)

Remove the monotonic wrappers and dependencies.

 1607unwrap_monotonic(Head) :-
 1608    '$pi_head'(PI, Head),
 1609    (   unwrap_predicate(PI, monotonic)
 1610    ->  prolog_unlisten(PI, monotonic_update)
 1611    ;   true
 1612    ).

 $start_monotonic(+Head, +Wrapped)

This is called the monotonic wrapper around a dynamic predicate to collect the dependencies between the dynamic predicate and the monotonic tabled predicates.

 1620'$start_monotonic'(Head, Wrapped) :-
 1621    (   '$tbl_collect_mono_dep'
 1622    ->  shift(dependency(Head)),
 1623        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1624        Wrapped,
 1625        tdebug(monotonic, '  --> ~p', [Head])
 1626    ;   Wrapped
 1627    ).

 monotonic_update(+Action, +ClauseRef)

Trap changes to the monotonic dynamic predicate and forward them.

 1633:- public monotonic_update/2. 1634monotonic_update(Action, ClauseRef) :-
 1635    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1636    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1637        mon_propagate(Action, Head, ClauseRef)
 1638    ;   true
 1639    ).