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_declaration, 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    ->  '$idg_add_edge'(Trie),
  432        mon_consumer(Wrapper, Trie, Skeleton,
  433                     start_tabling_2(Closure, Wrapper, Worker,
  434                                     Trie, Status, Skeleton))
  435    ;   more_general_table(Wrapper, ATrie),
  436        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  437    ->  '$idg_add_edge'(ATrie),
  438        mon_consumer(Wrapper, ATrie, Skeleton,
  439                     '$tbl_answer_update_dl'(ATrie, Skeleton)) % see (*)
  440    ;   more_general_table(Wrapper, ATrie),
  441        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  442    ->  (   Status == invalid
  443        ->  forall(reeval(ATrie, GenWrapper, GenSkeleton), true),
  444            start_subsumptive_tabling(Closure, Wrapper, Worker)
  445        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  446            mon_consumer(Wrapper, ATrie, Skeleton,
  447                         ( shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  448                           unify_subsumptive(Skeleton, GenSkeleton)
  449                         ))
  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).

 mon_consumer(+Wrapper, +Trie, +Skeleton, :Goal)

Call Goal, which produces the answers of Trie that unify with Skeleton, for a call to Wrapper that is answered from an existing table: an existing variant of a subsumptive call, a more general table or an abstract table. If Wrapper is monotonic and we collect monotonic dependencies, first record that the caller depends on Trie, as start_tabling/3 does for a variant table, so that answers propagated to Trie later also reach the caller. Skeleton may be more specific than the answers of Trie. Propagation unifies it with each new answer, passing only the answers this call can use.

  478mon_consumer(Wrapper, Trie, Skeleton, Goal) :-
  479    '$get_predicate_attribute'(Wrapper, monotonic, 1),
  480    '$tbl_collect_mono_dep',
  481    !,
  482    shift(dependency(Skeleton, Trie, Mono)),
  483    (   Mono == true
  484    ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  485    ;   call(Goal)
  486    ).
  487mon_consumer(_, _, _, Goal) :-
  488    call(Goal).

 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))

  501start_abstract_tabling(Closure, Wrapper, Worker) :-
  502    '$tbl_abstract_table'(Closure, Wrapper, Trie, _Abstract, Status, Skeleton),
  503    tdebug(abstract, 'Wrapper=~p, Worker=~p, Skel=~p',
  504           [Wrapper, Worker, Skeleton]),
  505    mon_consumer(Wrapper, Trie, Skeleton,
  506                 start_abstract_tabling_2(Closure, Wrapper, Worker,
  507                                          Trie, Status, Skeleton)).
  508
  509start_abstract_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
  510    (   is_most_general_term(Skeleton)           % TBD: Fill and test Abstract
  511    ->  start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  512    ;   Status == complete
  513    ->  '$tbl_answer_update_dl'(Trie, Skeleton)
  514    ;   functor(Status, fresh, 2)
  515    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  516        abstract_worker(Worker, GenWrapper, GenWorker),
  517        catch(create_abstract_table(Trie, Status, Skeleton, GenSkeleton, GenWrapper,
  518                                    GenWorker),
  519              deadlock,
  520              restart_abstract_tabling(Closure, Wrapper, Worker))
  521    ;   Status == invalid
  522    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  523        forall(reeval(Trie, GenWrapper, GenSkeleton), true),
  524        '$tbl_answer_update_dl'(Trie, Skeleton)
  525    ;   shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  526        unify_subsumptive(Skeleton, GenSkeleton)
  527    ).
  528
  529create_abstract_table(Trie, Fresh, Skeleton, GenSkeleton, Wrapper, Worker) :-
  530    tdebug(Fresh = fresh(SCC, WorkList)),
  531    tdebug(wl_goal(WorkList, Goal, _)),
  532    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  533    setup_call_catcher_cleanup(
  534        '$idg_set_current'(OldCurrent, Trie),
  535        run_leader(GenSkeleton, Worker, Fresh, LStatus, _Clause),
  536        Catcher,
  537        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  538    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  539    Skeleton = GenSkeleton,
  540    done_abstract_leader(LStatus, Fresh, GenSkeleton, Trie).
  541
  542abstract_worker(_:call(Term), _M:GenWrapper, call(GenTerm)) :-
  543    functor(Term, Closure, _),
  544    GenWrapper =.. [_|Args],
  545    GenTerm =.. [Closure|Args].
  546
  547:- '$hide'((done_abstract_leader/4)).  548
  549done_abstract_leader(complete, _Fresh, Skeleton, Trie) :-
  550    !,
  551    '$tbl_answer_update_dl'(Trie, Skeleton).
  552done_abstract_leader(final, fresh(SCC, _Worklist), Skeleton, Trie) :-
  553    !,
  554    '$tbl_free_component'(SCC),
  555    '$tbl_answer_update_dl'(Trie, Skeleton).
  556done_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).

  565:- '$hide'((done_leader/4, finished_leader/4)).  566
  567done_leader(complete, _Fresh, Skeleton, Clause) :-
  568    !,
  569    trie_gen_compiled(Clause, Skeleton).
  570done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  571    !,
  572    '$tbl_free_component'(SCC),
  573    trie_gen_compiled(Clause, Skeleton).
  574done_leader(_,_,_,_).
  575
  576finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  577    '$idg_set_current'(OldCurrent),
  578    (   Catcher == exit
  579    ->  true
  580    ;   Catcher == fail
  581    ->  true
  582    ;   Catcher = exception(_)
  583    ->  Fresh = fresh(SCC, _),
  584        '$tbl_table_discard_all'(SCC)
  585    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  586    ).

 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.

  601run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  602    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  603    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  604    activate(Skeleton, Worker, Worklist),
  605    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  606    completion(SCC, Status, Clause),
  607    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  608    (   Status == merged
  609    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  610        '$tbl_wkl_make_follower'(Worklist),
  611        shift_for_copy(call_info(Skeleton, Worklist))
  612    ;   true                                    % completed
  613    ).
  614
  615activate(Skeleton, Worker, WorkList) :-
  616    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  617    (   reset_delays,
  618        delim(Skeleton, Worker, WorkList, []),
  619        fail
  620    ;   true
  621    ).

 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.

  637delim(Skeleton, Worker, WorkList, Delays) :-
  638    reset(Worker, SourceCall, Continuation),
  639    tdebug(wl_goal(WorkList, Goal, _)),
  640    (   Continuation == 0
  641    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  642        tdebug(delay_goals(AllDelays, Cond)),
  643        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  644               [Skeleton, Goal, Cond]),
  645        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  646        Complete == !,
  647        !
  648    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  649    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  650        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  651        tdebug(wl_goal(WorkList, DstGoal, _)),
  652        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  653        '$tbl_wkl_add_suspension'(
  654            SourceWL,
  655            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  656    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  657    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  658        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  659        tdebug(wl_goal(WorkList, DstGoal, _)),
  660        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  661        '$tbl_wkl_add_suspension'(
  662            SourceWL,
  663            InstSkeleton,
  664            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  665    ;   '$tbl_wkl_table'(WorkList, ATrie),
  666        mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
  667    ->  delim(Skeleton, Continuation, WorkList, Delays)
  668    ).

 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.

  675'$moded_wrap_tabled'(Head, Options, ModeTest, WrapperNoModes, ModeArgs) :-
  676    set_pattributes(Head, Options),
  677    '$wrap_predicate'(Head, table, Closure, Wrapped,
  678                      (   ModeTest,
  679                          start_moded_tabling(Closure, Head, Wrapped,
  680                                              WrapperNoModes, ModeArgs)
  681                      )).
  682
  683
  684start_moded_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  685    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie,
  686                               Status, Skeleton, IsMono),
  687    (   IsMono == true
  688    ->  shift(dependency(Skeleton/ModeArgs, Trie, Mono)),
  689        (   Mono == true
  690        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  691        ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  692                                  Trie, Status, Skeleton)
  693        )
  694    ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  695                              Trie, Status, Skeleton)
  696    ).
  697
  698start_moded_tabling_2(_Closure, Wrapper, Worker, ModeArgs,
  699                      Trie, Status, Skeleton) :-
  700    (   Status == complete
  701    ->  moded_gen_answer(Trie, Skeleton, ModeArgs)
  702    ;   functor(Status, fresh, 2)
  703    ->  setup_call_catcher_cleanup(
  704            '$idg_set_current'(OldCurrent, Trie),
  705            moded_run_leader(Wrapper, Skeleton/ModeArgs,
  706                             Worker, Status, LStatus),
  707            Catcher,
  708            finished_leader(OldCurrent, Catcher, Status, Wrapper)),
  709        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  710               [Wrapper, ModeArgs, LStatus]),
  711        moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
  712    ;   Status == invalid
  713    ->  reeval(Trie, Wrapper, Skeleton),
  714        moded_gen_answer(Trie, Skeleton, ModeArgs)
  715    ;   % = run_follower, but never fresh and Status is a worklist
  716        shift_for_copy(call_info(Skeleton/ModeArgs, Status))
  717    ).
  718
  719:- public
  720    moded_gen_answer/3.                         % XSB tables.pl
  721
  722moded_gen_answer(Trie, Skeleton, ModedArgs) :-
  723    trie_gen(Trie, Skeleton),
  724    '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
  725
  726'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
  727    trie_gen(ATrie, Skeleton),
  728    '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
  729
  730moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
  731    !,
  732    moded_gen_answer(Trie, Skeleton, ModeArgs).
  733moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
  734    !,
  735    '$tbl_free_component'(SCC),
  736    moded_gen_answer(Trie, Skeleton, ModeArgs).
  737moded_done_leader(_, _, _, _, _).
  738
  739moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
  740    tdebug(wl_goal(Worklist, Goal, _)),
  741    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  742    moded_activate(SkeletonMA, Worker, Worklist),
  743    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  744    completion(SCC, Status, _Clause),           % TBD: propagate
  745    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  746    (   Status == merged
  747    ->  tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
  748        '$tbl_wkl_make_follower'(Worklist),
  749        shift_for_copy(call_info(SkeletonMA, Worklist))
  750    ;   true                                    % completed
  751    ).
  752
  753moded_activate(SkeletonMA, Worker, WorkList) :-
  754    (   reset_delays,
  755        delim(SkeletonMA, Worker, WorkList, []),
  756        fail
  757    ;   true
  758    ).

 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

  776:- public
  777    update/7.  778
  779% both unconditional
  780update(0b11, Wrapper, M, Agg, New, Next, delete) :-
  781    !,
  782    M:'$table_update'(Wrapper, Agg, New, Next),
  783    Agg \=@= Next.
  784% old unconditional, new conditional
  785update(0b10, Wrapper, M, Agg, New, Next, keep) :-
  786    !,
  787    M:'$table_update'(Wrapper, Agg, New, Next0),
  788    (   Next0 =@= Agg
  789    ->  Next = Agg
  790    ;   Next = Next0
  791    ).
  792% old conditional, new unconditional,
  793update(0b01, Wrapper, M, Agg, New, Next, keep) :-
  794    !,
  795    M:'$table_update'(Wrapper, New, Agg, Next0),
  796    (   Next0 =@= Agg
  797    ->  Next = Agg
  798    ;   Next = Next0
  799    ).
  800% both conditional
  801update(0b00, _Wrapper, _M, _Agg, New, New, keep) :-
  802    !.

 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.

  811completion(SCC, Status, Clause) :-
  812    (   reset_delays,
  813        completion_(SCC),
  814        fail
  815    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  816        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  817    ).
  818
  819completion_(SCC) :-
  820    repeat,
  821    (   '$tbl_pop_worklist'(SCC, WorkList)
  822    ->  tdebug(wl_goal(WorkList, Goal, _)),
  823        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  824        completion_step(WorkList)
  825    ;   !
  826    ).

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

  857completion_step(SourceWL) :-
  858    '$tbl_wkl_work'(SourceWL,
  859                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  860    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  861    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  862    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  863    tdebug(delay_goals(AllDelays, Cond)),
  864    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  865           [TargetGoal, SourceGoal, Answer, Cond]),
  866    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  867    fail.
  868
  869
  870		 /*******************************
  871		 *     STRATIFIED NEGATION	*
  872		 *******************************/

 tnot(:Goal)

Tabled negation.

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

  880tnot(Goal0) :-
  881    '$tnot_implementation'(Goal0, Goal),        % verifies Goal is tabled
  882    (   '$tbl_existing_variant_table'(_, Goal, Trie, Status, Skeleton),
  883        Status \== invalid
  884    ->  '$idg_add_edge'(Trie),
  885        (   '$tbl_answer_dl'(Trie, _, true)
  886        ->  fail
  887        ;   '$tbl_answer_dl'(Trie, _, _)
  888        ->  tdebug(tnot, 'tnot: adding ~p to delay list', [Goal]),
  889            add_delay(Trie)
  890        ;   Status == complete
  891        ->  true
  892        ;   negation_suspend(Goal, Skeleton, Status)
  893        )
  894    ;   tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  895        (   '$wrapped_implementation'(Goal, table, Implementation), % see (*)
  896            functor(Implementation, Closure, _),
  897            start_tabling(Closure, Goal, Implementation),
  898            fail
  899        ;   '$tbl_existing_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
  900            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  901            (   '$tbl_answer_dl'(Trie, _, true)
  902            ->  fail
  903            ;   '$tbl_answer_dl'(Trie, _, _)
  904            ->  add_delay(Trie)
  905            ;   NewStatus == complete
  906            ->  true
  907            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  908            )
  909        )
  910    ).
  911
  912floundering(Goal) :-
  913    format(string(Comment), 'Floundering goal in tnot/1: ~p', [Goal]),
  914    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.

  925negation_suspend(Wrapper, Skeleton, Worklist) :-
  926    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  927    '$tbl_wkl_negative'(Worklist),
  928    shift_for_copy(call_info(Skeleton, tnot(Worklist))),
  929    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  930    '$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.

  939not_exists(Goal) :-
  940    ground(Goal),
  941    '$get_predicate_attribute'(Goal, tabled, 1),
  942    !,
  943    tnot(Goal).
  944not_exists(Goal) :-
  945    (   tabled_call(Goal), fail
  946    ;   tnot(tabled_call(Goal))
  947    ).
  948
  949		 /*******************************
  950		 *           DELAY LISTS	*
  951		 *******************************/
  952
  953add_delay(Delay) :-
  954    '$tbl_delay_list'(DL0),
  955    '$tbl_set_delay_list'([Delay|DL0]).
  956
  957reset_delays :-
  958    '$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).

  966'$wfs_call'(Goal, M:Delays) :-
  967    '$tbl_delay_list'(DL0),
  968    reset_delays,
  969    call(Goal),
  970    '$tbl_delay_list'(DL1),
  971    (   delay_goals(DL1, M, Delays)
  972    ->  true
  973    ;   Delays = undefined
  974    ),
  975    '$append'(DL0, DL1, DL),
  976    '$tbl_set_delay_list'(DL).
  977
  978delay_goals([], _, true) :-
  979    !.
  980delay_goals([AT+AN|T], M, Goal) :-
  981    !,
  982    (   integer(AN)
  983    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  984        (   '$tbl_is_trienode'(Moded)
  985        ->  trie_term(AN, Answer)
  986        ;   true                        % TBD: Generated moded answer
  987        )
  988    ;   AN = Skeleton/ModeArgs
  989    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  990        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  991        G0 = M1:G0plain
  992    ;   '$tbl_table_status'(AT, _, G0, AN)
  993    ),
  994    GN = G0,
  995    (   T == []
  996    ->  Goal = GN
  997    ;   Goal = (GN,GT),
  998        delay_goals(T, M, GT)
  999    ).
 1000delay_goals([AT|T], M, Goal) :-
 1001    atrie_goal(AT, G0),
 1002    unqualify_goal(G0, M, G1),
 1003    GN = tnot(G1),
 1004    (   T == []
 1005    ->  Goal = GN
 1006    ;   Goal = (GN,GT),
 1007        delay_goals(T, M, GT)
 1008    ).
 1009
 1010at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
 1011    is_trie(Trie),
 1012    !,
 1013    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
 1014at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
 1015    is_trie(Trie),
 1016    !,
 1017    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
 1018    M2:'$table_mode'(Goal0, Variant, Moded),
 1019    unqualify_goal(M2:Goal0, M, Goal).
 1020
 1021atrie_goal(Trie, M:Goal) :-
 1022    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
 1023    M:'$table_mode'(Goal, Variant, _Moded).
 1024
 1025unqualify_goal(M:Goal, M, Goal0) :-
 1026    !,
 1027    Goal0 = Goal.
 1028unqualify_goal(Goal, _, Goal).
 1029
 1030
 1031                 /*******************************
 1032                 *            CLEANUP           *
 1033                 *******************************/

 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.

 1045abolish_all_tables :-
 1046    (   '$tbl_abolish_local_tables'
 1047    ->  true
 1048    ;   true
 1049    ),
 1050    (   '$tbl_variant_table'(VariantTrie),
 1051        trie_gen(VariantTrie, _, Trie),
 1052        '$tbl_destroy_table'(Trie),
 1053        fail
 1054    ;   true
 1055    ).
 1056
 1057abolish_private_tables :-
 1058    (   '$tbl_abolish_local_tables'
 1059    ->  true
 1060    ;   (   '$tbl_local_variant_table'(VariantTrie),
 1061            trie_gen(VariantTrie, _, Trie),
 1062            '$tbl_destroy_table'(Trie),
 1063            fail
 1064        ;   true
 1065        )
 1066    ).
 1067
 1068abolish_shared_tables :-
 1069    (   '$tbl_global_variant_table'(VariantTrie),
 1070        trie_gen(VariantTrie, _, Trie),
 1071        '$tbl_destroy_table'(Trie),
 1072        fail
 1073    ;   true
 1074    ).

 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?

 1083abolish_table_subgoals(SubGoal0) :-
 1084    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1085    !,
 1086    '$must_be'(acyclic, SubGoal),
 1087    (   '$tbl_variant_table'(VariantTrie),
 1088        trie_gen(VariantTrie, M:SubGoal, Trie),
 1089        '$tbl_destroy_table'(Trie),
 1090        fail
 1091    ;   true
 1092    ).
 1093abolish_table_subgoals(_).

 abolish_module_tables(+Module) is det

Abolish all tables for predicates associated with the given module.

 1099abolish_module_tables(Module) :-
 1100    '$must_be'(atom, Module),
 1101    '$tbl_variant_table'(VariantTrie),
 1102    current_module(Module),
 1103    !,
 1104    forall(trie_gen(VariantTrie, Module:_, Trie),
 1105           '$tbl_destroy_table'(Trie)).
 1106abolish_module_tables(_).

 abolish_nonincremental_tables is det

Abolish all tables that are not related to incremental predicates.

 1112abolish_nonincremental_tables :-
 1113    (   '$tbl_variant_table'(VariantTrie),
 1114        trie_gen(VariantTrie, _, Trie),
 1115        '$tbl_table_status'(Trie, Status, Goal, _),
 1116        (   Status == complete
 1117        ->  true
 1118        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1119        ),
 1120        \+ predicate_property(Goal, incremental),
 1121        '$tbl_destroy_table'(Trie),
 1122        fail
 1123    ;   true
 1124    ).

 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.

 1133abolish_nonincremental_tables(Options) :-
 1134    (   Options = on_incomplete(Action)
 1135    ->  Action == skip
 1136    ;   '$option'(on_incomplete(skip), Options)
 1137    ),
 1138    !,
 1139    (   '$tbl_variant_table'(VariantTrie),
 1140        trie_gen(VariantTrie, _, Trie),
 1141        '$tbl_table_status'(Trie, complete, Goal, _),
 1142        \+ predicate_property(Goal, incremental),
 1143        '$tbl_destroy_table'(Trie),
 1144        fail
 1145    ;   true
 1146    ).
 1147abolish_nonincremental_tables(_) :-
 1148    abolish_nonincremental_tables.
 1149
 1150
 1151                 /*******************************
 1152                 *        EXAMINE TABLES        *
 1153                 *******************************/

 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.

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

 table_options(+Options, +OptDictIn, -OptDictOut)

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

 1319table_options(Options, _Opts0, _Opts) :-
 1320    var(Options),
 1321    '$instantiation_error'(Options).
 1322table_options((A,B), Opts0, Opts) :-
 1323    !,
 1324    table_options(A, Opts0, Opts1),
 1325    table_options(B, Opts1, Opts).
 1326table_options(subsumptive, Opts0, Opts1) :-
 1327    !,
 1328    put_dict(mode, Opts0, subsumptive, Opts1).
 1329table_options(variant, Opts0, Opts1) :-
 1330    !,
 1331    put_dict(mode, Opts0, variant, Opts1).
 1332table_options(incremental, Opts0, Opts1) :-
 1333    !,
 1334    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1335table_options(monotonic, Opts0, Opts1) :-
 1336    !,
 1337    put_dict(monotonic, Opts0, true, Opts1).
 1338table_options(opaque, Opts0, Opts1) :-
 1339    !,
 1340    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1341table_options(lazy, Opts0, Opts1) :-
 1342    !,
 1343    put_dict(lazy, Opts0, true, Opts1).
 1344table_options(dynamic, Opts0, Opts1) :-
 1345    !,
 1346    put_dict(dynamic, Opts0, true, Opts1).
 1347table_options(shared, Opts0, Opts1) :-
 1348    !,
 1349    put_dict(tshared, Opts0, true, Opts1).
 1350table_options(private, Opts0, Opts1) :-
 1351    !,
 1352    put_dict(tshared, Opts0, false, Opts1).
 1353table_options(max_answers(Count), Opts0, Opts1) :-
 1354    !,
 1355    restraint(max_answers, Count, Opts0, Opts1).
 1356table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1357    !,
 1358    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1359table_options(answer_abstract(Size), Opts0, Opts1) :-
 1360    !,
 1361    restraint(answer_abstract, Size, Opts0, Opts1).
 1362table_options(Opt, _, _) :-
 1363    '$domain_error'(table_option, Opt).
 1364
 1365restraint(Name, Value0, Opts0, Opts) :-
 1366    '$table_option'(Value0, Value),
 1367    (   Value < 0
 1368    ->  Opts = Opts0
 1369    ;   put_dict(Name, Opts0, Value, Opts)
 1370    ).

 mode_check(+Moded, -TestCode)

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

 1378mode_check(Moded, Check) :-
 1379    var(Moded),
 1380    !,
 1381    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1382mode_check(Moded, true) :-
 1383    '$tbl_trienode'(Moded),
 1384    !.
 1385mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1386    Moded =.. [s|Vars],
 1387    var_check(Vars, Test).
 1388
 1389var_check([H|T], Test) :-
 1390    (   T == []
 1391    ->  Test = var(H)
 1392    ;   Test = (var(H),Rest),
 1393        var_check(T, Rest)
 1394    ).
 1395
 1396:- public
 1397    instantiated_moded_arg/1. 1398
 1399instantiated_moded_arg(Vars) :-
 1400    '$member'(V, Vars),
 1401    \+ var(V),
 1402    '$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,...)

 1414extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1415    compound(ModeSpec),
 1416    !,
 1417    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1418    compound_name_arguments(Head, Name, HeadArgs),
 1419    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1420    length(ModedArgs, Count),
 1421    atomic_list_concat([$,Name,$,Count], VName),
 1422    Variant =.. [VName|VariantArgs],
 1423    (   ModedArgs == []
 1424    ->  '$tbl_trienode'(ModedAnswer)
 1425    ;   ModedArgs = [ModedAnswer]
 1426    ->  true
 1427    ;   ModedAnswer =.. [s|ModedArgs]
 1428    ).
 1429extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1430    atomic_list_concat([$,Atom,$,0], Variant),
 1431    '$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?

 1441separate_args([], [], [], [], []).
 1442separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1443    indexed_mode(HM),
 1444    !,
 1445    separate_args(TM, TA, TNA, Modes, TMA).
 1446separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1447    separate_args(TM, TA, TNA, Modes, TMA).
 1448
 1449indexed_mode(Mode) :-                           % XSB
 1450    var(Mode),
 1451    !.
 1452indexed_mode(index).                            % YAP
 1453indexed_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.

 1460updater_clauses([], _, []) :- !.
 1461updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1462    update_goal(P, S0,S1,S2, Body).
 1463updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1464    length(Modes, Len),
 1465    functor(S0, s, Len),
 1466    functor(S1, s, Len),
 1467    functor(S2, s, Len),
 1468    S0 =.. [_|Args0],
 1469    S1 =.. [_|Args1],
 1470    S2 =.. [_|Args2],
 1471    update_body(Modes, Args0, Args1, Args2, true, Body).
 1472
 1473update_body([], _, _, _, Body, Body).
 1474update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1475    update_goal(P, A0,A1,A2, Goal),
 1476    mkconj(Body0, Goal, Body1),
 1477    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1478
 1479update_goal(Var, _,_,_, _) :-
 1480    var(Var),
 1481    !,
 1482    '$instantiation_error'(Var).
 1483update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1484    !,
 1485    '$must_be'(atom, M),
 1486    update_goal(lattice(PI), S0,S1,S2, Goal).
 1487update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1488    !,
 1489    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1490    '$must_be'(atom, Name),
 1491    Goal =.. [Name,S0,S1,S2].
 1492update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1493    compound(Head),
 1494    !,
 1495    compound_name_arity(Head, Name, Arity),
 1496    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1497    Goal =.. [Name,S0,S1,S2].
 1498update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1499    !,
 1500    '$must_be'(atom, Name),
 1501    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1502update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1503    !,
 1504    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1505    '$must_be'(atom, Name),
 1506    Call =.. [Name, S0, S1],
 1507    Goal = (Call -> S2 = S0 ; S2 = S1).
 1508update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1509    !,
 1510    '$must_be'(atom, M),
 1511    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1512    '$must_be'(atom, Name),
 1513    Call =.. [Name, S0, S1],
 1514    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1515update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1516    !,
 1517    '$must_be'(atom, M),
 1518    '$must_be'(atom, Name),
 1519    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1520update_goal(po(Name), S0,S1,S2, Goal) :-
 1521    !,
 1522    '$must_be'(atom, Name),
 1523    update_goal(po(Name/2), S0,S1,S2, Goal).
 1524update_goal(Alias, S0,S1,S2, Goal) :-
 1525    update_alias(Alias, Update),
 1526    !,
 1527    update_goal(Update, S0,S1,S2, Goal).
 1528update_goal(Mode, _,_,_, _) :-
 1529    '$domain_error'(tabled_mode, Mode).
 1530
 1531update_alias(first, lattice('$tabling':first/3)).
 1532update_alias(-,     lattice('$tabling':first/3)).
 1533update_alias(last,  lattice('$tabling':last/3)).
 1534update_alias(min,   lattice('$tabling':min/3)).
 1535update_alias(max,   lattice('$tabling':max/3)).
 1536update_alias(sum,   lattice('$tabling':sum/3)).
 1537
 1538mkconj(true, G,  G) :- !.
 1539mkconj(G1,   G2, (G1,G2)).
 1540
 1541
 1542		 /*******************************
 1543		 *          AGGREGATION		*
 1544		 *******************************/

 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.

 1554:- public first/3, last/3, min/3, max/3, sum/3. 1555
 1556first(S, _, S).
 1557last(_, S, S).
 1558min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1559max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1560sum(S0, S1, S) :- S is S0+S1.
 1561
 1562
 1563		 /*******************************
 1564		 *      DYNAMIC PREDICATES	*
 1565		 *******************************/

 $set_table_wrappers(:Head)

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

 1572'$set_table_wrappers'(Pred) :-
 1573    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1574        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1575    ->  wrap_incremental(Pred)
 1576    ;   unwrap_incremental(Pred)
 1577    ),
 1578    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1579    ->  wrap_monotonic(Pred)
 1580    ;   unwrap_monotonic(Pred)
 1581    ).
 1582
 1583		 /*******************************
 1584		 *       MONOTONIC TABLING	*
 1585		 *******************************/

 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.

 1592mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1593    '$idg_add_mono_dyn_dep'(Dynamic,
 1594                            dependency(Dynamic, Cont, Skel),
 1595                            ATrie).
 1596mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1597    '$idg_add_monotonic_dep'(SrcTrie,
 1598                             dependency(SrcSkel, IsMono, Cont, Skel),
 1599                             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.

A table with more than one monotonic dependency indexes them by their skeleton, so only the dependencies whose skeleton unifies with SrcReturn are visited rather than every dependency of SrcTrie.

 1613monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1614    (   '$idg_mono_index'(SrcTrie, Index)
 1615    ->  '$trie_gen_node'(Index, SrcSkel-ATrie, Leaf),
 1616        '$idg_mono_index_deps'(SrcTrie, Leaf, ATrie,
 1617                               dependency(SrcSkel, IsMono, Cont, Skel))
 1618    ;   '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1619                                  dependency(SrcSkel, IsMono, Cont, Skel))
 1620    ).

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

Dynamic predicate that maintains the dependency from a monotonic