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

Tabled execution (SLG WAM)

This library handled tabled execution of predicates using the characteristics if the SLG WAM. The required suspension is realised using delimited continuations implemented by reset/3 and shift/1. The table space and work lists are part of the SWI-Prolog core.

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

  177table(M:PIList) :-
  178    setup_call_cleanup(
  179        '$set_source_module'(OldModule, M),
  180        expand_term((:- table(PIList)), Clauses),
  181        '$set_source_module'(OldModule)),
  182    dyn_tabling_list(Clauses, M).
  183
  184dyn_tabling_list([], _).
  185dyn_tabling_list([H|T], M) :-
  186    dyn_tabling(H, M),
  187    dyn_tabling_list(T, M).
  188
  189dyn_tabling(M:Clause, _) :-
  190    !,
  191    dyn_tabling(Clause, M).
  192dyn_tabling((:- multifile(PI)), M) :-
  193    !,
  194    multifile(M:PI),
  195    dynamic(M:PI).
  196dyn_tabling(:- initialization(Wrap, now), M) :-
  197    !,
  198    M:Wrap.
  199dyn_tabling('$tabled'(Head, TMode), M) :-
  200    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  201        (   OMode \== TMode
  202        ->  erase(Ref),
  203            fail
  204        ;   true
  205        )
  206    ->  true
  207    ;   assertz(M:'$tabled'(Head, TMode))
  208    ).
  209dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  210    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  211    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  212        ->  true
  213        ;   erase(Ref),
  214            assertz(M:'$table_mode'(Head, Variant, Moded))
  215        )
  216    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  217    ).
  218dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  219    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  220    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  221        ->  true
  222        ;   erase(Ref),
  223            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  224        )
  225    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  226    ).
 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.
  237untable(M:PIList) :-
  238    untable(PIList, M).
  239
  240untable(Var, _) :-
  241    var(Var),
  242    !,
  243    '$instantiation_error'(Var).
  244untable(M:Spec, _) :-
  245    !,
  246    '$must_be'(atom, M),
  247    untable(Spec, M).
  248untable((A,B), M) :-
  249    !,
  250    untable(A, M),
  251    untable(B, M).
  252untable(Name//Arity, M) :-
  253    atom(Name), integer(Arity), Arity >= 0,
  254    !,
  255    Arity1 is Arity+2,
  256    untable(Name/Arity1, M).
  257untable(Name/Arity, M) :-
  258    !,
  259    functor(Head, Name, Arity),
  260    (   '$get_predicate_attribute'(M:Head, tabled, 1)
  261    ->  abolish_table_subgoals(M:Head),
  262        dynamic(M:'$tabled'/2),
  263        dynamic(M:'$table_mode'/3),
  264        retractall(M:'$tabled'(Head, _TMode)),
  265        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  266        unwrap_predicate(M:Name/Arity, table),
  267        '$set_predicate_attribute'(M:Head, tabled, false)
  268    ;   true
  269    ).
  270untable(Head, M) :-
  271    callable(Head),
  272    !,
  273    functor(Head, Name, Arity),
  274    untable(Name/Arity, M).
  275untable(TableSpec, _) :-
  276    '$type_error'(table_desclaration, TableSpec).
  277
  278untable_reconsult(PI) :-
  279    print_message(informational, untable(PI)),
  280    untable(PI).
  281
  282:- initialization
  283   prolog_listen(untable, untable_reconsult).  284
  285
  286'$wrap_tabled'(Head, Options) :-
  287    get_dict(mode, Options, subsumptive),
  288    !,
  289    set_pattributes(Head, Options),
  290    '$wrap_predicate'(Head, table, Closure, Wrapped,
  291                      start_subsumptive_tabling(Closure, Head, Wrapped)).
  292'$wrap_tabled'(Head, Options) :-
  293    get_dict(subgoal_abstract, Options, _Abstract),
  294    !,
  295    set_pattributes(Head, Options),
  296    '$wrap_predicate'(Head, table, Closure, Wrapped,
  297                      start_abstract_tabling(Closure, Head, Wrapped)).
  298'$wrap_tabled'(Head, Options) :-
  299    !,
  300    set_pattributes(Head, Options),
  301    '$wrap_predicate'(Head, table, Closure, Wrapped,
  302                      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.
  309set_pattributes(Head, Options) :-
  310    '$set_predicate_attribute'(Head, tabled, true),
  311    (   tabled_attribute(Attr),
  312        get_dict(Attr, Options, Value),
  313        '$set_predicate_attribute'(Head, Attr, Value),
  314        fail
  315    ;   true
  316    ).
  317
  318tabled_attribute(incremental).
  319tabled_attribute(dynamic).
  320tabled_attribute(tshared).
  321tabled_attribute(max_answers).
  322tabled_attribute(subgoal_abstract).
  323tabled_attribute(answer_abstract).
  324tabled_attribute(monotonic).
  325tabled_attribute(opaque).
 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.
  341start_tabling(Closure, Wrapper, Worker) :-
  342    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton, IsMono),
  343    (   IsMono == true
  344    ->  shift(dependency(Skeleton, Trie, Mono)),
  345        (   Mono == true
  346        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  347        ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  348        )
  349    ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  350    ).
  351
  352start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
  353    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  354    (   Status == complete
  355    ->  trie_gen_compiled(Trie, Skeleton)
  356    ;   functor(Status, fresh, 2)
  357    ->  catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
  358              deadlock,
  359              restart_tabling(Closure, Wrapper, Worker))
  360    ;   Status == invalid
  361    ->  reeval(Trie, Wrapper, Skeleton)
  362    ;   % = run_follower, but never fresh and Status is a worklist
  363        shift(call_info(Skeleton, Status))
  364    ).
  365
  366create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
  367    tdebug(Fresh = fresh(SCC, WorkList)),
  368    tdebug(wl_goal(WorkList, Goal, _)),
  369    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  370    setup_call_catcher_cleanup(
  371        '$idg_set_current'(OldCurrent, Trie),
  372        run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
  373        Catcher,
  374        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  375    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  376    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.
  386restart_tabling(Closure, Wrapper, Worker) :-
  387    tdebug(user_goal(Wrapper, Goal)),
  388    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  389    sleep(0.000001),
  390    start_tabling(Closure, Wrapper, Worker).
  391
  392restart_abstract_tabling(Closure, Wrapper, Worker) :-
  393    tdebug(user_goal(Wrapper, Goal)),
  394    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  395    sleep(0.000001),
  396    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.
  408start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  409    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  410    ->  (   Status == complete
  411        ->  trie_gen_compiled(Trie, Skeleton)
  412        ;   Status == invalid
  413        ->  reeval(Trie, Wrapper, Skeleton),
  414            trie_gen_compiled(Trie, Skeleton)
  415        ;   shift(call_info(Skeleton, Status))
  416        )
  417    ;   more_general_table(Wrapper, ATrie),
  418        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  419    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  420    ;   more_general_table(Wrapper, ATrie),
  421        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  422    ->  (   Status == invalid
  423        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  424            Wrapper = GenWrapper,
  425            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  426        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  427            shift(call_info(GenSkeleton, Skeleton, Status)),
  428            unify_subsumptive(Skeleton, GenSkeleton)
  429        )
  430    ;   start_tabling(Closure, Wrapper, Worker)
  431    ).
 wrapper_skeleton(+GenWrapper, +GenSkeleton, +Wrapper, -Skeleton)
Skeleton is a specialized version of GenSkeleton for the subsumed new consumer.
  438wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  439    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  440    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  441           [GenSkeleton+Skeleton]).
  442
  443unify_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))

  456start_abstract_tabling(Closure, Wrapper, Worker) :-
  457    '$tbl_abstract_table'(Closure, Wrapper, Trie, _Abstract, Status, Skeleton),
  458    tdebug(abstract, 'Wrapper=~p, Worker=~p, Skel=~p',
  459           [Wrapper, Worker, Skeleton]),
  460    (   is_most_general_term(Skeleton)           % TBD: Fill and test Abstract
  461    ->  start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  462    ;   Status == complete
  463    ->  '$tbl_answer_update_dl'(Trie, Skeleton)
  464    ;   functor(Status, fresh, 2)
  465    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  466        abstract_worker(Worker, GenWrapper, GenWorker),
  467        catch(create_abstract_table(Trie, Status, Skeleton, GenSkeleton, GenWrapper,
  468                                    GenWorker),
  469              deadlock,
  470              restart_abstract_tabling(Closure, Wrapper, Worker))
  471    ;   Status == invalid
  472    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  473        reeval(ATrie, GenWrapper, GenSkeleton),
  474        Wrapper = GenWrapper,
  475        '$tbl_answer_update_dl'(ATrie, Skeleton)
  476    ;   shift(call_info(GenSkeleton, Skeleton, Status)),
  477        unify_subsumptive(Skeleton, GenSkeleton)
  478    ).
  479
  480create_abstract_table(Trie, Fresh, Skeleton, GenSkeleton, Wrapper, Worker) :-
  481    tdebug(Fresh = fresh(SCC, WorkList)),
  482    tdebug(wl_goal(WorkList, Goal, _)),
  483    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  484    setup_call_catcher_cleanup(
  485        '$idg_set_current'(OldCurrent, Trie),
  486        run_leader(GenSkeleton, Worker, Fresh, LStatus, _Clause),
  487        Catcher,
  488        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  489    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  490    Skeleton = GenSkeleton,
  491    done_abstract_leader(LStatus, Fresh, GenSkeleton, Trie).
  492
  493abstract_worker(_:call(Term), _M:GenWrapper, call(GenTerm)) :-
  494    functor(Term, Closure, _),
  495    GenWrapper =.. [_|Args],
  496    GenTerm =.. [Closure|Args].
  497
  498:- '$hide'((done_abstract_leader/4)).  499
  500done_abstract_leader(complete, _Fresh, Skeleton, Trie) :-
  501    !,
  502    '$tbl_answer_update_dl'(Trie, Skeleton).
  503done_abstract_leader(final, fresh(SCC, _Worklist), Skeleton, Trie) :-
  504    !,
  505    '$tbl_free_component'(SCC),
  506    '$tbl_answer_update_dl'(Trie, Skeleton).
  507done_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).
  516:- '$hide'((done_leader/4, finished_leader/4)).  517
  518done_leader(complete, _Fresh, Skeleton, Clause) :-
  519    !,
  520    trie_gen_compiled(Clause, Skeleton).
  521done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  522    !,
  523    '$tbl_free_component'(SCC),
  524    trie_gen_compiled(Clause, Skeleton).
  525done_leader(_,_,_,_).
  526
  527finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  528    '$idg_set_current'(OldCurrent),
  529    (   Catcher == exit
  530    ->  true
  531    ;   Catcher == fail
  532    ->  true
  533    ;   Catcher = exception(_)
  534    ->  Fresh = fresh(SCC, _),
  535        '$tbl_table_discard_all'(SCC)
  536    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  537    ).
 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.

  552run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  553    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  554    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  555    activate(Skeleton, Worker, Worklist),
  556    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  557    completion(SCC, Status, Clause),
  558    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  559    (   Status == merged
  560    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  561        '$tbl_wkl_make_follower'(Worklist),
  562        shift(call_info(Skeleton, Worklist))
  563    ;   true                                    % completed
  564    ).
  565
  566activate(Skeleton, Worker, WorkList) :-
  567    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  568    (   reset_delays,
  569        delim(Skeleton, Worker, WorkList, []),
  570        fail
  571    ;   true
  572    ).
 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.
  588delim(Skeleton, Worker, WorkList, Delays) :-
  589    reset(Worker, SourceCall, Continuation),
  590    tdebug(wl_goal(WorkList, Goal, _)),
  591    (   Continuation == 0
  592    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  593        tdebug(delay_goals(AllDelays, Cond)),
  594        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  595               [Skeleton, Goal, Cond]),
  596        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  597        Complete == !,
  598        !
  599    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  600    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  601        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  602        tdebug(wl_goal(WorkList, DstGoal, _)),
  603        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  604        '$tbl_wkl_add_suspension'(
  605            SourceWL,
  606            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  607    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  608    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  609        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  610        tdebug(wl_goal(WorkList, DstGoal, _)),
  611        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  612        '$tbl_wkl_add_suspension'(
  613            SourceWL,
  614            InstSkeleton,
  615            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  616    ;   '$tbl_wkl_table'(WorkList, ATrie),
  617        mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
  618    ->  delim(Skeleton, Continuation, WorkList, Delays)
  619    ).
 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.
  626'$moded_wrap_tabled'(Head, ModeTest, WrapperNoModes, ModeArgs) :-
  627    '$set_predicate_attribute'(Head, tabled, true),
  628    '$wrap_predicate'(Head, table, Closure, Wrapped,
  629                      (   ModeTest,
  630                          start_moded_tabling(Closure, Head, Wrapped,
  631                                              WrapperNoModes, ModeArgs)
  632                      )).
  633
  634
  635start_moded_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  636    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie, Status, Skeleton),
  637    (   Status == complete
  638    ->  moded_gen_answer(Trie, Skeleton, ModeArgs)
  639    ;   functor(Status, fresh, 2)
  640    ->  setup_call_catcher_cleanup(
  641            '$idg_set_current'(OldCurrent, Trie),
  642            moded_run_leader(Wrapper, Skeleton/ModeArgs,
  643                             Worker, Status, LStatus),
  644            Catcher,
  645            finished_leader(OldCurrent, Catcher, Status, Wrapper)),
  646        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  647               [Wrapper, ModeArgs, LStatus]),
  648        moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
  649    ;   Status == invalid
  650    ->  reeval(Trie, Wrapper, Skeleton),
  651        moded_gen_answer(Trie, Skeleton, ModeArgs)
  652    ;   % = run_follower, but never fresh and Status is a worklist
  653        shift(call_info(Skeleton/ModeArgs, Status))
  654    ).
  655
  656:- public
  657    moded_gen_answer/3.                         % XSB tables.pl
  658
  659moded_gen_answer(Trie, Skeleton, ModedArgs) :-
  660    trie_gen(Trie, Skeleton),
  661    '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
  662
  663'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
  664    trie_gen(ATrie, Skeleton),
  665    '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
  666
  667moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
  668    !,
  669    moded_gen_answer(Trie, Skeleton, ModeArgs).
  670moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
  671    !,
  672    '$tbl_free_component'(SCC),
  673    moded_gen_answer(Trie, Skeleton, ModeArgs).
  674moded_done_leader(_, _, _, _, _).
  675
  676moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
  677    tdebug(wl_goal(Worklist, Goal, _)),
  678    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  679    moded_activate(SkeletonMA, Worker, Worklist),
  680    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  681    completion(SCC, Status, _Clause),           % TBD: propagate
  682    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  683    (   Status == merged
  684    ->  tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
  685        '$tbl_wkl_make_follower'(Worklist),
  686        shift(call_info(SkeletonMA, Worklist))
  687    ;   true                                    % completed
  688    ).
  689
  690moded_activate(SkeletonMA, Worker, WorkList) :-
  691    (   reset_delays,
  692        delim(SkeletonMA, Worker, WorkList, []),
  693        fail
  694    ;   true
  695    ).
 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 uncondional
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
  713:- public
  714    update/7.  715
  716update(0b11, Wrapper, M, A1, A2, A3, delete) :-
  717    !,
  718    M:'$table_update'(Wrapper, A1, A2, A3),
  719    A1 \=@= A3.
  720update(0b10, Wrapper, M, A1, A2, A3, Action) :-
  721    !,
  722    (   is_subsumed_by(Wrapper, M, A2, A1)
  723    ->  Action = done
  724    ;   A3 = A2,
  725        Action = keep
  726    ).
  727update(0b01, Wrapper, M, A1, A2, A2, Action) :-
  728    !,
  729    (   is_subsumed_by(Wrapper, M, A1, A2)
  730    ->  Action = delete
  731    ;   Action = keep
  732    ).
  733update(0b00, _Wrapper, _M, _A1, A2, A2, keep) :-
  734    !.
  735
  736is_subsumed_by(Wrapper, M, Instance, General) :-
  737    M:'$table_update'(Wrapper, Instance, General, New),
  738    New =@= General.
 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.
  747completion(SCC, Status, Clause) :-
  748    (   reset_delays,
  749        completion_(SCC),
  750        fail
  751    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  752        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  753    ).
  754
  755completion_(SCC) :-
  756    repeat,
  757    (   '$tbl_pop_worklist'(SCC, WorkList)
  758    ->  tdebug(wl_goal(WorkList, Goal, _)),
  759        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  760        completion_step(WorkList)
  761    ;   !
  762    ).
 $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:

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.
  793completion_step(SourceWL) :-
  794    '$tbl_wkl_work'(SourceWL,
  795                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  796    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  797    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  798    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  799    tdebug(delay_goals(AllDelays, Cond)),
  800    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  801           [TargetGoal, SourceGoal, Answer, Cond]),
  802    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  803    fail.
  804
  805
  806		 /*******************************
  807		 *     STRATIFIED NEGATION	*
  808		 *******************************/
 tnot(:Goal)
Tabled negation.

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

  816tnot(Goal0) :-
  817    '$tnot_implementation'(Goal0, Goal),        % verifies Goal is tabled
  818    (   '$tbl_existing_variant_table'(_, Goal, Trie, Status, Skeleton)
  819    ->  (   '$tbl_answer_dl'(Trie, _, true)
  820        ->  fail
  821        ;   '$tbl_answer_dl'(Trie, _, _)
  822        ->  tdebug(tnot, 'tnot: adding ~p to delay list', [Goal]),
  823            add_delay(Trie)
  824        ;   Status == complete
  825        ->  true
  826        ;   negation_suspend(Goal, Skeleton, Status)
  827        )
  828    ;   tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  829        (   '$wrapped_implementation'(Goal, table, Implementation), % see (*)
  830            functor(Implementation, Closure, _),
  831            start_tabling(Closure, Goal, Implementation),
  832            fail
  833        ;   '$tbl_existing_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
  834            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  835            (   '$tbl_answer_dl'(Trie, _, true)
  836            ->  fail
  837            ;   '$tbl_answer_dl'(Trie, _, _)
  838            ->  add_delay(Trie)
  839            ;   NewStatus == complete
  840            ->  true
  841            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  842            )
  843        )
  844    ).
  845
  846floundering(Goal) :-
  847    format(string(Comment), 'Floundering goal in tnot/1: ~p', [Goal]),
  848    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.

  859negation_suspend(Wrapper, Skeleton, Worklist) :-
  860    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  861    '$tbl_wkl_negative'(Worklist),
  862    shift(call_info(Skeleton, tnot(Worklist))),
  863    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  864    '$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.
  873not_exists(Goal) :-
  874    ground(Goal),
  875    '$get_predicate_attribute'(Goal, tabled, 1),
  876    !,
  877    tnot(Goal).
  878not_exists(Goal) :-
  879    (   tabled_call(Goal), fail
  880    ;   tnot(tabled_call(Goal))
  881    ).
  882
  883		 /*******************************
  884		 *           DELAY LISTS	*
  885		 *******************************/
  886
  887add_delay(Delay) :-
  888    '$tbl_delay_list'(DL0),
  889    '$tbl_set_delay_list'([Delay|DL0]).
  890
  891reset_delays :-
  892    '$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).
  900'$wfs_call'(Goal, M:Delays) :-
  901    '$tbl_delay_list'(DL0),
  902    reset_delays,
  903    call(Goal),
  904    '$tbl_delay_list'(DL1),
  905    (   delay_goals(DL1, M, Delays)
  906    ->  true
  907    ;   Delays = undefined
  908    ),
  909    '$append'(DL0, DL1, DL),
  910    '$tbl_set_delay_list'(DL).
  911
  912delay_goals([], _, true) :-
  913    !.
  914delay_goals([AT+AN|T], M, Goal) :-
  915    !,
  916    (   integer(AN)
  917    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  918        (   '$tbl_is_trienode'(Moded)
  919        ->  trie_term(AN, Answer)
  920        ;   true                        % TBD: Generated moded answer
  921        )
  922    ;   AN = Skeleton/ModeArgs
  923    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  924        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  925        G0 = M1:G0plain
  926    ;   '$tbl_table_status'(AT, _, G0, AN)
  927    ),
  928    GN = G0,
  929    (   T == []
  930    ->  Goal = GN
  931    ;   Goal = (GN,GT),
  932        delay_goals(T, M, GT)
  933    ).
  934delay_goals([AT|T], M, Goal) :-
  935    atrie_goal(AT, G0),
  936    unqualify_goal(G0, M, G1),
  937    GN = tnot(G1),
  938    (   T == []
  939    ->  Goal = GN
  940    ;   Goal = (GN,GT),
  941        delay_goals(T, M, GT)
  942    ).
  943
  944at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
  945    is_trie(Trie),
  946    !,
  947    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
  948at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
  949    is_trie(Trie),
  950    !,
  951    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
  952    M2:'$table_mode'(Goal0, Variant, Moded),
  953    unqualify_goal(M2:Goal0, M, Goal).
  954
  955atrie_goal(Trie, M:Goal) :-
  956    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
  957    M:'$table_mode'(Goal, Variant, _Moded).
  958
  959unqualify_goal(M:Goal, M, Goal0) :-
  960    !,
  961    Goal0 = Goal.
  962unqualify_goal(Goal, _, Goal).
  963
  964
  965                 /*******************************
  966                 *            CLEANUP           *
  967                 *******************************/
 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.

  979abolish_all_tables :-
  980    (   '$tbl_abolish_local_tables'
  981    ->  true
  982    ;   true
  983    ),
  984    (   '$tbl_variant_table'(VariantTrie),
  985        trie_gen(VariantTrie, _, Trie),
  986        '$tbl_destroy_table'(Trie),
  987        fail
  988    ;   true
  989    ).
  990
  991abolish_private_tables :-
  992    (   '$tbl_abolish_local_tables'
  993    ->  true
  994    ;   (   '$tbl_local_variant_table'(VariantTrie),
  995            trie_gen(VariantTrie, _, Trie),
  996            '$tbl_destroy_table'(Trie),
  997            fail
  998        ;   true
  999        )
 1000    ).
 1001
 1002abolish_shared_tables :-
 1003    (   '$tbl_global_variant_table'(VariantTrie),
 1004        trie_gen(VariantTrie, _, Trie),
 1005        '$tbl_destroy_table'(Trie),
 1006        fail
 1007    ;   true
 1008    ).
 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?
 1017abolish_table_subgoals(SubGoal0) :-
 1018    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1019    !,
 1020    '$must_be'(acyclic, SubGoal),
 1021    (   '$tbl_variant_table'(VariantTrie),
 1022        trie_gen(VariantTrie, M:SubGoal, Trie),
 1023        '$tbl_destroy_table'(Trie),
 1024        fail
 1025    ;   true
 1026    ).
 1027abolish_table_subgoals(_).
 abolish_module_tables(+Module) is det
Abolish all tables for predicates associated with the given module.
 1033abolish_module_tables(Module) :-
 1034    '$must_be'(atom, Module),
 1035    '$tbl_variant_table'(VariantTrie),
 1036    current_module(Module),
 1037    !,
 1038    forall(trie_gen(VariantTrie, Module:_, Trie),
 1039           '$tbl_destroy_table'(Trie)).
 1040abolish_module_tables(_).
 abolish_nonincremental_tables is det
Abolish all tables that are not related to incremental predicates.
 1046abolish_nonincremental_tables :-
 1047    (   '$tbl_variant_table'(VariantTrie),
 1048        trie_gen(VariantTrie, _, Trie),
 1049        '$tbl_table_status'(Trie, Status, Goal, _),
 1050        (   Status == complete
 1051        ->  true
 1052        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1053        ),
 1054        \+ predicate_property(Goal, incremental),
 1055        '$tbl_destroy_table'(Trie),
 1056        fail
 1057    ;   true
 1058    ).
 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.
 1067abolish_nonincremental_tables(Options) :-
 1068    (   Options = on_incomplete(Action)
 1069    ->  Action == skip
 1070    ;   '$option'(on_incomplete(skip), Options)
 1071    ),
 1072    !,
 1073    (   '$tbl_variant_table'(VariantTrie),
 1074        trie_gen(VariantTrie, _, Trie),
 1075        '$tbl_table_status'(Trie, complete, Goal, _),
 1076        \+ predicate_property(Goal, incremental),
 1077        '$tbl_destroy_table'(Trie),
 1078        fail
 1079    ;   true
 1080    ).
 1081abolish_nonincremental_tables(_) :-
 1082    abolish_nonincremental_tables.
 1083
 1084
 1085                 /*******************************
 1086                 *        EXAMINE TABLES        *
 1087                 *******************************/
 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.
 1096current_table(Variant, Trie) :-
 1097    ct_generate(Variant),
 1098    !,
 1099    current_table_gen(Variant, Trie).
 1100current_table(Variant, Trie) :-
 1101    current_table_lookup(Variant, Trie),
 1102    !.
 1103
 1104current_table_gen(Variant, Trie) :-
 1105    '$tbl_local_variant_table'(VariantTrie),
 1106    trie_gen(VariantTrie, Variant, Trie).
 1107current_table_gen(Variant, Trie) :-
 1108    '$tbl_global_variant_table'(VariantTrie),
 1109    trie_gen(VariantTrie, Variant, Trie),
 1110    \+ '$tbl_table_status'(Trie, fresh). % shared tables are not destroyed
 1111
 1112current_table_lookup(Variant, Trie) :-
 1113    '$tbl_local_variant_table'(VariantTrie),
 1114    trie_lookup(VariantTrie, Variant, Trie).
 1115current_table_lookup(Variant, Trie) :-
 1116    '$tbl_global_variant_table'(VariantTrie),
 1117    trie_lookup(VariantTrie, Variant, Trie),
 1118    \+ '$tbl_table_status'(Trie, fresh).
 1119
 1120ct_generate(M:Variant) :-
 1121    (   var(Variant)
 1122    ->  true
 1123    ;   var(M)
 1124    ).
 1125
 1126                 /*******************************
 1127                 *      WRAPPER GENERATION      *
 1128                 *******************************/
 1129
 1130:- multifile
 1131    system:term_expansion/2,
 1132    tabled/2. 1133:- dynamic
 1134    system:term_expansion/2. 1135
 1136wrappers(Spec, M) -->
 1137    { tabling_defaults(
 1138          [ (table_incremental=true)            - (incremental=true),
 1139            (table_shared=true)                 - (tshared=true),
 1140            (table_subsumptive=true)            - ((mode)=subsumptive),
 1141            call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
 1142          ],
 1143          #{}, Defaults)
 1144    },
 1145    wrappers(Spec, M, Defaults).
 1146
 1147wrappers(Var, _, _) -->
 1148    { var(Var),
 1149      !,
 1150      '$instantiation_error'(Var)
 1151    }.
 1152wrappers(M:Spec, _, Opts) -->
 1153    !,
 1154    { '$must_be'(atom, M) },
 1155    wrappers(Spec, M, Opts).
 1156wrappers(Spec as Options, M, Opts0) -->
 1157    !,
 1158    { table_options(Options, Opts0, Opts) },
 1159    wrappers(Spec, M, Opts).
 1160wrappers((A,B), M, Opts) -->
 1161    !,
 1162    wrappers(A, M, Opts),
 1163    wrappers(B, M, Opts).
 1164wrappers(Name//Arity, M, Opts) -->
 1165    { atom(Name), integer(Arity), Arity >= 0,
 1166      !,
 1167      Arity1 is Arity+2
 1168    },
 1169    wrappers(Name/Arity1, M, Opts).
 1170wrappers(Name/Arity, Module, Opts) -->
 1171    { '$option'(mode(TMode), Opts, variant),
 1172      atom(Name), integer(Arity), Arity >= 0,
 1173      !,
 1174      functor(Head, Name, Arity),
 1175      '$tbl_trienode'(Reserved)
 1176    },
 1177    qualify(Module,
 1178            [ '$tabled'(Head, TMode),
 1179              '$table_mode'(Head, Head, Reserved)
 1180            ]),
 1181    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1182    ].
 1183wrappers(ModeDirectedSpec, Module, Opts) -->
 1184    { '$option'(mode(TMode), Opts, variant),
 1185      callable(ModeDirectedSpec),
 1186      !,
 1187      functor(ModeDirectedSpec, Name, Arity),
 1188      functor(Head, Name, Arity),
 1189      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1190      updater_clauses(Modes, Head, UpdateClauses),
 1191      mode_check(Moded, ModeTest),
 1192      (   ModeTest == true
 1193      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1194          TVariant = Head
 1195      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, ModeTest,
 1196                                            Module:Variant, Moded),
 1197          TVariant = Variant
 1198      )
 1199    },
 1200    qualify(Module,
 1201            [ '$tabled'(Head, TMode),
 1202              '$table_mode'(Head, TVariant, Moded)
 1203            ]),
 1204    [ (:- initialization(WrapClause, now))
 1205    ],
 1206    qualify(Module, UpdateClauses).
 1207wrappers(TableSpec, _M, _Opts) -->
 1208    { '$type_error'(table_desclaration, TableSpec)
 1209    }.
 1210
 1211qualify(Module, List) -->
 1212    { prolog_load_context(module, Module) },
 1213    !,
 1214    clist(List).
 1215qualify(Module, List) -->
 1216    qlist(List, Module).
 1217
 1218clist([])    --> [].
 1219clist([H|T]) --> [H], clist(T).
 1220
 1221qlist([], _)    --> [].
 1222qlist([H|T], M) --> [M:H], qlist(T, M).
 1223
 1224
 1225tabling_defaults([], Dict, Dict).
 1226tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
 1227    (   tabling_default(Condition)
 1228    ->  Dict1 = Dict0.put(Opt,Value)
 1229    ;   Dict1 = Dict0
 1230    ),
 1231    tabling_defaults(T, Dict1, Dict).
 1232
 1233tabling_default(Flag=FValue) :-
 1234    !,
 1235    current_prolog_flag(Flag, FValue).
 1236tabling_default(call(Term)) :-
 1237    call(Term).
 1238
 1239% Called from wrappers//2.
 1240
 1241subgoal_size_restraint(Level) :-
 1242    current_prolog_flag(max_table_subgoal_size_action, abstract),
 1243    current_prolog_flag(max_table_subgoal_size, Level).
 table_options(+Options, +OptDictIn, -OptDictOut)
Handler the ... as options ... construct.
 1249table_options(Options, _Opts0, _Opts) :-
 1250    var(Options),
 1251    '$instantiation_error'(Options).
 1252table_options((A,B), Opts0, Opts) :-
 1253    !,
 1254    table_options(A, Opts0, Opts1),
 1255    table_options(B, Opts1, Opts).
 1256table_options(subsumptive, Opts0, Opts1) :-
 1257    !,
 1258    put_dict(mode, Opts0, subsumptive, Opts1).
 1259table_options(variant, Opts0, Opts1) :-
 1260    !,
 1261    put_dict(mode, Opts0, variant, Opts1).
 1262table_options(incremental, Opts0, Opts1) :-
 1263    !,
 1264    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1265table_options(monotonic, Opts0, Opts1) :-
 1266    !,
 1267    put_dict(monotonic, Opts0, true, Opts1).
 1268table_options(opaque, Opts0, Opts1) :-
 1269    !,
 1270    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1271table_options(dynamic, Opts0, Opts1) :-
 1272    !,
 1273    put_dict(dynamic, Opts0, true, Opts1).
 1274table_options(shared, Opts0, Opts1) :-
 1275    !,
 1276    put_dict(tshared, Opts0, true, Opts1).
 1277table_options(private, Opts0, Opts1) :-
 1278    !,
 1279    put_dict(tshared, Opts0, false, Opts1).
 1280table_options(max_answers(Count), Opts0, Opts1) :-
 1281    !,
 1282    restraint(max_answers, Count, Opts0, Opts1).
 1283table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1284    !,
 1285    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1286table_options(answer_abstract(Size), Opts0, Opts1) :-
 1287    !,
 1288    restraint(answer_abstract, Size, Opts0, Opts1).
 1289table_options(Opt, _, _) :-
 1290    '$domain_error'(table_option, Opt).
 1291
 1292restraint(Name, Value0, Opts0, Opts) :-
 1293    '$table_option'(Value0, Value),
 1294    (   Value < 0
 1295    ->  Opts = Opts0
 1296    ;   put_dict(Name, Opts0, Value, Opts)
 1297    ).
 mode_check(+Moded, -TestCode)
Enforce the output arguments of a mode-directed tabled predicate to be unbound.
 1305mode_check(Moded, Check) :-
 1306    var(Moded),
 1307    !,
 1308    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1309mode_check(Moded, true) :-
 1310    '$tbl_trienode'(Moded),
 1311    !.
 1312mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1313    Moded =.. [s|Vars],
 1314    var_check(Vars, Test).
 1315
 1316var_check([H|T], Test) :-
 1317    (   T == []
 1318    ->  Test = var(H)
 1319    ;   Test = (var(H),Rest),
 1320        var_check(T, Rest)
 1321    ).
 1322
 1323:- public
 1324    instantiated_moded_arg/1. 1325
 1326instantiated_moded_arg(Vars) :-
 1327    '$member'(V, Vars),
 1328    \+ var(V),
 1329    '$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,...)
 1341extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1342    compound(ModeSpec),
 1343    !,
 1344    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1345    compound_name_arguments(Head, Name, HeadArgs),
 1346    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1347    length(ModedArgs, Count),
 1348    atomic_list_concat([$,Name,$,Count], VName),
 1349    Variant =.. [VName|VariantArgs],
 1350    (   ModedArgs == []
 1351    ->  '$tbl_trienode'(ModedAnswer)
 1352    ;   ModedArgs = [ModedAnswer]
 1353    ->  true
 1354    ;   ModedAnswer =.. [s|ModedArgs]
 1355    ).
 1356extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1357    atomic_list_concat([$,Atom,$,0], Variant),
 1358    '$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?
 1368separate_args([], [], [], [], []).
 1369separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1370    indexed_mode(HM),
 1371    !,
 1372    separate_args(TM, TA, TNA, Modes, TMA).
 1373separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1374    separate_args(TM, TA, TNA, Modes, TMA).
 1375
 1376indexed_mode(Mode) :-                           % XSB
 1377    var(Mode),
 1378    !.
 1379indexed_mode(index).                            % YAP
 1380indexed_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.
 1387updater_clauses([], _, []) :- !.
 1388updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1389    update_goal(P, S0,S1,S2, Body).
 1390updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1391    length(Modes, Len),
 1392    functor(S0, s, Len),
 1393    functor(S1, s, Len),
 1394    functor(S2, s, Len),
 1395    S0 =.. [_|Args0],
 1396    S1 =.. [_|Args1],
 1397    S2 =.. [_|Args2],
 1398    update_body(Modes, Args0, Args1, Args2, true, Body).
 1399
 1400update_body([], _, _, _, Body, Body).
 1401update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1402    update_goal(P, A0,A1,A2, Goal),
 1403    mkconj(Body0, Goal, Body1),
 1404    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1405
 1406update_goal(Var, _,_,_, _) :-
 1407    var(Var),
 1408    !,
 1409    '$instantiation_error'(Var).
 1410update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1411    !,
 1412    '$must_be'(atom, M),
 1413    update_goal(lattice(PI), S0,S1,S2, Goal).
 1414update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1415    !,
 1416    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1417    '$must_be'(atom, Name),
 1418    Goal =.. [Name,S0,S1,S2].
 1419update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1420    compound(Head),
 1421    !,
 1422    compound_name_arity(Head, Name, Arity),
 1423    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1424    Goal =.. [Name,S0,S1,S2].
 1425update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1426    !,
 1427    '$must_be'(atom, Name),
 1428    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1429update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1430    !,
 1431    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1432    '$must_be'(atom, Name),
 1433    Call =.. [Name, S0, S1],
 1434    Goal = (Call -> S2 = S0 ; S2 = S1).
 1435update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1436    !,
 1437    '$must_be'(atom, M),
 1438    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1439    '$must_be'(atom, Name),
 1440    Call =.. [Name, S0, S1],
 1441    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1442update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1443    !,
 1444    '$must_be'(atom, M),
 1445    '$must_be'(atom, Name),
 1446    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1447update_goal(po(Name), S0,S1,S2, Goal) :-
 1448    !,
 1449    '$must_be'(atom, Name),
 1450    update_goal(po(Name/2), S0,S1,S2, Goal).
 1451update_goal(Alias, S0,S1,S2, Goal) :-
 1452    update_alias(Alias, Update),
 1453    !,
 1454    update_goal(Update, S0,S1,S2, Goal).
 1455update_goal(Mode, _,_,_, _) :-
 1456    '$domain_error'(tabled_mode, Mode).
 1457
 1458update_alias(first, lattice('$tabling':first/3)).
 1459update_alias(-,     lattice('$tabling':first/3)).
 1460update_alias(last,  lattice('$tabling':last/3)).
 1461update_alias(min,   lattice('$tabling':min/3)).
 1462update_alias(max,   lattice('$tabling':max/3)).
 1463update_alias(sum,   lattice('$tabling':sum/3)).
 1464
 1465mkconj(true, G,  G) :- !.
 1466mkconj(G1,   G2, (G1,G2)).
 1467
 1468
 1469		 /*******************************
 1470		 *          AGGREGATION		*
 1471		 *******************************/
 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.
 1481:- public first/3, last/3, min/3, max/3, sum/3. 1482
 1483first(S, _, S).
 1484last(_, S, S).
 1485min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1486max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1487sum(S0, S1, S) :- S is S0+S1.
 1488
 1489
 1490		 /*******************************
 1491		 *      DYNAMIC PREDICATES	*
 1492		 *******************************/
 $set_table_wrappers(:Head)
Clear/add wrappers and notifications to trap dynamic predicates. This is required both for incremental and monotonic tabling.
 1499'$set_table_wrappers'(Pred) :-
 1500    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1501        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1502    ->  wrap_incremental(Pred)
 1503    ;   unwrap_incremental(Pred)
 1504    ),
 1505    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1506    ->  wrap_monotonic(Pred)
 1507    ;   unwrap_monotonic(Pred)
 1508    ).
 1509
 1510		 /*******************************
 1511		 *       MONOTONIC TABLING	*
 1512		 *******************************/
 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.
 1519mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1520    '$idg_add_mono_dyn_dep'(Dynamic,
 1521                            dependency(Dynamic, Cont, Skel),
 1522                            ATrie).
 1523mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1524    '$idg_add_monotonic_dep'(SrcTrie,
 1525                             dependency(SrcSkel, IsMono, Cont, Skel),
 1526                             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.
 1536monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1537    '$idg_mono_affects'(SrcTrie, ATrie,
 1538                        dependency(SrcSkel, IsMono, Cont, Skel)).
 monotonic_dyn_affects(:Head, -Continuation, -Return, -ATrie)
Dynamic predicate that maintains the dependency from a monotonic
 1544monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1545    dyn_affected(Head, DTrie),
 1546    '$idg_mono_affects'(DTrie, ATrie,
 1547                        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.
 1555wrap_monotonic(Head) :-
 1556    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1557                      '$start_monotonic'(Head, Wrapped)),
 1558    '$pi_head'(PI, Head),
 1559    prolog_listen(PI, monotonic_update).
 unwrap_monotonic(+Head)
Remove the monotonic wrappers and dependencies.
 1565unwrap_monotonic(Head) :-
 1566    '$pi_head'(PI, Head),
 1567    (   unwrap_predicate(PI, monotonic)
 1568    ->  prolog_unlisten(PI, monotonic_update)
 1569    ;   true
 1570    ).
 1571
 1572'$start_monotonic'(Head, Wrapped) :-
 1573    (   '$tbl_collect_mono_dep'
 1574    ->  shift(dependency(Head)),
 1575        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1576        Wrapped,
 1577        tdebug(monotonic, '  --> ~p', [Head])
 1578    ;   Wrapped
 1579    ).
 1580
 1581monotonic_update(Action, ClauseRef) :-
 1582    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1583    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1584        mon_propagate(Action, Head)
 1585    ;   true
 1586    ).
 mon_propagate(+Action, +Head)
Handle changes to a dynamic predicate as part of monotonic updates.
 1593mon_propagate(Action, Head) :-
 1594    assert_action(Action),
 1595    !,
 1596    setup_call_cleanup(
 1597        '$tbl_propagate_start'(Old),
 1598        propagate_assert(Head),
 1599        '$tbl_propagate_end'(Old)).
 1600mon_propagate(retract, Head) :-
 1601    !,
 1602    mon_abolish_dependents(Head).
 1603mon_propagate(rollback(Action), Head) :-
 1604    mon_propagate_rollback(Action, Head).
 1605
 1606mon_propagate_rollback(Action, _Head) :-
 1607    assert_action(Action),
 1608    !.
 1609mon_propagate_rollback(retract, Head) :-
 1610    mon_abolish_dependents(Head).
 1611
 1612assert_action(asserta).
 1613assert_action(assertz).
 propagate_assert(+Head) is det
Propagate assertion of a dynamic clause with head Head.
 1619propagate_assert(Head) :-
 1620    tdebug(monotonic, 'Asserted ~p', [Head]),
 1621    (   monotonic_dyn_affects(Head, Cont, Skel, ATrie),
 1622        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1623        pdelim(Cont, Skel, ATrie),
 1624        fail
 1625    ;   true
 1626    ).
 propagate_answer(+SrcTrie, +SrcSkel) is det
Propagate the new answer SrcSkel to the answer table SrcTrie.
 1632propagate_answer(SrcTrie, SrcSkel) :-
 1633    (   monotonic_affects(SrcTrie, SrcSkel, true, Cont, Skel, ATrie),
 1634        tdebug(monotonic, 'Propagating tab ~p to ~p', [SrcTrie, ATrie]),
 1635        pdelim(Cont, Skel, ATrie),
 1636        fail
 1637    ;   true
 1638    ).
 pdelim(+Worker, +Skel, +ATrie)
Call Worker (a continuation) and add each binding it provides for Skel to ATrie. If a new answer is added to ATrie, using propagate_answer/2 to propagate this further. Note that we may hit new dependencies and thus we need to run this using reset/3.
To be done
- Not sure whether we need full tabling here. Need to think of test cases.
 1650pdelim(Worker, Skel, ATrie) :-
 1651    reset(Worker, Dep, Cont),
 1652    (   Cont == 0
 1653    ->  '$tbl_monotonic_add_answer'(ATrie, Skel),
 1654        propagate_answer(ATrie, Skel)
 1655    ;   mon_assert_dep(Dep, Cont, Skel, ATrie),
 1656        pdelim(Cont, Skel, ATrie)
 1657    ).
 mon_abolish_dependents(+HeadOrTrie)
Abolish all dependency relations from HeadOrTrie and their tables.
To be done
- We could also consider marking them as invalid and let normal incremental tabling deal with this situation?
 1666mon_abolish_dependents(Node) :-
 1667    dependent_tables([Node], [], Tables),
 1668    forall('$member'(ATrie, Tables),
 1669           '$tbl_destroy_table'(ATrie)).
 1670
 1671dependent_tables([], Tables, Tables) :-
 1672    !.
 1673dependent_tables([Node|T], Tables0, Tables) :-
 1674    (   is_trie(Node)
 1675    ->  findall(ATrie,
 1676                monotonic_affects(Node, _Ret0, _IsMono, _ContinuationT, _RetT, ATrie),
 1677                Tries)
 1678    ;   findall(ATrie,
 1679                monotonic_dyn_affects(Node, _ContinuationD, _RetD, ATrie),
 1680                Tries)
 1681    ),
 1682    sort(Tries, STries),
 1683    ord_subtract(STries, Tables0, New),
 1684    ord_union(T, New, Agenda),
 1685    ord_union(New, Tables0, Tables1),
 1686    dependent_tables(Agenda, Tables1, Tables).
 ord_subtract(+InOSet, +NotInOSet, -Diff)
ordered set difference
 1692ord_subtract([], _Not, []).
 1693ord_subtract([H1|T1], L2, Diff) :-
 1694    diff21(L2, H1, T1, Diff).
 1695
 1696diff21([], H1, T1, [H1|T1]).
 1697diff21([H2|T2], H1, T1, Diff) :-
 1698    compare(Order, H1, H2),
 1699    diff3(Order, H1, T1, H2, T2, Diff).
 1700
 1701diff12([], _H2, _T2, []).
 1702diff12([H1|T1], H2, T2, Diff) :-
 1703    compare(Order, H1, H2),
 1704    diff3(Order, H1, T1, H2, T2, Diff).
 1705
 1706diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1707    diff12(T1, H2, T2, Diff).
 1708diff3(=, _H1, T1, _H2, T2, Diff) :-
 1709    ord_subtract(T1, T2, Diff).
 1710diff3(>,  H1, T1, _H2, T2, Diff) :-
 1711    diff21(T2, H1, T1, Diff).
 ord_union(+OSet1, +OSet2, -Union)
 1715ord_union([], Union, Union).
 1716ord_union([H1|T1], L2, Union) :-
 1717    union2(L2, H1, T1, Union).
 1718
 1719union2([], H1, T1, [H1|T1]).
 1720union2([H2|T2], H1, T1, Union) :-
 1721    compare(Order, H1, H2),
 1722    union3(Order, H1, T1, H2, T2, Union).
 1723
 1724union3(<, H1, T1,  H2, T2, [H1|Union]) :-
 1725    union2(T1, H2, T2, Union).
 1726union3(=, H1, T1, _H2, T2, [H1|Union]) :-
 1727    ord_union(T1, T2, Union).
 1728union3(>, H1, T1,  H2, T2, [H2|Union]) :-
 1729    union2(T2, H1, T1, Union).
 abolish_monotonic_tables
Abolish all monotonic tables and the monotonic dependency relations.
 1735abolish_monotonic_tables :-
 1736    (   '$tbl_variant_table'(VariantTrie),
 1737        trie_gen(VariantTrie, Goal, ATrie),
 1738        '$get_predicate_attribute'(Goal, monotonic, 1),
 1739        '$tbl_destroy_table'(ATrie),
 1740        fail
 1741    ;   true
 1742    ).
 1743
 1744		 /*******************************
 1745		 *      INCREMENTAL TABLING	*
 1746		 *******************************/
 wrap_incremental(:Head) is det
Wrap an incremental dynamic predicate to be added to the IDG.
 1752wrap_incremental(Head) :-
 1753    tdebug(monotonic, 'Wrapping ~p', [Head]),
 1754    abstract_goal(Head, Abstract),
 1755    '$pi_head'(PI, Head),
 1756    (   Head == Abstract
 1757    ->  prolog_listen(PI, dyn_update)
 1758    ;   prolog_listen(PI, dyn_update(Abstract))
 1759    ).
 1760
 1761abstract_goal(M:Head, M:Abstract) :-
 1762    compound(Head),
 1763    '$get_predicate_attribute'(M:Head, abstract, 1),
 1764    !,
 1765    compound_name_arity(Head, Name, Arity),
 1766    functor(Abstract, Name, Arity).
 1767abstract_goal(Head, Head).
 dyn_update(+Action, +Context) is det
Track changes to added or removed clauses. We use '$clause'/4 because it works on erased clauses.
To be done
- Add a '$clause_head'(-Head, +ClauseRef) to only decompile the head.
 1777dyn_update(_Action, ClauseRef) :-
 1778    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1779    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1780        dyn_changed_pattern(Head)
 1781    ;   true
 1782    ).
 1783
 1784dyn_update(Abstract, _, _) :-
 1785    dyn_changed_pattern(Abstract).
 1786
 1787dyn_changed_pattern(Term) :-
 1788    forall(dyn_affected(Term, ATrie),
 1789           '$idg_changed'(ATrie)).
 1790
 1791dyn_affected(Term, ATrie) :-
 1792    '$tbl_variant_table'(VTable),
 1793    trie_gen(VTable, Term, ATrie).
 unwrap_incremental(:Head) is det
Remove dynamic predicate incremenal forwarding, reset the possible abstract property and remove possible tables.
 1800unwrap_incremental(Head) :-
 1801    '$pi_head'(PI, Head),
 1802    abstract_goal(Head, Abstract),
 1803    (   Head == Abstract
 1804    ->  prolog_unlisten(PI, dyn_update)
 1805    ;   '$set_predicate_attribute'(Head, abstract, 0),
 1806        prolog_unlisten(PI, dyn_update(_))
 1807    ),
 1808    (   '$tbl_variant_table'(VariantTrie)
 1809    ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1810               '$tbl_destroy_table'(ATrie))
 1811    ;   true
 1812    ).
 reeval(+ATrie, :Goal, ?Return) is nondet
Called if the table ATrie is out-of-date (has non-zero falsecount). The answers of this predicate are the answers to Goal after re-evaluating the answer trie.

This finds all dependency paths to dynamic predicates and then evaluates the nodes in a breath-first fashion starting at the level just above the dynamic predicates and moving upwards. Bottom up evaluation is used to profit from upward propagation of not-modified events that may cause the evaluation to stop early.

Note that false paths either end in a dynamic node or a complete node. The latter happens if we have and IDG "D -> P -> Q" and we first re-evaluate P for some reason. Now Q can still be invalid after P has been re-evaluated.

Arguments:
ATrie- is the answer trie. When shared tabling, we own this trie.
Goal- is tabled goal (variant). If we run into a deadlock we need to call this.
Return- is the return skeleton. We must run trie_gen_compiled(ATrie, Return) to enumerate the answers
 1838reeval(ATrie, Goal, Return) :-
 1839    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1840          retry_reeval(ATrie, Goal)).
 1841
 1842retry_reeval(ATrie, Goal) :-
 1843    '$tbl_reeval_abandon'(ATrie),
 1844    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1845    sleep(0.000001),
 1846    call(Goal).
 1847
 1848try_reeval(ATrie, Goal, Return) :-
 1849    nb_current('$tbl_reeval', true),
 1850    !,
 1851    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1852    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1853    (   nonvar(Clause)
 1854    ->  trie_gen_compiled(Clause, Return)
 1855    ;   call(Goal)
 1856    ).
 1857try_reeval(ATrie, Goal, Return) :-
 1858    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1859    findall(Path, false_path(ATrie, Path), Paths0),
 1860    sort(0, @>, Paths0, Paths),
 1861    split_paths(Paths, Dynamic, Complete),
 1862    tdebug(forall('$member'(Path, Dynamic),
 1863                  tdebug(reeval, '  Re-eval dynamic path: ~p', [Path]))),
 1864    tdebug(forall('$member'(Path, Complete),
 1865                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1866    reeval_paths(Dynamic, ATrie),
 1867    reeval_paths(Complete, ATrie),
 1868    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1869    (   nonvar(Clause)
 1870    ->  trie_gen_compiled(Clause, Return)
 1871    ;   call(Goal)
 1872    ).
 1873
 1874split_paths([], [], []).
 1875split_paths([[Rank-_Len|Path]|T], [Path|DT], CT) :-
 1876    status_rank(dynamic, Rank),
 1877    !,
 1878    split_paths(T, DT, CT).
 1879split_paths([[_|Path]|T], DT, [Path|CT]) :-
 1880    split_paths(T, DT, CT).
 1881
 1882reeval_paths([], _) :-
 1883    !.
 1884reeval_paths(BottomUp, ATrie) :-
 1885    is_invalid(ATrie),
 1886    !,
 1887    reeval_heads(BottomUp, ATrie, BottomUp1),
 1888    reeval_paths(BottomUp1, ATrie).
 1889reeval_paths(_, _).
 1890
 1891reeval_heads(_, ATrie, _) :-
 1892    \+ is_invalid(ATrie),
 1893    !.
 1894reeval_heads([], _, []).
 1895reeval_heads([[H]|B], ATrie, BT) :-
 1896    !,
 1897    reeval_node(H),
 1898    reeval_heads(B, ATrie, BT).
 1899reeval_heads([[]|B], ATrie, BT) :-
 1900    !,
 1901    reeval_heads(B, ATrie, BT).
 1902reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1903    !,
 1904    reeval_node(H),
 1905    reeval_heads(B, ATrie, BT).
 false_path(+Atrie, -Path) is nondet
True when Path is a list of invalid tries (bottom up, ending with ATrie). The last element of the list is a term Rank-Length that is used for sorting the paths.

If we find a table along the way that is being worked on by some other thread we wait for it.

 1916false_path(ATrie, BottomUp) :-
 1917    false_path(ATrie, Path, []),
 1918    '$reverse'(Path, BottomUp).
 1919
 1920false_path(ATrie, [ATrie|T], Seen) :-
 1921    \+ memberchk(ATrie, Seen),
 1922    '$idg_edge'(ATrie, dependent, Dep),
 1923    '$tbl_reeval_wait'(Dep, Status),
 1924    tdebug(reeval, '    ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
 1925    (   Status == invalid
 1926    ->  false_path(Dep, T, [ATrie|Seen])
 1927    ;   status_rank(Status, Rank),
 1928        length(Seen, Len),
 1929        T = [Rank-Len]
 1930    ).
 1931
 1932status_rank(dynamic,   2) :- !.
 1933status_rank(monotonic, 2) :- !.
 1934status_rank(complete,  1) :- !.
 1935status_rank(Status,    Rank) :-
 1936    var(Rank),
 1937    !,
 1938    format(user_error, 'Re-eval from status ~p~n', [Status]),
 1939    Rank = 0.
 1940status_rank(Rank,   Rank) :-
 1941    format(user_error, 'Re-eval from rank ~p~n', [Rank]).
 1942
 1943is_invalid(ATrie) :-
 1944    '$idg_falsecount'(ATrie, FalseCount),
 1945    FalseCount > 0.
 reeval_node(+ATrie)
Re-evaluate the invalid answer trie ATrie. Initially this created a nested tabling environment, but this is dropped:
 1958reeval_node(ATrie) :-
 1959    '$tbl_reeval_prepare'(ATrie, Variant, Clause),
 1960    var(Clause),
 1961    !,
 1962    tdebug(reeval, 'Re-evaluating ~p', [Variant]),
 1963    (   '$idg_reset_current',
 1964        setup_call_cleanup(
 1965            nb_setval('$tbl_reeval', true),
 1966            ignore(Variant),                    % assumes local scheduling
 1967            nb_delete('$tbl_reeval')),
 1968        fail
 1969    ;   tdebug(reeval, 'Re-evaluated ~p', [Variant])
 1970    ).
 1971reeval_node(_).
 1972
 1973
 1974		 /*******************************
 1975		 *      EXPAND DIRECTIVES	*
 1976		 *******************************/
 1977
 1978system:term_expansion((:- table(Preds)), Expansion) :-
 1979    \+ current_prolog_flag(xref, true),
 1980    prolog_load_context(module, M),
 1981    phrase(wrappers(Preds, M), Clauses),
 1982    multifile_decls(Clauses, Directives0),
 1983    sort(Directives0, Directives),
 1984    '$append'(Directives, Clauses, Expansion).
 1985
 1986multifile_decls([], []).
 1987multifile_decls([H0|T0], [H|T]) :-
 1988    multifile_decl(H0, H),
 1989    !,
 1990    multifile_decls(T0, T).
 1991multifile_decls([_|T0], T) :-
 1992    multifile_decls(T0, T).
 1993
 1994multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 1995    !,
 1996    functor(Head, Name, Arity).
 1997multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 1998    !,
 1999    functor(Head, Name, Arity).
 2000multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 2001    !,
 2002    functor(Head, Name, Arity).
 2003multifile_decl(Head, (:- multifile(Name/Arity))) :-
 2004    !,
 2005    Head \= (:-_),
 2006    functor(Head, Name, Arity).
 2007
 2008
 2009		 /*******************************
 2010		 *      ANSWER COMPLETION	*
 2011		 *******************************/
 2012
 2013:- public answer_completion/2.
 answer_completion(+AnswerTrie, +Return) is det
Find positive loops in the residual program and remove the corresponding answers, possibly causing additional simplification. This is called from C if simplify_component() detects there are conditional answers after simplification.

Note that we are called recursively from C. Our caller prepared a clean new tabling environment and restores the old one after this predicate terminates.

author
- This code is by David Warren as part of XSB.
See also
- called from C, pl-tabling.c, answer_completion()
 2029answer_completion(AnswerTrie, Return) :-
 2030    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 2031    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 2032    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 2033                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 2034    (   Propagated > 0
 2035    ->  answer_completion(AnswerTrie, Return)
 2036    ;   true
 2037    ).
 2038
 2039answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 2040    (   eval_subgoal_in_residual(AnswerTrie, Return),
 2041        fail
 2042    ;   true
 2043    ),
 2044    delete_answers_for_failing_calls(Propagated),
 2045    (   Propagated == 0
 2046    ->  mark_succeeding_calls_as_answer_completed
 2047    ;   true
 2048    ).
 delete_answers_for_failing_calls(-Propagated)
Delete answers whose condition is determined to be false and return the number of additional answers that changed status as a consequence of additional simplification propagation.
 2056delete_answers_for_failing_calls(Propagated) :-
 2057    State = state(0),
 2058    (   subgoal_residual_trie(ASGF, ESGF),
 2059        \+ trie_gen(ESGF, _ETmp),
 2060        tdebug(trie_goal(ASGF, Goal0, _)),
 2061        tdebug(trie_goal(ASGF, Goal, _0Return)),
 2062        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 2063        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 2064	'$tbl_force_truth_value'(ALeaf, false, Count),
 2065        arg(1, State, Prop0),
 2066        Prop is Prop0+Count-1,
 2067        nb_setarg(1, State, Prop),
 2068	fail
 2069    ;   arg(1, State, Propagated)
 2070    ).
 2071
 2072mark_succeeding_calls_as_answer_completed :-
 2073    (   subgoal_residual_trie(ASGF, _ESGF),
 2074        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 2075        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 2076            tdebug(trie_goal(ASGF, Goal, _0Return)),
 2077            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 2078            '$tbl_set_answer_completed'(ASGF)
 2079        ),
 2080        fail
 2081    ;   true
 2082    ).
 2083
 2084subgoal_residual_trie(ASGF, ESGF) :-
 2085    '$tbl_variant_table'(VariantTrie),
 2086    context_module(M),
 2087    trie_gen(VariantTrie, M:eval_subgoal_in_residual(ASGF, _), ESGF).
 eval_dl_in_residual(+Condition)
Evaluate a condition by only looking at the residual goals of the involved calls.
 2094eval_dl_in_residual(true) :-
 2095    !.
 2096eval_dl_in_residual((A;B)) :-
 2097    !,
 2098    (   eval_dl_in_residual(A)
 2099    ;   eval_dl_in_residual(B)
 2100    ).
 2101eval_dl_in_residual((A,B)) :-
 2102    !,
 2103    eval_dl_in_residual(A),
 2104    eval_dl_in_residual(B).
 2105eval_dl_in_residual(tnot(G)) :-
 2106    !,
 2107    tdebug(ac, ' ? tnot(~p)', [G]),
 2108    current_table(G, SGF),
 2109    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2110    tnot(eval_subgoal_in_residual(SGF, Return)).
 2111eval_dl_in_residual(G) :-
 2112    tdebug(ac, ' ? ~p', [G]),
 2113    (   current_table(G, SGF)
 2114    ->	true
 2115    ;   more_general_table(G, SGF)
 2116    ->	true
 2117    ;	writeln(user_error, 'MISSING CALL? '(G)),
 2118        fail
 2119    ),
 2120    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2121    eval_subgoal_in_residual(SGF, Return).
 2122
 2123more_general_table(G, Trie) :-
 2124    term_variables(G, Vars),
 2125    '$tbl_variant_table'(VariantTrie),
 2126    trie_gen(VariantTrie, G, Trie),
 2127    is_most_general_term(Vars).
 2128
 2129:- table eval_subgoal_in_residual/2.
 eval_subgoal_in_residual(+AnswerTrie, ?Return)
Derive answers for the variant represented by AnswerTrie based on the residual goals only.
 2136eval_subgoal_in_residual(AnswerTrie, _Return) :-
 2137    '$tbl_is_answer_completed'(AnswerTrie),
 2138    !,
 2139    undefined.
 2140eval_subgoal_in_residual(AnswerTrie, Return) :-
 2141    '$tbl_answer'(AnswerTrie, Return, Condition),
 2142    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 2143    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 2144    eval_dl_in_residual(Condition).
 2145
 2146
 2147		 /*******************************
 2148		 *            TRIPWIRES		*
 2149		 *******************************/
 tripwire(+Wire, +Action, +Context)
Called from the tabling engine of some tripwire is exceeded and the situation is not handled internally (such as abstract and bounded_rationality.
 2157:- public tripwire/3. 2158:- multifile prolog:tripwire/2. 2159
 2160tripwire(Wire, _Action, Context) :-
 2161    prolog:tripwire(Wire, Context),
 2162    !.
 2163tripwire(Wire, Action, Context) :-
 2164    Error = error(resource_error(tripwire(Wire, Context)), _),
 2165    tripwire_action(Action, Error).
 2166
 2167tripwire_action(warning, Error) :-
 2168    print_message(warning, Error).
 2169tripwire_action(error, Error) :-
 2170    throw(Error).
 2171tripwire_action(suspend, Error) :-
 2172    print_message(warning, Error),
 2173    break.
 2174
 2175
 2176		 /*******************************
 2177		 *   SYSTEM TABLED PREDICATES	*
 2178		 *******************************/
 2179
 2180:- table
 2181    system:undefined/0,
 2182    system:answer_count_restraint/0,
 2183    system:radial_restraint/0,
 2184    system:tabled_call/1.
 undefined is undefined
Expresses the value bottom from the well founded semantics.
 2190system:(undefined :-
 2191    tnot(undefined)).
 answer_count_restraint is undefined
 radial_restraint is undefined
Similar to undefined/0, providing a specific undefined for restraint violations.
 2199system:(answer_count_restraint :-
 2200    tnot(answer_count_restraint)).
 2201
 2202system:(radial_restraint :-
 2203    tnot(radial_restraint)).
 2204
 2205system:(tabled_call(X) :- call(X))