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).
 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.
  340start_tabling(Closure, Wrapper, Worker) :-
  341    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton, IsMono),
  342    (   IsMono == true
  343    ->  shift(dependency(Skeleton, Trie, Mono)),
  344        (   Mono == true
  345        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  346        ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  347        )
  348    ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  349    ).
  350
  351start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
  352    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  353    (   Status == complete
  354    ->  trie_gen_compiled(Trie, Skeleton)
  355    ;   functor(Status, fresh, 2)
  356    ->  catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
  357              deadlock,
  358              restart_tabling(Closure, Wrapper, Worker))
  359    ;   Status == invalid
  360    ->  reeval(Trie, Wrapper, Skeleton)
  361    ;   % = run_follower, but never fresh and Status is a worklist
  362        shift(call_info(Skeleton, Status))
  363    ).
  364
  365create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
  366    tdebug(Fresh = fresh(SCC, WorkList)),
  367    tdebug(wl_goal(WorkList, Goal, _)),
  368    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  369    setup_call_catcher_cleanup(
  370        '$idg_set_current'(OldCurrent, Trie),
  371        run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
  372        Catcher,
  373        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  374    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  375    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.
  385restart_tabling(Closure, Wrapper, Worker) :-
  386    tdebug(user_goal(Wrapper, Goal)),
  387    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  388    sleep(0.000001),
  389    start_tabling(Closure, Wrapper, Worker).
  390
  391restart_abstract_tabling(Closure, Wrapper, Worker) :-
  392    tdebug(user_goal(Wrapper, Goal)),
  393    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  394    sleep(0.000001),
  395    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.
  407start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  408    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  409    ->  (   Status == complete
  410        ->  trie_gen_compiled(Trie, Skeleton)
  411        ;   Status == invalid
  412        ->  reeval(Trie, Wrapper, Skeleton),
  413            trie_gen_compiled(Trie, Skeleton)
  414        ;   shift(call_info(Skeleton, Status))
  415        )
  416    ;   more_general_table(Wrapper, ATrie),
  417        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  418    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  419    ;   more_general_table(Wrapper, ATrie),
  420        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  421    ->  (   Status == invalid
  422        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  423            Wrapper = GenWrapper,
  424            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  425        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  426            shift(call_info(GenSkeleton, Skeleton, Status)),
  427            unify_subsumptive(Skeleton, GenSkeleton)
  428        )
  429    ;   start_tabling(Closure, Wrapper, Worker)
  430    ).
 wrapper_skeleton(+GenWrapper, +GenSkeleton, +Wrapper, -Skeleton)
Skeleton is a specialized version of GenSkeleton for the subsumed new consumer.
  437wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  438    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  439    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  440           [GenSkeleton+Skeleton]).
  441
  442unify_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))

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

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

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

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

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

  978abolish_all_tables :-
  979    (   '$tbl_abolish_local_tables'
  980    ->  true
  981    ;   true
  982    ),
  983    (   '$tbl_variant_table'(VariantTrie),
  984        trie_gen(VariantTrie, _, Trie),
  985        '$tbl_destroy_table'(Trie),
  986        fail
  987    ;   true
  988    ).
  989
  990abolish_private_tables :-
  991    (   '$tbl_abolish_local_tables'
  992    ->  true
  993    ;   (   '$tbl_local_variant_table'(VariantTrie),
  994            trie_gen(VariantTrie, _, Trie),
  995            '$tbl_destroy_table'(Trie),
  996            fail
  997        ;   true
  998        )
  999    ).
 1000
 1001abolish_shared_tables :-
 1002    (   '$tbl_global_variant_table'(VariantTrie),
 1003        trie_gen(VariantTrie, _, Trie),
 1004        '$tbl_destroy_table'(Trie),
 1005        fail
 1006    ;   true
 1007    ).
 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?
 1016abolish_table_subgoals(SubGoal0) :-
 1017    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1018    !,
 1019    '$must_be'(acyclic, SubGoal),
 1020    (   '$tbl_variant_table'(VariantTrie),
 1021        trie_gen(VariantTrie, M:SubGoal, Trie),
 1022        '$tbl_destroy_table'(Trie),
 1023        fail
 1024    ;   true
 1025    ).
 1026abolish_table_subgoals(_).
 abolish_module_tables(+Module) is det
Abolish all tables for predicates associated with the given module.
 1032abolish_module_tables(Module) :-
 1033    '$must_be'(atom, Module),
 1034    '$tbl_variant_table'(VariantTrie),
 1035    current_module(Module),
 1036    !,
 1037    forall(trie_gen(VariantTrie, Module:_, Trie),
 1038           '$tbl_destroy_table'(Trie)).
 1039abolish_module_tables(_).
 abolish_nonincremental_tables is det
Abolish all tables that are not related to incremental predicates.
 1045abolish_nonincremental_tables :-
 1046    (   '$tbl_variant_table'(VariantTrie),
 1047        trie_gen(VariantTrie, _, Trie),
 1048        '$tbl_table_status'(Trie, Status, Goal, _),
 1049        (   Status == complete
 1050        ->  true
 1051        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1052        ),
 1053        \+ predicate_property(Goal, incremental),
 1054        '$tbl_destroy_table'(Trie),
 1055        fail
 1056    ;   true
 1057    ).
 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.
 1066abolish_nonincremental_tables(Options) :-
 1067    (   Options = on_incomplete(Action)
 1068    ->  Action == skip
 1069    ;   '$option'(on_incomplete(skip), Options)
 1070    ),
 1071    !,
 1072    (   '$tbl_variant_table'(VariantTrie),
 1073        trie_gen(VariantTrie, _, Trie),
 1074        '$tbl_table_status'(Trie, complete, Goal, _),
 1075        \+ predicate_property(Goal, incremental),
 1076        '$tbl_destroy_table'(Trie),
 1077        fail
 1078    ;   true
 1079    ).
 1080abolish_nonincremental_tables(_) :-
 1081    abolish_nonincremental_tables.
 1082
 1083
 1084                 /*******************************
 1085                 *        EXAMINE TABLES        *
 1086                 *******************************/
 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.
 1095current_table(Variant, Trie) :-
 1096    ct_generate(Variant),
 1097    !,
 1098    current_table_gen(Variant, Trie).
 1099current_table(Variant, Trie) :-
 1100    current_table_lookup(Variant, Trie),
 1101    !.
 1102
 1103current_table_gen(Variant, Trie) :-
 1104    '$tbl_local_variant_table'(VariantTrie),
 1105    trie_gen(VariantTrie, Variant, Trie).
 1106current_table_gen(Variant, Trie) :-
 1107    '$tbl_global_variant_table'(VariantTrie),
 1108    trie_gen(VariantTrie, Variant, Trie),
 1109    \+ '$tbl_table_status'(Trie, fresh). % shared tables are not destroyed
 1110
 1111current_table_lookup(Variant, Trie) :-
 1112    '$tbl_local_variant_table'(VariantTrie),
 1113    trie_lookup(VariantTrie, Variant, Trie).
 1114current_table_lookup(Variant, Trie) :-
 1115    '$tbl_global_variant_table'(VariantTrie),
 1116    trie_lookup(VariantTrie, Variant, Trie),
 1117    \+ '$tbl_table_status'(Trie, fresh).
 1118
 1119ct_generate(M:Variant) :-
 1120    (   var(Variant)
 1121    ->  true
 1122    ;   var(M)
 1123    ).
 1124
 1125                 /*******************************
 1126                 *      WRAPPER GENERATION      *
 1127                 *******************************/
 1128
 1129:- multifile
 1130    system:term_expansion/2,
 1131    tabled/2. 1132:- dynamic
 1133    system:term_expansion/2. 1134
 1135wrappers(Spec, M) -->
 1136    { tabling_defaults(
 1137          [ (table_incremental=true)            - (incremental=true),
 1138            (table_shared=true)                 - (tshared=true),
 1139            (table_subsumptive=true)            - ((mode)=subsumptive),
 1140            call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
 1141          ],
 1142          #{}, Defaults)
 1143    },
 1144    wrappers(Spec, M, Defaults).
 1145
 1146wrappers(Var, _, _) -->
 1147    { var(Var),
 1148      !,
 1149      '$instantiation_error'(Var)
 1150    }.
 1151wrappers(M:Spec, _, Opts) -->
 1152    !,
 1153    { '$must_be'(atom, M) },
 1154    wrappers(Spec, M, Opts).
 1155wrappers(Spec as Options, M, Opts0) -->
 1156    !,
 1157    { table_options(Options, Opts0, Opts) },
 1158    wrappers(Spec, M, Opts).
 1159wrappers((A,B), M, Opts) -->
 1160    !,
 1161    wrappers(A, M, Opts),
 1162    wrappers(B, M, Opts).
 1163wrappers(Name//Arity, M, Opts) -->
 1164    { atom(Name), integer(Arity), Arity >= 0,
 1165      !,
 1166      Arity1 is Arity+2
 1167    },
 1168    wrappers(Name/Arity1, M, Opts).
 1169wrappers(Name/Arity, Module, Opts) -->
 1170    { '$option'(mode(TMode), Opts, variant),
 1171      atom(Name), integer(Arity), Arity >= 0,
 1172      !,
 1173      functor(Head, Name, Arity),
 1174      '$tbl_trienode'(Reserved)
 1175    },
 1176    qualify(Module,
 1177            [ '$tabled'(Head, TMode),
 1178              '$table_mode'(Head, Head, Reserved)
 1179            ]),
 1180    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1181    ].
 1182wrappers(ModeDirectedSpec, Module, Opts) -->
 1183    { '$option'(mode(TMode), Opts, variant),
 1184      callable(ModeDirectedSpec),
 1185      !,
 1186      functor(ModeDirectedSpec, Name, Arity),
 1187      functor(Head, Name, Arity),
 1188      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1189      updater_clauses(Modes, Head, UpdateClauses),
 1190      mode_check(Moded, ModeTest),
 1191      (   ModeTest == true
 1192      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1193          TVariant = Head
 1194      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, ModeTest,
 1195                                            Module:Variant, Moded),
 1196          TVariant = Variant
 1197      )
 1198    },
 1199    qualify(Module,
 1200            [ '$tabled'(Head, TMode),
 1201              '$table_mode'(Head, TVariant, Moded)
 1202            ]),
 1203    [ (:- initialization(WrapClause, now))
 1204    ],
 1205    qualify(Module, UpdateClauses).
 1206wrappers(TableSpec, _M, _Opts) -->
 1207    { '$type_error'(table_desclaration, TableSpec)
 1208    }.
 1209
 1210qualify(Module, List) -->
 1211    { prolog_load_context(module, Module) },
 1212    !,
 1213    clist(List).
 1214qualify(Module, List) -->
 1215    qlist(List, Module).
 1216
 1217clist([])    --> [].
 1218clist([H|T]) --> [H], clist(T).
 1219
 1220qlist([], _)    --> [].
 1221qlist([H|T], M) --> [M:H], qlist(T, M).
 1222
 1223
 1224tabling_defaults([], Dict, Dict).
 1225tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
 1226    (   tabling_default(Condition)
 1227    ->  Dict1 = Dict0.put(Opt,Value)
 1228    ;   Dict1 = Dict0
 1229    ),
 1230    tabling_defaults(T, Dict1, Dict).
 1231
 1232tabling_default(Flag=FValue) :-
 1233    !,
 1234    current_prolog_flag(Flag, FValue).
 1235tabling_default(call(Term)) :-
 1236    call(Term).
 1237
 1238% Called from wrappers//2.
 1239
 1240subgoal_size_restraint(Level) :-
 1241    current_prolog_flag(max_table_subgoal_size_action, abstract),
 1242    current_prolog_flag(max_table_subgoal_size, Level).
 table_options(+Options, +OptDictIn, -OptDictOut)
Handler the ... as options ... construct.
 1248table_options(Options, _Opts0, _Opts) :-
 1249    var(Options),
 1250    '$instantiation_error'(Options).
 1251table_options((A,B), Opts0, Opts) :-
 1252    !,
 1253    table_options(A, Opts0, Opts1),
 1254    table_options(B, Opts1, Opts).
 1255table_options(subsumptive, Opts0, Opts1) :-
 1256    !,
 1257    put_dict(mode, Opts0, subsumptive, Opts1).
 1258table_options(variant, Opts0, Opts1) :-
 1259    !,
 1260    put_dict(mode, Opts0, variant, Opts1).
 1261table_options(incremental, Opts0, Opts1) :-
 1262    !,
 1263    put_dict(incremental, Opts0, true, Opts1).
 1264table_options(monotonic, Opts0, Opts1) :-
 1265    !,
 1266    put_dict(monotonic, Opts0, true, Opts1).
 1267table_options(opaque, Opts0, Opts1) :-
 1268    !,
 1269    put_dict(incremental, Opts0, false, Opts1).
 1270table_options(dynamic, Opts0, Opts1) :-
 1271    !,
 1272    put_dict(dynamic, Opts0, true, Opts1).
 1273table_options(shared, Opts0, Opts1) :-
 1274    !,
 1275    put_dict(tshared, Opts0, true, Opts1).
 1276table_options(private, Opts0, Opts1) :-
 1277    !,
 1278    put_dict(tshared, Opts0, false, Opts1).
 1279table_options(max_answers(Count), Opts0, Opts1) :-
 1280    !,
 1281    restraint(max_answers, Count, Opts0, Opts1).
 1282table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1283    !,
 1284    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1285table_options(answer_abstract(Size), Opts0, Opts1) :-
 1286    !,
 1287    restraint(answer_abstract, Size, Opts0, Opts1).
 1288table_options(Opt, _, _) :-
 1289    '$domain_error'(table_option, Opt).
 1290
 1291restraint(Name, Value0, Opts0, Opts) :-
 1292    '$table_option'(Value0, Value),
 1293    (   Value < 0
 1294    ->  Opts = Opts0
 1295    ;   put_dict(Name, Opts0, Value, Opts)
 1296    ).
 mode_check(+Moded, -TestCode)
Enforce the output arguments of a mode-directed tabled predicate to be unbound.
 1304mode_check(Moded, Check) :-
 1305    var(Moded),
 1306    !,
 1307    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1308mode_check(Moded, true) :-
 1309    '$tbl_trienode'(Moded),
 1310    !.
 1311mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1312    Moded =.. [s|Vars],
 1313    var_check(Vars, Test).
 1314
 1315var_check([H|T], Test) :-
 1316    (   T == []
 1317    ->  Test = var(H)
 1318    ;   Test = (var(H),Rest),
 1319        var_check(T, Rest)
 1320    ).
 1321
 1322:- public
 1323    instantiated_moded_arg/1. 1324
 1325instantiated_moded_arg(Vars) :-
 1326    '$member'(V, Vars),
 1327    \+ var(V),
 1328    '$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,...)
 1340extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1341    compound(ModeSpec),
 1342    !,
 1343    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1344    compound_name_arguments(Head, Name, HeadArgs),
 1345    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1346    length(ModedArgs, Count),
 1347    atomic_list_concat([$,Name,$,Count], VName),
 1348    Variant =.. [VName|VariantArgs],
 1349    (   ModedArgs == []
 1350    ->  '$tbl_trienode'(ModedAnswer)
 1351    ;   ModedArgs = [ModedAnswer]
 1352    ->  true
 1353    ;   ModedAnswer =.. [s|ModedArgs]
 1354    ).
 1355extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1356    atomic_list_concat([$,Atom,$,0], Variant),
 1357    '$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?
 1367separate_args([], [], [], [], []).
 1368separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1369    indexed_mode(HM),
 1370    !,
 1371    separate_args(TM, TA, TNA, Modes, TMA).
 1372separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1373    separate_args(TM, TA, TNA, Modes, TMA).
 1374
 1375indexed_mode(Mode) :-                           % XSB
 1376    var(Mode),
 1377    !.
 1378indexed_mode(index).                            % YAP
 1379indexed_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.
 1386updater_clauses([], _, []) :- !.
 1387updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1388    update_goal(P, S0,S1,S2, Body).
 1389updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1390    length(Modes, Len),
 1391    functor(S0, s, Len),
 1392    functor(S1, s, Len),
 1393    functor(S2, s, Len),
 1394    S0 =.. [_|Args0],
 1395    S1 =.. [_|Args1],
 1396    S2 =.. [_|Args2],
 1397    update_body(Modes, Args0, Args1, Args2, true, Body).
 1398
 1399update_body([], _, _, _, Body, Body).
 1400update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1401    update_goal(P, A0,A1,A2, Goal),
 1402    mkconj(Body0, Goal, Body1),
 1403    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1404
 1405update_goal(Var, _,_,_, _) :-
 1406    var(Var),
 1407    !,
 1408    '$instantiation_error'(Var).
 1409update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1410    !,
 1411    '$must_be'(atom, M),
 1412    update_goal(lattice(PI), S0,S1,S2, Goal).
 1413update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1414    !,
 1415    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1416    '$must_be'(atom, Name),
 1417    Goal =.. [Name,S0,S1,S2].
 1418update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1419    compound(Head),
 1420    !,
 1421    compound_name_arity(Head, Name, Arity),
 1422    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1423    Goal =.. [Name,S0,S1,S2].
 1424update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1425    !,
 1426    '$must_be'(atom, Name),
 1427    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1428update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1429    !,
 1430    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1431    '$must_be'(atom, Name),
 1432    Call =.. [Name, S0, S1],
 1433    Goal = (Call -> S2 = S0 ; S2 = S1).
 1434update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1435    !,
 1436    '$must_be'(atom, M),
 1437    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1438    '$must_be'(atom, Name),
 1439    Call =.. [Name, S0, S1],
 1440    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1441update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1442    !,
 1443    '$must_be'(atom, M),
 1444    '$must_be'(atom, Name),
 1445    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1446update_goal(po(Name), S0,S1,S2, Goal) :-
 1447    !,
 1448    '$must_be'(atom, Name),
 1449    update_goal(po(Name/2), S0,S1,S2, Goal).
 1450update_goal(Alias, S0,S1,S2, Goal) :-
 1451    update_alias(Alias, Update),
 1452    !,
 1453    update_goal(Update, S0,S1,S2, Goal).
 1454update_goal(Mode, _,_,_, _) :-
 1455    '$domain_error'(tabled_mode, Mode).
 1456
 1457update_alias(first, lattice('$tabling':first/3)).
 1458update_alias(-,     lattice('$tabling':first/3)).
 1459update_alias(last,  lattice('$tabling':last/3)).
 1460update_alias(min,   lattice('$tabling':min/3)).
 1461update_alias(max,   lattice('$tabling':max/3)).
 1462update_alias(sum,   lattice('$tabling':sum/3)).
 1463
 1464mkconj(true, G,  G) :- !.
 1465mkconj(G1,   G2, (G1,G2)).
 1466
 1467
 1468		 /*******************************
 1469		 *          AGGREGATION		*
 1470		 *******************************/
 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.
 1480:- public first/3, last/3, min/3, max/3, sum/3. 1481
 1482first(S, _, S).
 1483last(_, S, S).
 1484min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1485max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1486sum(S0, S1, S) :- S is S0+S1.
 1487
 1488
 1489		 /*******************************
 1490		 *      DYNAMIC PREDICATES	*
 1491		 *******************************/
 $set_table_wrappers(:Head)
Clear/add wrappers and notifications to trap dynamic predicates. This is required both for incremental and monotonic tabling.
 1498'$set_table_wrappers'(Pred) :-
 1499    (   '$get_predicate_attribute'(Pred, incremental, 1)
 1500    ->  wrap_incremental(Pred)
 1501    ;   unwrap_incremental(Pred)
 1502    ),
 1503    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1504    ->  wrap_monotonic(Pred)
 1505    ;   unwrap_monotonic(Pred)
 1506    ).
 1507
 1508		 /*******************************
 1509		 *       MONOTONIC TABLING	*
 1510		 *******************************/
 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.
 1517mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1518    '$idg_add_mono_dyn_dep'(Dynamic,
 1519                            dependency(Dynamic, Cont, Skel),
 1520                            ATrie).
 1521mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1522    '$idg_add_monotonic_dep'(SrcTrie,
 1523                             dependency(SrcSkel, IsMono, Cont, Skel),
 1524                             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.
 1534monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1535    '$idg_mono_affects'(SrcTrie, ATrie,
 1536                        dependency(SrcSkel, IsMono, Cont, Skel)).
 monotonic_dyn_affects(:Head, -Continuation, -Return, -ATrie)
Dynamic predicate that maintains the dependency from a monotonic
 1542monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1543    dyn_affected(Head, DTrie),
 1544    '$idg_mono_affects'(DTrie, ATrie,
 1545                        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.
 1553wrap_monotonic(Head) :-
 1554    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1555                      '$start_monotonic'(Head, Wrapped)),
 1556    '$pi_head'(PI, Head),
 1557    prolog_listen(PI, monotonic_update).
 unwrap_monotonic(+Head)
Remove the monotonic wrappers and dependencies.
 1563unwrap_monotonic(Head) :-
 1564    '$pi_head'(PI, Head),
 1565    (   unwrap_predicate(PI, monotonic)
 1566    ->  prolog_unlisten(PI, monotonic_update)
 1567    ;   true
 1568    ).
 1569
 1570'$start_monotonic'(Head, Wrapped) :-
 1571    (   '$tbl_collect_mono_dep'
 1572    ->  shift(dependency(Head)),
 1573        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1574        Wrapped,
 1575        tdebug(monotonic, '  --> ~p', [Head])
 1576    ;   Wrapped
 1577    ).
 1578
 1579monotonic_update(Action, ClauseRef) :-
 1580    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1581    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1582        mon_propagate(Action, Head)
 1583    ;   true
 1584    ).
 mon_propagate(+Action, +Head)
Handle changes to a dynamic predicate as part of monotonic updates.
 1591mon_propagate(Action, Head) :-
 1592    assert_action(Action),
 1593    !,
 1594    setup_call_cleanup(
 1595        '$tbl_propagate_start'(Old),
 1596        propagate_assert(Head),
 1597        '$tbl_propagate_end'(Old)).
 1598mon_propagate(retract, Head) :-
 1599    mon_abolish_dependents(Head).
 1600
 1601assert_action(asserta).
 1602assert_action(assertz).
 propagate_assert(+Head) is det
Propagate assertion of a dynamic clause with head Head.
 1608propagate_assert(Head) :-
 1609    tdebug(monotonic, 'Asserted ~p', [Head]),
 1610    (   monotonic_dyn_affects(Head, Cont, Skel, ATrie),
 1611        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1612        pdelim(Cont, Skel, ATrie),
 1613        fail
 1614    ;   true
 1615    ).
 propagate_answer(+SrcTrie, +SrcSkel) is det
Propagate the new answer SrcSkel to the answer table SrcTrie.
 1621propagate_answer(SrcTrie, SrcSkel) :-
 1622    (   monotonic_affects(SrcTrie, SrcSkel, true, Cont, Skel, ATrie),
 1623        tdebug(monotonic, 'Propagating tab ~p to ~p', [SrcTrie, ATrie]),
 1624        pdelim(Cont, Skel, ATrie),
 1625        fail
 1626    ;   true
 1627    ).
 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.
 1639pdelim(Worker, Skel, ATrie) :-
 1640    reset(Worker, Dep, Cont),
 1641    (   Cont == 0
 1642    ->  '$tbl_monotonic_add_answer'(ATrie, Skel),
 1643        propagate_answer(ATrie, Skel)
 1644    ;   mon_assert_dep(Dep, Cont, Skel, ATrie),
 1645        pdelim(Cont, Skel, ATrie)
 1646    ).
 mon_abolish_dependents(+HeadOrTrie)
Abolish all dependency relations from HeadOrTrie and their tables.
To be done
- Move to C
 1654mon_abolish_dependents(Node) :-
 1655    dependent_tables([Node], [], Tables),
 1656    forall('$member'(ATrie, Tables),
 1657           '$tbl_destroy_table'(ATrie)).
 1658
 1659dependent_tables([], Tables, Tables) :-
 1660    !.
 1661dependent_tables([Node|T], Tables0, Tables) :-
 1662    (   is_trie(Node)
 1663    ->  findall(ATrie,
 1664                monotonic_affects(Node, _Ret0, _IsMono, _ContinuationT, _RetT, ATrie),
 1665                Tries)
 1666    ;   findall(ATrie,
 1667                monotonic_dyn_affects(Node, _ContinuationD, _RetD, ATrie),
 1668                Tries)
 1669    ),
 1670    sort(Tries, STries),
 1671    ord_subtract(STries, Tables0, New),
 1672    ord_union(T, New, Agenda),
 1673    ord_union(New, Tables0, Tables1),
 1674    dependent_tables(Agenda, Tables1, Tables).
 ord_subtract(+InOSet, +NotInOSet, -Diff)
ordered set difference
 1680ord_subtract([], _Not, []).
 1681ord_subtract([H1|T1], L2, Diff) :-
 1682    diff21(L2, H1, T1, Diff).
 1683
 1684diff21([], H1, T1, [H1|T1]).
 1685diff21([H2|T2], H1, T1, Diff) :-
 1686    compare(Order, H1, H2),
 1687    diff3(Order, H1, T1, H2, T2, Diff).
 1688
 1689diff12([], _H2, _T2, []).
 1690diff12([H1|T1], H2, T2, Diff) :-
 1691    compare(Order, H1, H2),
 1692    diff3(Order, H1, T1, H2, T2, Diff).
 1693
 1694diff3(<,  H1, T1,  H2, T2, [H1|Diff]) :-
 1695    diff12(T1, H2, T2, Diff).
 1696diff3(=, _H1, T1, _H2, T2, Diff) :-
 1697    ord_subtract(T1, T2, Diff).
 1698diff3(>,  H1, T1, _H2, T2, Diff) :-
 1699    diff21(T2, H1, T1, Diff).
 ord_union(+OSet1, +OSet2, -Union)
 1703ord_union([], Union, Union).
 1704ord_union([H1|T1], L2, Union) :-
 1705    union2(L2, H1, T1, Union).
 1706
 1707union2([], H1, T1, [H1|T1]).
 1708union2([H2|T2], H1, T1, Union) :-
 1709    compare(Order, H1, H2),
 1710    union3(Order, H1, T1, H2, T2, Union).
 1711
 1712union3(<, H1, T1,  H2, T2, [H1|Union]) :-
 1713    union2(T1, H2, T2, Union).
 1714union3(=, H1, T1, _H2, T2, [H1|Union]) :-
 1715    ord_union(T1, T2, Union).
 1716union3(>, H1, T1,  H2, T2, [H2|Union]) :-
 1717    union2(T2, H1, T1, Union).
 abolish_monotonic_tables
Abolish all monotonic tables and the monotonic dependency relations.
 1723abolish_monotonic_tables :-
 1724    (   '$tbl_variant_table'(VariantTrie),
 1725        trie_gen(VariantTrie, Goal, ATrie),
 1726        '$get_predicate_attribute'(Goal, monotonic, 1),
 1727        '$tbl_destroy_table'(ATrie),
 1728        fail
 1729    ;   true
 1730    ).
 1731
 1732		 /*******************************
 1733		 *      INCREMENTAL TABLING	*
 1734		 *******************************/
 wrap_incremental(:Head) is det
Wrap an incremental dynamic predicate to be added to the IDG.
 1740wrap_incremental(Head) :-
 1741    tdebug(monotonic, 'Wrapping ~p', [Head]),
 1742    abstract_goal(Head, Abstract),
 1743    '$pi_head'(PI, Head),
 1744    (   Head == Abstract
 1745    ->  prolog_listen(PI, dyn_update)
 1746    ;   prolog_listen(PI, dyn_update(Abstract))
 1747    ).
 1748
 1749abstract_goal(M:Head, M:Abstract) :-
 1750    compound(Head),
 1751    '$get_predicate_attribute'(M:Head, abstract, 1),
 1752    !,
 1753    compound_name_arity(Head, Name, Arity),
 1754    functor(Abstract, Name, Arity).
 1755abstract_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.
 1765dyn_update(_Action, ClauseRef) :-
 1766    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1767    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1768        dyn_changed_pattern(Head)
 1769    ;   true
 1770    ).
 1771
 1772dyn_update(Abstract, _, _) :-
 1773    dyn_changed_pattern(Abstract).
 1774
 1775dyn_changed_pattern(Term) :-
 1776    forall(dyn_affected(Term, ATrie),
 1777           '$idg_changed'(ATrie)).
 1778
 1779dyn_affected(Term, ATrie) :-
 1780    '$tbl_variant_table'(VTable),
 1781    trie_gen(VTable, Term, ATrie).
 unwrap_incremental(:Head) is det
Remove dynamic predicate incremenal forwarding, reset the possible abstract property and remove possible tables.
 1788unwrap_incremental(Head) :-
 1789    '$pi_head'(PI, Head),
 1790    abstract_goal(Head, Abstract),
 1791    (   Head == Abstract
 1792    ->  prolog_unlisten(PI, dyn_update)
 1793    ;   '$set_predicate_attribute'(Head, abstract, 0),
 1794        prolog_unlisten(PI, dyn_update(_))
 1795    ),
 1796    (   '$tbl_variant_table'(VariantTrie)
 1797    ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1798               '$tbl_destroy_table'(ATrie))
 1799    ;   true
 1800    ).
 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
 1826reeval(ATrie, Goal, Return) :-
 1827    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1828          retry_reeval(ATrie, Goal)).
 1829
 1830retry_reeval(ATrie, Goal) :-
 1831    '$tbl_reeval_abandon'(ATrie),
 1832    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1833    sleep(0.000001),
 1834    call(Goal).
 1835
 1836try_reeval(ATrie, Goal, Return) :-
 1837    nb_current('$tbl_reeval', true),
 1838    !,
 1839    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1840    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1841    (   nonvar(Clause)
 1842    ->  trie_gen_compiled(Clause, Return)
 1843    ;   call(Goal)
 1844    ).
 1845try_reeval(ATrie, Goal, Return) :-
 1846    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1847    findall(Path, false_path(ATrie, Path), Paths0),
 1848    sort(0, @>, Paths0, Paths),
 1849    split_paths(Paths, Dynamic, Complete),
 1850    tdebug(forall('$member'(Path, Dynamic),
 1851                  tdebug(reeval, '  Re-eval dynamic path: ~p', [Path]))),
 1852    tdebug(forall('$member'(Path, Complete),
 1853                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1854    reeval_paths(Dynamic, ATrie),
 1855    reeval_paths(Complete, ATrie),
 1856    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1857    (   nonvar(Clause)
 1858    ->  trie_gen_compiled(Clause, Return)
 1859    ;   call(Goal)
 1860    ).
 1861
 1862split_paths([], [], []).
 1863split_paths([[Rank-_Len|Path]|T], [Path|DT], CT) :-
 1864    status_rank(dynamic, Rank),
 1865    !,
 1866    split_paths(T, DT, CT).
 1867split_paths([[_|Path]|T], DT, [Path|CT]) :-
 1868    split_paths(T, DT, CT).
 1869
 1870reeval_paths([], _) :-
 1871    !.
 1872reeval_paths(BottomUp, ATrie) :-
 1873    is_invalid(ATrie),
 1874    !,
 1875    reeval_heads(BottomUp, ATrie, BottomUp1),
 1876    reeval_paths(BottomUp1, ATrie).
 1877reeval_paths(_, _).
 1878
 1879reeval_heads(_, ATrie, _) :-
 1880    \+ is_invalid(ATrie),
 1881    !.
 1882reeval_heads([], _, []).
 1883reeval_heads([[H]|B], ATrie, BT) :-
 1884    !,
 1885    reeval_node(H),
 1886    reeval_heads(B, ATrie, BT).
 1887reeval_heads([[]|B], ATrie, BT) :-
 1888    !,
 1889    reeval_heads(B, ATrie, BT).
 1890reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1891    !,
 1892    reeval_node(H),
 1893    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.

 1904false_path(ATrie, BottomUp) :-
 1905    false_path(ATrie, Path, []),
 1906    '$reverse'(Path, BottomUp).
 1907
 1908false_path(ATrie, [ATrie|T], Seen) :-
 1909    \+ memberchk(ATrie, Seen),
 1910    '$idg_edge'(ATrie, dependent, Dep),
 1911    '$tbl_reeval_wait'(Dep, Status),
 1912    tdebug(reeval, '    ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
 1913    (   Status == invalid
 1914    ->  false_path(Dep, T, [ATrie|Seen])
 1915    ;   status_rank(Status, Rank),
 1916        length(Seen, Len),
 1917        T = [Rank-Len]
 1918    ).
 1919
 1920status_rank(dynamic,  2) :- !.
 1921status_rank(complete, 1) :- !.
 1922status_rank(Status,   Rank) :-
 1923    var(Rank),
 1924    !,
 1925    format(user_error, 'Re-eval from status ~p~n', [Status]),
 1926    Rank = 0.
 1927status_rank(Rank,   Rank) :-
 1928    format(user_error, 'Re-eval from rank ~p~n', [Rank]).
 1929
 1930is_invalid(ATrie) :-
 1931    '$idg_falsecount'(ATrie, FalseCount),
 1932    FalseCount > 0.
 reeval_node(+ATrie)
Re-evaluate the invalid answer trie ATrie. Initially this created a nested tabling environment, but this is dropped:
 1945reeval_node(ATrie) :-
 1946    '$tbl_reeval_prepare'(ATrie, Variant, Clause),
 1947    var(Clause),
 1948    !,
 1949    tdebug(reeval, 'Re-evaluating ~p', [Variant]),
 1950    (   '$idg_reset_current',
 1951        setup_call_cleanup(
 1952            nb_setval('$tbl_reeval', true),
 1953            ignore(Variant),                    % assumes local scheduling
 1954            nb_delete('$tbl_reeval')),
 1955        fail
 1956    ;   tdebug(reeval, 'Re-evaluated ~p', [Variant])
 1957    ).
 1958reeval_node(_).
 1959
 1960
 1961		 /*******************************
 1962		 *      EXPAND DIRECTIVES	*
 1963		 *******************************/
 1964
 1965system:term_expansion((:- table(Preds)), Expansion) :-
 1966    \+ current_prolog_flag(xref, true),
 1967    prolog_load_context(module, M),
 1968    phrase(wrappers(Preds, M), Clauses),
 1969    multifile_decls(Clauses, Directives0),
 1970    sort(Directives0, Directives),
 1971    '$append'(Directives, Clauses, Expansion).
 1972
 1973multifile_decls([], []).
 1974multifile_decls([H0|T0], [H|T]) :-
 1975    multifile_decl(H0, H),
 1976    !,
 1977    multifile_decls(T0, T).
 1978multifile_decls([_|T0], T) :-
 1979    multifile_decls(T0, T).
 1980
 1981multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 1982    !,
 1983    functor(Head, Name, Arity).
 1984multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 1985    !,
 1986    functor(Head, Name, Arity).
 1987multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 1988    !,
 1989    functor(Head, Name, Arity).
 1990multifile_decl(Head, (:- multifile(Name/Arity))) :-
 1991    !,
 1992    Head \= (:-_),
 1993    functor(Head, Name, Arity).
 1994
 1995
 1996		 /*******************************
 1997		 *      ANSWER COMPLETION	*
 1998		 *******************************/
 1999
 2000:- 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()
 2016answer_completion(AnswerTrie, Return) :-
 2017    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 2018    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 2019    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 2020                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 2021    (   Propagated > 0
 2022    ->  answer_completion(AnswerTrie, Return)
 2023    ;   true
 2024    ).
 2025
 2026answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 2027    (   eval_subgoal_in_residual(AnswerTrie, Return),
 2028        fail
 2029    ;   true
 2030    ),
 2031    delete_answers_for_failing_calls(Propagated),
 2032    (   Propagated == 0
 2033    ->  mark_succeeding_calls_as_answer_completed
 2034    ;   true
 2035    ).
 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.
 2043delete_answers_for_failing_calls(Propagated) :-
 2044    State = state(0),
 2045    (   subgoal_residual_trie(ASGF, ESGF),
 2046        \+ trie_gen(ESGF, _ETmp),
 2047        tdebug(trie_goal(ASGF, Goal0, _)),
 2048        tdebug(trie_goal(ASGF, Goal, _0Return)),
 2049        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 2050        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 2051	'$tbl_force_truth_value'(ALeaf, false, Count),
 2052        arg(1, State, Prop0),
 2053        Prop is Prop0+Count-1,
 2054        nb_setarg(1, State, Prop),
 2055	fail
 2056    ;   arg(1, State, Propagated)
 2057    ).
 2058
 2059mark_succeeding_calls_as_answer_completed :-
 2060    (   subgoal_residual_trie(ASGF, _ESGF),
 2061        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 2062        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 2063            tdebug(trie_goal(ASGF, Goal, _0Return)),
 2064            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 2065            '$tbl_set_answer_completed'(ASGF)
 2066        ),
 2067        fail
 2068    ;   true
 2069    ).
 2070
 2071subgoal_residual_trie(ASGF, ESGF) :-
 2072    '$tbl_variant_table'(VariantTrie),
 2073    context_module(M),
 2074    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.
 2081eval_dl_in_residual(true) :-
 2082    !.
 2083eval_dl_in_residual((A;B)) :-
 2084    !,
 2085    (   eval_dl_in_residual(A)
 2086    ;   eval_dl_in_residual(B)
 2087    ).
 2088eval_dl_in_residual((A,B)) :-
 2089    !,
 2090    eval_dl_in_residual(A),
 2091    eval_dl_in_residual(B).
 2092eval_dl_in_residual(tnot(G)) :-
 2093    !,
 2094    tdebug(ac, ' ? tnot(~p)', [G]),
 2095    current_table(G, SGF),
 2096    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2097    tnot(eval_subgoal_in_residual(SGF, Return)).
 2098eval_dl_in_residual(G) :-
 2099    tdebug(ac, ' ? ~p', [G]),
 2100    (   current_table(G, SGF)
 2101    ->	true
 2102    ;   more_general_table(G, SGF)
 2103    ->	true
 2104    ;	writeln(user_error, 'MISSING CALL? '(G)),
 2105        fail
 2106    ),
 2107    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2108    eval_subgoal_in_residual(SGF, Return).
 2109
 2110more_general_table(G, Trie) :-
 2111    term_variables(G, Vars),
 2112    '$tbl_variant_table'(VariantTrie),
 2113    trie_gen(VariantTrie, G, Trie),
 2114    is_most_general_term(Vars).
 2115
 2116:- 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.
 2123eval_subgoal_in_residual(AnswerTrie, _Return) :-
 2124    '$tbl_is_answer_completed'(AnswerTrie),
 2125    !,
 2126    undefined.
 2127eval_subgoal_in_residual(AnswerTrie, Return) :-
 2128    '$tbl_answer'(AnswerTrie, Return, Condition),
 2129    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 2130    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 2131    eval_dl_in_residual(Condition).
 2132
 2133
 2134		 /*******************************
 2135		 *            TRIPWIRES		*
 2136		 *******************************/
 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.
 2144:- public tripwire/3. 2145:- multifile prolog:tripwire/2. 2146
 2147tripwire(Wire, _Action, Context) :-
 2148    prolog:tripwire(Wire, Context),
 2149    !.
 2150tripwire(Wire, Action, Context) :-
 2151    Error = error(resource_error(tripwire(Wire, Context)), _),
 2152    tripwire_action(Action, Error).
 2153
 2154tripwire_action(warning, Error) :-
 2155    print_message(warning, Error).
 2156tripwire_action(error, Error) :-
 2157    throw(Error).
 2158tripwire_action(suspend, Error) :-
 2159    print_message(warning, Error),
 2160    break.
 2161
 2162
 2163		 /*******************************
 2164		 *   SYSTEM TABLED PREDICATES	*
 2165		 *******************************/
 2166
 2167:- table
 2168    system:undefined/0,
 2169    system:answer_count_restraint/0,
 2170    system:radial_restraint/0,
 2171    system:tabled_call/1.
 undefined is undefined
Expresses the value bottom from the well founded semantics.
 2177system:(undefined :-
 2178    tnot(undefined)).
 answer_count_restraint is undefined
 radial_restraint is undefined
Similar to undefined/0, providing a specific undefined for restraint violations.
 2186system:(answer_count_restraint :-
 2187    tnot(answer_count_restraint)).
 2188
 2189system:(radial_restraint :-
 2190    tnot(radial_restraint)).
 2191
 2192system:(tabled_call(X) :- call(X))