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-2025, 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)).  118:- set_prolog_flag(optimise_debug, false).  119:- autoload(library(debug), [debug/3, debugging/1]).  120
  121wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
  122    !,
  123    '$tbl_wkl_table'(WorkList, ATrie),
  124    trie_goal(ATrie, Goal, Skeleton).
  125wl_goal(WorkList, Goal, Skeleton) :-
  126    '$tbl_wkl_table'(WorkList, ATrie),
  127    trie_goal(ATrie, Goal, Skeleton).
  128
  129trie_goal(ATrie, Goal, Skeleton) :-
  130    '$tbl_table_status'(ATrie, _Status, M:Variant, Skeleton),
  131    (   M:'$table_mode'(Goal0, Variant, _Moded)
  132    ->  true
  133    ;   Goal0 = Variant                 % dynamic IDG nodes
  134    ),
  135    unqualify_goal(M:Goal0, user, Goal).
  136
  137delay_goals(List, Goal) :-
  138    delay_goals(List, user, Goal).
  139
  140user_goal(Goal, UGoal) :-
  141    unqualify_goal(Goal, user, UGoal).
  142
  143:- multifile
  144    prolog:portray/1.  145
  146user:portray(ATrie) :-
  147    '$is_answer_trie'(ATrie, _),
  148    trie_goal(ATrie, Goal, _Skeleton),
  149    (   '$idg_falsecount'(ATrie, FalseCount)
  150    ->  (   '$idg_forced'(ATrie)
  151        ->  format('~q [fc=~d/F] for ~p', [ATrie, FalseCount, Goal])
  152        ;   format('~q [fc=~d] for ~p', [ATrie, FalseCount, Goal])
  153        )
  154    ;   format('~q for ~p', [ATrie, Goal])
  155    ).
  156user:portray(Cont) :-
  157    compound(Cont),
  158    compound_name_arguments(Cont, '$cont$', [_Context, Clause, PC | Args]),
  159    clause_property(Clause, file(File)),
  160    file_base_name(File, Base),
  161    clause_property(Clause, line_count(Line)),
  162    clause_property(Clause, predicate(PI)),
  163    format('~q at ~w:~d @PC=~w, ~p', [PI, Base, Line, PC, Args]).
  164
  165:- 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.

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

 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.

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

  326set_pattributes(Head, Options) :-
  327    '$set_predicate_attribute'(Head, tabled, true),
  328    (   tabled_attribute(Attr),
  329        get_dict(Attr, Options, Value),
  330        '$set_predicate_attribute'(Head, Attr, Value),
  331        fail
  332    ;   current_prolog_flag(table_monotonic, lazy),
  333        '$set_predicate_attribute'(Head, lazy, true),
  334        fail
  335    ;   true
  336    ).
  337
  338tabled_attribute(incremental).
  339tabled_attribute(dynamic).
  340tabled_attribute(tshared).
  341tabled_attribute(max_answers).
  342tabled_attribute(subgoal_abstract).
  343tabled_attribute(answer_abstract).
  344tabled_attribute(monotonic).
  345tabled_attribute(opaque).
  346tabled_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.

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

  407restart_tabling(Closure, Wrapper, Worker) :-
  408    tdebug(user_goal(Wrapper, Goal)),
  409    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  410    sleep(0.000001),
  411    start_tabling(Closure, Wrapper, Worker).
  412
  413restart_abstract_tabling(Closure, Wrapper, Worker) :-
  414    tdebug(user_goal(Wrapper, Goal)),
  415    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  416    sleep(0.000001),
  417    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.

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

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

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

  459wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  460    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  461    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  462           [GenSkeleton+Skeleton]).
  463
  464unify_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))

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

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

 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.

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

 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.

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

 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.

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

 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

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

 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.

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

 $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.

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

 tnot(:Goal)

Tabled negation.

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

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

  897negation_suspend(Wrapper, Skeleton, Worklist) :-
  898    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  899    '$tbl_wkl_negative'(Worklist),
  900    shift_for_copy(call_info(Skeleton, tnot(Worklist))),
  901    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  902    '$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.

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

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

 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.

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

 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?

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

 abolish_module_tables(+Module) is det

Abolish all tables for predicates associated with the given module.

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

 abolish_nonincremental_tables is det

Abolish all tables that are not related to incremental predicates.

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

 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.

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

 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.

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

 table_options(+Options, +OptDictIn, -OptDictOut)

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

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

 mode_check(+Moded, -TestCode)

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

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

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

 1413separate_args([], [], [], [], []).
 1414separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1415    indexed_mode(HM),
 1416    !,
 1417    separate_args(TM, TA, TNA, Modes, TMA).
 1418separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1419    separate_args(TM, TA, TNA, Modes, TMA).
 1420
 1421indexed_mode(Mode) :-                           % XSB
 1422    var(Mode),
 1423    !.
 1424indexed_mode(index).                            % YAP
 1425indexed_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.

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

 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.

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

 $set_table_wrappers(:Head)

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

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

 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.

 1564mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1565    '$idg_add_mono_dyn_dep'(Dynamic,
 1566                            dependency(Dynamic, Cont, Skel),
 1567                            ATrie).
 1568mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1569    '$idg_add_monotonic_dep'(SrcTrie,
 1570                             dependency(SrcSkel, IsMono, Cont, Skel),
 1571                             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.

 1581monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1582    '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1583                              dependency(SrcSkel, IsMono, Cont, Skel)).

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

Dynamic predicate that maintains the dependency from a monotonic

 1589monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1590    dyn_affected(Head, DTrie),
 1591    '$idg_mono_affects_eager'(DTrie, ATrie,
 1592                              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.

 1600wrap_monotonic(Head) :-
 1601    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1602                      '$start_monotonic'(Head, Wrapped)),
 1603    '$pi_head'(PI, Head),
 1604    prolog_listen(PI, monotonic_update).

 unwrap_monotonic(+Head)

Remove the monotonic wrappers and dependencies.

 1610unwrap_monotonic(Head) :-
 1611    '$pi_head'(PI, Head),
 1612    (   unwrap_predicate(PI, monotonic)
 1613    ->  prolog_unlisten(PI, monotonic_update)
 1614    ;   true
 1615    ).

 $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.

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