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

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 */
   97% Enable debugging using debug(tabling(Topic)) when compiled with
   98% -DO_DEBUG
   99goal_expansion(tdebug(Topic, Fmt, Args), Expansion) :-
  100    (   current_prolog_flag(prolog_debug, true)
  101    ->  Expansion = debug(tabling(Topic), Fmt, Args)
  102    ;   Expansion = true
  103    ).
  104goal_expansion(tdebug(Goal), Expansion) :-
  105    (   current_prolog_flag(prolog_debug, true)
  106    ->  Expansion = (   debugging(tabling(_))
  107                    ->  (   Goal
  108                        ->  true
  109                        ;   print_message(error,
  110                                          format('goal_failed: ~q', [Goal]))
  111                        )
  112                    ;   true
  113                    )
  114    ;   Expansion = true
  115    ).
  116
  117:- if(current_prolog_flag(prolog_debug, true)).  118wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
  119    !,
  120    '$tbl_wkl_table'(WorkList, ATrie),
  121    trie_goal(ATrie, Goal, Skeleton).
  122wl_goal(WorkList, Goal, Skeleton) :-
  123    '$tbl_wkl_table'(WorkList, ATrie),
  124    trie_goal(ATrie, Goal, Skeleton).
  125
  126trie_goal(ATrie, Goal, Skeleton) :-
  127    '$tbl_table_status'(ATrie, _Status, M:Variant, Skeleton),
  128    (   M:'$table_mode'(Goal0, Variant, _Moded)
  129    ->  true
  130    ;   Goal0 = Variant                 % dynamic IDG nodes
  131    ),
  132    unqualify_goal(M:Goal0, user, Goal).
  133
  134delay_goals(List, Goal) :-
  135    delay_goals(List, user, Goal).
  136
  137user_goal(Goal, UGoal) :-
  138    unqualify_goal(Goal, user, UGoal).
  139
  140:- multifile
  141    prolog:portray/1.  142
  143user:portray(ATrie) :-
  144    '$is_answer_trie'(ATrie, _),
  145    trie_goal(ATrie, Goal, _Skeleton),
  146    (   '$idg_falsecount'(ATrie, FalseCount)
  147    ->  (   '$idg_forced'(ATrie)
  148        ->  format('~q [fc=~d/F] for ~p', [ATrie, FalseCount, Goal])
  149        ;   format('~q [fc=~d] for ~p', [ATrie, FalseCount, Goal])
  150        )
  151    ;   format('~q for ~p', [ATrie, Goal])
  152    ).
  153user:portray(Cont) :-
  154    compound(Cont),
  155    compound_name_arguments(Cont, '$cont$', [Clause, PC | Args]),
  156    clause_property(Clause, file(File)),
  157    file_base_name(File, Base),
  158    clause_property(Clause, line_count(Line)),
  159    clause_property(Clause, predicate(PI)),
  160    format('~q at ~w:~d @PC=~w, ~p', [PI, Base, Line, PC, Args]).
  161
  162:- endif.
 table :PredicateIndicators
Prepare the given PredicateIndicators for tabling. This predicate is normally used as a directive, but SWI-Prolog also allows runtime conversion of non-tabled predicates to tabled predicates by calling table/1. The example below prepares the predicate edge/2 and the non-terminal statement//1 for tabled execution.
:- table edge/2, statement//1.

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

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

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

  187table(M:PIList) :-
  188    setup_call_cleanup(
  189        '$set_source_module'(OldModule, M),
  190        expand_term((:- table(PIList)), Clauses),
  191        '$set_source_module'(OldModule)),
  192    dyn_tabling_list(Clauses, M).
  193
  194dyn_tabling_list([], _).
  195dyn_tabling_list([H|T], M) :-
  196    dyn_tabling(H, M),
  197    dyn_tabling_list(T, M).
  198
  199dyn_tabling(M:Clause, _) :-
  200    !,
  201    dyn_tabling(Clause, M).
  202dyn_tabling((:- multifile(PI)), M) :-
  203    !,
  204    multifile(M:PI),
  205    dynamic(M:PI).
  206dyn_tabling(:- initialization(Wrap, now), M) :-
  207    !,
  208    M:Wrap.
  209dyn_tabling('$tabled'(Head, TMode), M) :-
  210    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  211        (   OMode \== TMode
  212        ->  erase(Ref),
  213            fail
  214        ;   true
  215        )
  216    ->  true
  217    ;   assertz(M:'$tabled'(Head, TMode))
  218    ).
  219dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  220    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  221    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  222        ->  true
  223        ;   erase(Ref),
  224            assertz(M:'$table_mode'(Head, Variant, Moded))
  225        )
  226    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  227    ).
  228dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  229    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  230    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  231        ->  true
  232        ;   erase(Ref),
  233            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  234        )
  235    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  236    ).
 untable(M:PIList) is det
Remove tabling for the predicates in PIList. This can be used to undo the effect of table/1 at runtime. In addition to removing the tabling instrumentation this also removes possibly associated tables using abolish_table_subgoals/1.
Arguments:
PIList- is a comma-list that is compatible ith table/1.
  247untable(M:PIList) :-
  248    untable(PIList, M).
  249
  250untable(Var, _) :-
  251    var(Var),
  252    !,
  253    '$instantiation_error'(Var).
  254untable(M:Spec, _) :-
  255    !,
  256    '$must_be'(atom, M),
  257    untable(Spec, M).
  258untable((A,B), M) :-
  259    !,
  260    untable(A, M),
  261    untable(B, M).
  262untable(Name//Arity, M) :-
  263    atom(Name), integer(Arity), Arity >= 0,
  264    !,
  265    Arity1 is Arity+2,
  266    untable(Name/Arity1, M).
  267untable(Name/Arity, M) :-
  268    !,
  269    functor(Head, Name, Arity),
  270    (   '$get_predicate_attribute'(M:Head, tabled, 1)
  271    ->  abolish_table_subgoals(M:Head),
  272        dynamic(M:'$tabled'/2),
  273        dynamic(M:'$table_mode'/3),
  274        retractall(M:'$tabled'(Head, _TMode)),
  275        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  276        unwrap_predicate(M:Name/Arity, table),
  277        '$set_predicate_attribute'(M:Head, tabled, false),
  278        '$set_predicate_attribute'(M:Head, opaque, false),
  279        '$set_predicate_attribute'(M:Head, incremental, false),
  280        '$set_predicate_attribute'(M:Head, monotonic, false),
  281        '$set_predicate_attribute'(M:Head, lazy, false)
  282    ;   true
  283    ).
  284untable(Head, M) :-
  285    callable(Head),
  286    !,
  287    functor(Head, Name, Arity),
  288    untable(Name/Arity, M).
  289untable(TableSpec, _) :-
  290    '$type_error'(table_desclaration, TableSpec).
  291
  292untable_reconsult(PI) :-
  293    print_message(informational, untable(PI)),
  294    untable(PI).
  295
  296:- initialization
  297   prolog_listen(untable, untable_reconsult).  298
  299
  300'$wrap_tabled'(Head, Options) :-
  301    get_dict(mode, Options, subsumptive),
  302    !,
  303    set_pattributes(Head, Options),
  304    '$wrap_predicate'(Head, table, Closure, Wrapped,
  305                      start_subsumptive_tabling(Closure, Head, Wrapped)).
  306'$wrap_tabled'(Head, Options) :-
  307    get_dict(subgoal_abstract, Options, _Abstract),
  308    !,
  309    set_pattributes(Head, Options),
  310    '$wrap_predicate'(Head, table, Closure, Wrapped,
  311                      start_abstract_tabling(Closure, Head, Wrapped)).
  312'$wrap_tabled'(Head, Options) :-
  313    !,
  314    set_pattributes(Head, Options),
  315    '$wrap_predicate'(Head, table, Closure, Wrapped,
  316                      start_tabling(Closure, Head, Wrapped)).
 set_pattributes(:Head, +Options) is det
Set all tabling attributes for Head. These have been collected using table_options/3 from the :- table Head as (Attr1,...) directive.
  323set_pattributes(Head, Options) :-
  324    '$set_predicate_attribute'(Head, tabled, true),
  325    (   tabled_attribute(Attr),
  326        get_dict(Attr, Options, Value),
  327        '$set_predicate_attribute'(Head, Attr, Value),
  328        fail
  329    ;   current_prolog_flag(table_monotonic, lazy),
  330        '$set_predicate_attribute'(Head, lazy, true),
  331        fail
  332    ;   true
  333    ).
  334
  335tabled_attribute(incremental).
  336tabled_attribute(dynamic).
  337tabled_attribute(tshared).
  338tabled_attribute(max_answers).
  339tabled_attribute(subgoal_abstract).
  340tabled_attribute(answer_abstract).
  341tabled_attribute(monotonic).
  342tabled_attribute(opaque).
  343tabled_attribute(lazy).
 start_tabling(:Closure, :Wrapper, :Implementation)
Execute Implementation using tabling. This predicate should not be called directly. The table/1 directive causes a predicate to be translated into a renamed implementation and a wrapper that involves this predicate.
Arguments:
Closure- is the wrapper closure to find the predicate quickly. It is also allowed to pass nothing. In that cases the predicate is looked up using Wrapper. We suggest to pass 0 in this case.
Compatibility
- This interface may change or disappear without notice from future versions.
  359start_tabling(Closure, Wrapper, Worker) :-
  360    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton, IsMono),
  361    (   IsMono == true
  362    ->  shift(dependency(Skeleton, Trie, Mono)),
  363        (   Mono == true
  364        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  365        ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  366        )
  367    ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  368    ).
  369
  370start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
  371    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  372    (   Status == complete
  373    ->  trie_gen_compiled(Trie, Skeleton)
  374    ;   functor(Status, fresh, 2)
  375    ->  catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
  376              deadlock,
  377              restart_tabling(Closure, Wrapper, Worker))
  378    ;   Status == invalid
  379    ->  reeval(Trie, Wrapper, Skeleton)
  380    ;   % = run_follower, but never fresh and Status is a worklist
  381        shift_for_copy(call_info(Skeleton, Status))
  382    ).
  383
  384create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
  385    tdebug(Fresh = fresh(SCC, WorkList)),
  386    tdebug(wl_goal(WorkList, Goal, _)),
  387    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  388    setup_call_catcher_cleanup(
  389        '$idg_set_current'(OldCurrent, Trie),
  390        run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
  391        Catcher,
  392        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  393    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  394    done_leader(LStatus, Fresh, Skeleton, Clause).
 restart_tabling(+Closure, +Wrapper, +Worker)
We were aborted due to a deadlock. Simply retry. We sleep a very tiny amount to give the thread against which we have deadlocked the opportunity to grab our table. Without, it is common that we re-grab the table within our time slice and before the kernel managed to wakeup the other thread.
  404restart_tabling(Closure, Wrapper, Worker) :-
  405    tdebug(user_goal(Wrapper, Goal)),
  406    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  407    sleep(0.000001),
  408    start_tabling(Closure, Wrapper, Worker).
  409
  410restart_abstract_tabling(Closure, Wrapper, Worker) :-
  411    tdebug(user_goal(Wrapper, Goal)),
  412    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  413    sleep(0.000001),
  414    start_abstract_tabling(Closure, Wrapper, Worker).
 start_subsumptive_tabling(:Closure, :Wrapper, :Implementation)
(*) We should not use trie_gen_compiled/2 here as this will enumerate all answers while '$tbl_answer_update_dl'/2 uses the available trie indexing to only fetch the relevant answer(s).
To be done
- In the end '$tbl_answer_update_dl'/2 is problematic with incremental and shared tabling as we do not get the consistent update view from the compiled result.
  426start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  427    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  428    ->  (   Status == complete
  429        ->  trie_gen_compiled(Trie, Skeleton)
  430        ;   Status == invalid
  431        ->  reeval(Trie, Wrapper, Skeleton),
  432            trie_gen_compiled(Trie, Skeleton)
  433        ;   shift_for_copy(call_info(Skeleton, Status))
  434        )
  435    ;   more_general_table(Wrapper, ATrie),
  436        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  437    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  438    ;   more_general_table(Wrapper, ATrie),
  439        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  440    ->  (   Status == invalid
  441        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  442            Wrapper = GenWrapper,
  443            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  444        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  445            shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  446            unify_subsumptive(Skeleton, GenSkeleton)
  447        )
  448    ;   start_tabling(Closure, Wrapper, Worker)
  449    ).
 wrapper_skeleton(+GenWrapper, +GenSkeleton, +Wrapper, -Skeleton)
Skeleton is a specialized version of GenSkeleton for the subsumed new consumer.
  456wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  457    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  458    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  459           [GenSkeleton+Skeleton]).
  460
  461unify_subsumptive(X,X).
 start_abstract_tabling(:Closure, :Wrapper, :Worker)
Deal with table p/1 as subgoal_abstract(N). This is a merge between variant and subsumptive tabling. If the goal is not abstracted this is simple variant tabling. If the goal is abstracted we must solve the more general goal and use answers from the abstract table.

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

  474start_abstract_tabling(Closure, Wrapper, Worker) :-
  475    '$tbl_abstract_table'(Closure, Wrapper, Trie, _Abstract, Status, Skeleton),
  476    tdebug(abstract, 'Wrapper=~p, Worker=~p, Skel=~p',
  477           [Wrapper, Worker, Skeleton]),
  478    (   is_most_general_term(Skeleton)           % TBD: Fill and test Abstract
  479    ->  start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  480    ;   Status == complete
  481    ->  '$tbl_answer_update_dl'(Trie, Skeleton)
  482    ;   functor(Status, fresh, 2)
  483    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  484        abstract_worker(Worker, GenWrapper, GenWorker),
  485        catch(create_abstract_table(Trie, Status, Skeleton, GenSkeleton, GenWrapper,
  486                                    GenWorker),
  487              deadlock,
  488              restart_abstract_tabling(Closure, Wrapper, Worker))
  489    ;   Status == invalid
  490    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  491        reeval(ATrie, GenWrapper, GenSkeleton),
  492        Wrapper = GenWrapper,
  493        '$tbl_answer_update_dl'(ATrie, Skeleton)
  494    ;   shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  495        unify_subsumptive(Skeleton, GenSkeleton)
  496    ).
  497
  498create_abstract_table(Trie, Fresh, Skeleton, GenSkeleton, Wrapper, Worker) :-
  499    tdebug(Fresh = fresh(SCC, WorkList)),
  500    tdebug(wl_goal(WorkList, Goal, _)),
  501    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  502    setup_call_catcher_cleanup(
  503        '$idg_set_current'(OldCurrent, Trie),
  504        run_leader(GenSkeleton, Worker, Fresh, LStatus, _Clause),
  505        Catcher,
  506        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  507    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  508    Skeleton = GenSkeleton,
  509    done_abstract_leader(LStatus, Fresh, GenSkeleton, Trie).
  510
  511abstract_worker(_:call(Term), _M:GenWrapper, call(GenTerm)) :-
  512    functor(Term, Closure, _),
  513    GenWrapper =.. [_|Args],
  514    GenTerm =.. [Closure|Args].
  515
  516:- '$hide'((done_abstract_leader/4)).  517
  518done_abstract_leader(complete, _Fresh, Skeleton, Trie) :-
  519    !,
  520    '$tbl_answer_update_dl'(Trie, Skeleton).
  521done_abstract_leader(final, fresh(SCC, _Worklist), Skeleton, Trie) :-
  522    !,
  523    '$tbl_free_component'(SCC),
  524    '$tbl_answer_update_dl'(Trie, Skeleton).
  525done_abstract_leader(_,_,_,_).
 done_leader(+Status, +Fresh, +Skeleton, -Clause)
Called on completion of a table. Possibly destroys the component and generates the answers from the complete table. The last cases deals with leaders that are merged into a higher SCC (and thus no longer a leader).
  534:- '$hide'((done_leader/4, finished_leader/4)).  535
  536done_leader(complete, _Fresh, Skeleton, Clause) :-
  537    !,
  538    trie_gen_compiled(Clause, Skeleton).
  539done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  540    !,
  541    '$tbl_free_component'(SCC),
  542    trie_gen_compiled(Clause, Skeleton).
  543done_leader(_,_,_,_).
  544
  545finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  546    '$idg_set_current'(OldCurrent),
  547    (   Catcher == exit
  548    ->  true
  549    ;   Catcher == fail
  550    ->  true
  551    ;   Catcher = exception(_)
  552    ->  Fresh = fresh(SCC, _),
  553        '$tbl_table_discard_all'(SCC)
  554    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  555    ).
 run_leader(+Skeleton, +Worker, +Fresh, -Status, -Clause) is det
Run the leader of a (new) SCC, storing instantiated copies of Wrapper into Trie. Status is the status of the SCC when this predicate terminates. It is one of complete, in which case local completion finished or merged if running the completion finds an open (not completed) active goal that resides in a parent component. In this case, this SCC has been merged with this parent.

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

  570run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  571    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  572    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  573    activate(Skeleton, Worker, Worklist),
  574    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  575    completion(SCC, Status, Clause),
  576    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  577    (   Status == merged
  578    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  579        '$tbl_wkl_make_follower'(Worklist),
  580        shift_for_copy(call_info(Skeleton, Worklist))
  581    ;   true                                    % completed
  582    ).
  583
  584activate(Skeleton, Worker, WorkList) :-
  585    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  586    (   reset_delays,
  587        delim(Skeleton, Worker, WorkList, []),
  588        fail
  589    ;   true
  590    ).
 delim(+Skeleton, +Worker, +WorkList, +Delays)
Call WorkList and add all instances of Skeleton as answer to WorkList, conditional according to Delays.
Arguments:
Skeleton- is the return skeleton (ret/N term)
Worker- is either the (wrapped) tabled goal or a continuation
WorkList- is the work list associated with Worker (or its continuation).
Delays- is the current delay list. Note that the actual delay also include the internal global delay list. '$tbl_wkl_add_answer'/4 joins the two. For a dependency we join the two explicitly.
  606delim(Skeleton, Worker, WorkList, Delays) :-
  607    reset(Worker, SourceCall, Continuation),
  608    tdebug(wl_goal(WorkList, Goal, _)),
  609    (   Continuation == 0
  610    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  611        tdebug(delay_goals(AllDelays, Cond)),
  612        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  613               [Skeleton, Goal, Cond]),
  614        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  615        Complete == !,
  616        !
  617    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  618    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  619        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  620        tdebug(wl_goal(WorkList, DstGoal, _)),
  621        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  622        '$tbl_wkl_add_suspension'(
  623            SourceWL,
  624            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  625    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  626    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  627        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  628        tdebug(wl_goal(WorkList, DstGoal, _)),
  629        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  630        '$tbl_wkl_add_suspension'(
  631            SourceWL,
  632            InstSkeleton,
  633            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  634    ;   '$tbl_wkl_table'(WorkList, ATrie),
  635        mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
  636    ->  delim(Skeleton, Continuation, WorkList, Delays)
  637    ).
 start_moded_tabling(+Closure, :Wrapper, :Implementation, +Variant, +ModeArgs)
As start_tabling/2, but in addition separates the data stored in the answer trie in the Variant and ModeArgs.
  644'$moded_wrap_tabled'(Head, Options, ModeTest, WrapperNoModes, ModeArgs) :-
  645    set_pattributes(Head, Options),
  646    '$wrap_predicate'(Head, table, Closure, Wrapped,
  647                      (   ModeTest,
  648                          start_moded_tabling(Closure, Head, Wrapped,
  649                                              WrapperNoModes, ModeArgs)
  650                      )).
  651
  652
  653start_moded_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  654    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie,
  655                               Status, Skeleton, IsMono),
  656    (   IsMono == true
  657    ->  shift(dependency(Skeleton/ModeArgs, Trie, Mono)),
  658        (   Mono == true
  659        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  660        ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  661                                  Trie, Status, Skeleton)
  662        )
  663    ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  664                              Trie, Status, Skeleton)
  665    ).
  666
  667start_moded_tabling_2(_Closure, Wrapper, Worker, ModeArgs,
  668                      Trie, Status, Skeleton) :-
  669    (   Status == complete
  670    ->  moded_gen_answer(Trie, Skeleton, ModeArgs)
  671    ;   functor(Status, fresh, 2)
  672    ->  setup_call_catcher_cleanup(
  673            '$idg_set_current'(OldCurrent, Trie),
  674            moded_run_leader(Wrapper, Skeleton/ModeArgs,
  675                             Worker, Status, LStatus),
  676            Catcher,
  677            finished_leader(OldCurrent, Catcher, Status, Wrapper)),
  678        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  679               [Wrapper, ModeArgs, LStatus]),
  680        moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
  681    ;   Status == invalid
  682    ->  reeval(Trie, Wrapper, Skeleton),
  683        moded_gen_answer(Trie, Skeleton, ModeArgs)
  684    ;   % = run_follower, but never fresh and Status is a worklist
  685        shift_for_copy(call_info(Skeleton/ModeArgs, Status))
  686    ).
  687
  688:- public
  689    moded_gen_answer/3.                         % XSB tables.pl
  690
  691moded_gen_answer(Trie, Skeleton, ModedArgs) :-
  692    trie_gen(Trie, Skeleton),
  693    '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
  694
  695'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
  696    trie_gen(ATrie, Skeleton),
  697    '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
  698
  699moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
  700    !,
  701    moded_gen_answer(Trie, Skeleton, ModeArgs).
  702moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
  703    !,
  704    '$tbl_free_component'(SCC),
  705    moded_gen_answer(Trie, Skeleton, ModeArgs).
  706moded_done_leader(_, _, _, _, _).
  707
  708moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
  709    tdebug(wl_goal(Worklist, Goal, _)),
  710    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  711    moded_activate(SkeletonMA, Worker, Worklist),
  712    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  713    completion(SCC, Status, _Clause),           % TBD: propagate
  714    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  715    (   Status == merged
  716    ->  tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
  717        '$tbl_wkl_make_follower'(Worklist),
  718        shift_for_copy(call_info(SkeletonMA, Worklist))
  719    ;   true                                    % completed
  720    ).
  721
  722moded_activate(SkeletonMA, Worker, WorkList) :-
  723    (   reset_delays,
  724        delim(SkeletonMA, Worker, WorkList, []),
  725        fail
  726    ;   true
  727    ).
 update(+Flags, +Head, +Module, +A1, +A2, -A3, -Action) is semidet
Update the aggregated value for an answer. Iff this predicate succeeds, the aggregated value is updated to A3. If Del is unified with true, A1 should be deleted.
Arguments:
Flags- is a bit mask telling which of A1 and A2 are 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
  745:- public
  746    update/7.  747
  748update(0b11, Wrapper, M, A1, A2, A3, delete) :-
  749    !,
  750    M:'$table_update'(Wrapper, A1, A2, A3),
  751    A1 \=@= A3.
  752update(0b10, Wrapper, M, A1, A2, A3, Action) :-
  753    !,
  754    (   is_subsumed_by(Wrapper, M, A2, A1)
  755    ->  Action = done
  756    ;   A3 = A2,
  757        Action = keep
  758    ).
  759update(0b01, Wrapper, M, A1, A2, A2, Action) :-
  760    !,
  761    (   is_subsumed_by(Wrapper, M, A1, A2)
  762    ->  Action = delete
  763    ;   Action = keep
  764    ).
  765update(0b00, _Wrapper, _M, _A1, A2, A2, keep) :-
  766    !.
  767
  768is_subsumed_by(Wrapper, M, Instance, General) :-
  769    M:'$table_update'(Wrapper, Instance, General, New),
  770    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.
  779completion(SCC, Status, Clause) :-
  780    (   reset_delays,
  781        completion_(SCC),
  782        fail
  783    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  784        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  785    ).
  786
  787completion_(SCC) :-
  788    repeat,
  789    (   '$tbl_pop_worklist'(SCC, WorkList)
  790    ->  tdebug(wl_goal(WorkList, Goal, _)),
  791        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  792        completion_step(WorkList)
  793    ;   !
  794    ).
 $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.
  825completion_step(SourceWL) :-
  826    '$tbl_wkl_work'(SourceWL,
  827                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  828    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  829    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  830    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  831    tdebug(delay_goals(AllDelays, Cond)),
  832    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  833           [TargetGoal, SourceGoal, Answer, Cond]),
  834    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  835    fail.
  836
  837
  838		 /*******************************
  839		 *     STRATIFIED NEGATION	*
  840		 *******************************/
 tnot(:Goal)
Tabled negation.

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

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

  891negation_suspend(Wrapper, Skeleton, Worklist) :-
  892    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  893    '$tbl_wkl_negative'(Worklist),
  894    shift_for_copy(call_info(Skeleton, tnot(Worklist))),
  895    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  896    '$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.
  905not_exists(Goal) :-
  906    ground(Goal),
  907    '$get_predicate_attribute'(Goal, tabled, 1),
  908    !,
  909    tnot(Goal).
  910not_exists(Goal) :-
  911    (   tabled_call(Goal), fail
  912    ;   tnot(tabled_call(Goal))
  913    ).
  914
  915		 /*******************************
  916		 *           DELAY LISTS	*
  917		 *******************************/
  918
  919add_delay(Delay) :-
  920    '$tbl_delay_list'(DL0),
  921    '$tbl_set_delay_list'([Delay|DL0]).
  922
  923reset_delays :-
  924    '$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).
  932'$wfs_call'(Goal, M:Delays) :-
  933    '$tbl_delay_list'(DL0),
  934    reset_delays,
  935    call(Goal),
  936    '$tbl_delay_list'(DL1),
  937    (   delay_goals(DL1, M, Delays)
  938    ->  true
  939    ;   Delays = undefined
  940    ),
  941    '$append'(DL0, DL1, DL),
  942    '$tbl_set_delay_list'(DL).
  943
  944delay_goals([], _, true) :-
  945    !.
  946delay_goals([AT+AN|T], M, Goal) :-
  947    !,
  948    (   integer(AN)
  949    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  950        (   '$tbl_is_trienode'(Moded)
  951        ->  trie_term(AN, Answer)
  952        ;   true                        % TBD: Generated moded answer
  953        )
  954    ;   AN = Skeleton/ModeArgs
  955    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  956        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  957        G0 = M1:G0plain
  958    ;   '$tbl_table_status'(AT, _, G0, AN)
  959    ),
  960    GN = G0,
  961    (   T == []
  962    ->  Goal = GN
  963    ;   Goal = (GN,GT),
  964        delay_goals(T, M, GT)
  965    ).
  966delay_goals([AT|T], M, Goal) :-
  967    atrie_goal(AT, G0),
  968    unqualify_goal(G0, M, G1),
  969    GN = tnot(G1),
  970    (   T == []
  971    ->  Goal = GN
  972    ;   Goal = (GN,GT),
  973        delay_goals(T, M, GT)
  974    ).
  975
  976at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
  977    is_trie(Trie),
  978    !,
  979    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
  980at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
  981    is_trie(Trie),
  982    !,
  983    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
  984    M2:'$table_mode'(Goal0, Variant, Moded),
  985    unqualify_goal(M2:Goal0, M, Goal).
  986
  987atrie_goal(Trie, M:Goal) :-
  988    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
  989    M:'$table_mode'(Goal, Variant, _Moded).
  990
  991unqualify_goal(M:Goal, M, Goal0) :-
  992    !,
  993    Goal0 = Goal.
  994unqualify_goal(Goal, _, Goal).
  995
  996
  997                 /*******************************
  998                 *            CLEANUP           *
  999                 *******************************/
 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.

 1011abolish_all_tables :-
 1012    (   '$tbl_abolish_local_tables'
 1013    ->  true
 1014    ;   true
 1015    ),
 1016    (   '$tbl_variant_table'(VariantTrie),
 1017        trie_gen(VariantTrie, _, Trie),
 1018        '$tbl_destroy_table'(Trie),
 1019        fail
 1020    ;   true
 1021    ).
 1022
 1023abolish_private_tables :-
 1024    (   '$tbl_abolish_local_tables'
 1025    ->  true
 1026    ;   (   '$tbl_local_variant_table'(VariantTrie),
 1027            trie_gen(VariantTrie, _, Trie),
 1028            '$tbl_destroy_table'(Trie),
 1029            fail
 1030        ;   true
 1031        )
 1032    ).
 1033
 1034abolish_shared_tables :-
 1035    (   '$tbl_global_variant_table'(VariantTrie),
 1036        trie_gen(VariantTrie, _, Trie),
 1037        '$tbl_destroy_table'(Trie),
 1038        fail
 1039    ;   true
 1040    ).
 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?
 1049abolish_table_subgoals(SubGoal0) :-
 1050    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1051    !,
 1052    '$must_be'(acyclic, SubGoal),
 1053    (   '$tbl_variant_table'(VariantTrie),
 1054        trie_gen(VariantTrie, M:SubGoal, Trie),
 1055        '$tbl_destroy_table'(Trie),
 1056        fail
 1057    ;   true
 1058    ).
 1059abolish_table_subgoals(_).
 abolish_module_tables(+Module) is det
Abolish all tables for predicates associated with the given module.
 1065abolish_module_tables(Module) :-
 1066    '$must_be'(atom, Module),
 1067    '$tbl_variant_table'(VariantTrie),
 1068    current_module(Module),
 1069    !,
 1070    forall(trie_gen(VariantTrie, Module:_, Trie),
 1071           '$tbl_destroy_table'(Trie)).
 1072abolish_module_tables(_).
 abolish_nonincremental_tables is det
Abolish all tables that are not related to incremental predicates.
 1078abolish_nonincremental_tables :-
 1079    (   '$tbl_variant_table'(VariantTrie),
 1080        trie_gen(VariantTrie, _, Trie),
 1081        '$tbl_table_status'(Trie, Status, Goal, _),
 1082        (   Status == complete
 1083        ->  true
 1084        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1085        ),
 1086        \+ predicate_property(Goal, incremental),
 1087        '$tbl_destroy_table'(Trie),
 1088        fail
 1089    ;   true
 1090    ).
 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.
 1099abolish_nonincremental_tables(Options) :-
 1100    (   Options = on_incomplete(Action)
 1101    ->  Action == skip
 1102    ;   '$option'(on_incomplete(skip), Options)
 1103    ),
 1104    !,
 1105    (   '$tbl_variant_table'(VariantTrie),
 1106        trie_gen(VariantTrie, _, Trie),
 1107        '$tbl_table_status'(Trie, complete, Goal, _),
 1108        \+ predicate_property(Goal, incremental),
 1109        '$tbl_destroy_table'(Trie),
 1110        fail
 1111    ;   true
 1112    ).
 1113abolish_nonincremental_tables(_) :-
 1114    abolish_nonincremental_tables.
 1115
 1116
 1117                 /*******************************
 1118                 *        EXAMINE TABLES        *
 1119                 *******************************/
 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.
 1128current_table(Variant, Trie) :-
 1129    ct_generate(Variant),
 1130    !,
 1131    current_table_gen(Variant, Trie).
 1132current_table(Variant, Trie) :-
 1133    current_table_lookup(Variant, Trie),
 1134    !.
 1135
 1136current_table_gen(M:Variant, Trie) :-
 1137    '$tbl_local_variant_table'(VariantTrie),
 1138    trie_gen(VariantTrie, M:NonModed, Trie),
 1139    M:'$table_mode'(Variant, NonModed, _Moded).
 1140current_table_gen(M:Variant, Trie) :-
 1141    '$tbl_global_variant_table'(VariantTrie),
 1142    trie_gen(VariantTrie, M:NonModed, Trie),
 1143    \+ '$tbl_table_status'(Trie, fresh), % shared tables are not destroyed
 1144    M:'$table_mode'(Variant, NonModed, _Moded).
 1145
 1146current_table_lookup(M:Variant, Trie) :-
 1147    M:'$table_mode'(Variant, NonModed, _Moded),
 1148    '$tbl_local_variant_table'(VariantTrie),
 1149    trie_lookup(VariantTrie, M:NonModed, Trie).
 1150current_table_lookup(M:Variant, Trie) :-
 1151    M:'$table_mode'(Variant, NonModed, _Moded),
 1152    '$tbl_global_variant_table'(VariantTrie),
 1153    trie_lookup(VariantTrie, NonModed, Trie),
 1154    \+ '$tbl_table_status'(Trie, fresh).
 1155
 1156ct_generate(M:Variant) :-
 1157    (   var(Variant)
 1158    ->  true
 1159    ;   var(M)
 1160    ).
 1161
 1162                 /*******************************
 1163                 *      WRAPPER GENERATION      *
 1164                 *******************************/
 1165
 1166:- multifile
 1167    system:term_expansion/2,
 1168    tabled/2. 1169:- dynamic
 1170    system:term_expansion/2. 1171
 1172wrappers(Spec, M) -->
 1173    { tabling_defaults(
 1174          [ (table_incremental=true)            - (incremental=true),
 1175            (table_shared=true)                 - (tshared=true),
 1176            (table_subsumptive=true)            - ((mode)=subsumptive),
 1177            call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
 1178          ],
 1179          #{}, Defaults)
 1180    },
 1181    wrappers(Spec, M, Defaults).
 1182
 1183wrappers(Var, _, _) -->
 1184    { var(Var),
 1185      !,
 1186      '$instantiation_error'(Var)
 1187    }.
 1188wrappers(M:Spec, _, Opts) -->
 1189    !,
 1190    { '$must_be'(atom, M) },
 1191    wrappers(Spec, M, Opts).
 1192wrappers(Spec as Options, M, Opts0) -->
 1193    !,
 1194    { table_options(Options, Opts0, Opts) },
 1195    wrappers(Spec, M, Opts).
 1196wrappers((A,B), M, Opts) -->
 1197    !,
 1198    wrappers(A, M, Opts),
 1199    wrappers(B, M, Opts).
 1200wrappers(Name//Arity, M, Opts) -->
 1201    { atom(Name), integer(Arity), Arity >= 0,
 1202      !,
 1203      Arity1 is Arity+2
 1204    },
 1205    wrappers(Name/Arity1, M, Opts).
 1206wrappers(Name/Arity, Module, Opts) -->
 1207    { '$option'(mode(TMode), Opts, variant),
 1208      atom(Name), integer(Arity), Arity >= 0,
 1209      !,
 1210      functor(Head, Name, Arity),
 1211      '$tbl_trienode'(Reserved)
 1212    },
 1213    qualify(Module,
 1214            [ '$tabled'(Head, TMode),
 1215              '$table_mode'(Head, Head, Reserved)
 1216            ]),
 1217    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1218    ].
 1219wrappers(ModeDirectedSpec, Module, Opts) -->
 1220    { '$option'(mode(TMode), Opts, variant),
 1221      callable(ModeDirectedSpec),
 1222      !,
 1223      functor(ModeDirectedSpec, Name, Arity),
 1224      functor(Head, Name, Arity),
 1225      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1226      updater_clauses(Modes, Head, UpdateClauses),
 1227      mode_check(Moded, ModeTest),
 1228      (   ModeTest == true
 1229      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1230          TVariant = Head
 1231      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, Opts, ModeTest,
 1232                                            Module:Variant, Moded),
 1233          TVariant = Variant
 1234      )
 1235    },
 1236    qualify(Module,
 1237            [ '$tabled'(Head, TMode),
 1238              '$table_mode'(Head, TVariant, Moded)
 1239            ]),
 1240    [ (:- initialization(WrapClause, now))
 1241    ],
 1242    qualify(Module, UpdateClauses).
 1243wrappers(TableSpec, _M, _Opts) -->
 1244    { '$type_error'(table_desclaration, TableSpec)
 1245    }.
 1246
 1247qualify(Module, List) -->
 1248    { prolog_load_context(module, Module) },
 1249    !,
 1250    clist(List).
 1251qualify(Module, List) -->
 1252    qlist(List, Module).
 1253
 1254clist([])    --> [].
 1255clist([H|T]) --> [H], clist(T).
 1256
 1257qlist([], _)    --> [].
 1258qlist([H|T], M) --> [M:H], qlist(T, M).
 1259
 1260
 1261tabling_defaults([], Dict, Dict).
 1262tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
 1263    (   tabling_default(Condition)
 1264    ->  Dict1 = Dict0.put(Opt,Value)
 1265    ;   Dict1 = Dict0
 1266    ),
 1267    tabling_defaults(T, Dict1, Dict).
 1268
 1269tabling_default(Flag=FValue) :-
 1270    !,
 1271    current_prolog_flag(Flag, FValue).
 1272tabling_default(call(Term)) :-
 1273    call(Term).
 1274
 1275% Called from wrappers//2.
 1276
 1277subgoal_size_restraint(Level) :-
 1278    current_prolog_flag(max_table_subgoal_size_action, abstract),
 1279    current_prolog_flag(max_table_subgoal_size, Level).
 table_options(+Options, +OptDictIn, -OptDictOut)
Handler the ... as options ... construct.
 1285table_options(Options, _Opts0, _Opts) :-
 1286    var(Options),
 1287    '$instantiation_error'(Options).
 1288table_options((A,B), Opts0, Opts) :-
 1289    !,
 1290    table_options(A, Opts0, Opts1),
 1291    table_options(B, Opts1, Opts).
 1292table_options(subsumptive, Opts0, Opts1) :-
 1293    !,
 1294    put_dict(mode, Opts0, subsumptive, Opts1).
 1295table_options(variant, Opts0, Opts1) :-
 1296    !,
 1297    put_dict(mode, Opts0, variant, Opts1).
 1298table_options(incremental, Opts0, Opts1) :-
 1299    !,
 1300    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1301table_options(monotonic, Opts0, Opts1) :-
 1302    !,
 1303    put_dict(monotonic, Opts0, true, Opts1).
 1304table_options(opaque, Opts0, Opts1) :-
 1305    !,
 1306    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1307table_options(lazy, Opts0, Opts1) :-
 1308    !,
 1309    put_dict(lazy, Opts0, true, Opts1).
 1310table_options(dynamic, Opts0, Opts1) :-
 1311    !,
 1312    put_dict(dynamic, Opts0, true, Opts1).
 1313table_options(shared, Opts0, Opts1) :-
 1314    !,
 1315    put_dict(tshared, Opts0, true, Opts1).
 1316table_options(private, Opts0, Opts1) :-
 1317    !,
 1318    put_dict(tshared, Opts0, false, Opts1).
 1319table_options(max_answers(Count), Opts0, Opts1) :-
 1320    !,
 1321    restraint(max_answers, Count, Opts0, Opts1).
 1322table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1323    !,
 1324    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1325table_options(answer_abstract(Size), Opts0, Opts1) :-
 1326    !,
 1327    restraint(answer_abstract, Size, Opts0, Opts1).
 1328table_options(Opt, _, _) :-
 1329    '$domain_error'(table_option, Opt).
 1330
 1331restraint(Name, Value0, Opts0, Opts) :-
 1332    '$table_option'(Value0, Value),
 1333    (   Value < 0
 1334    ->  Opts = Opts0
 1335    ;   put_dict(Name, Opts0, Value, Opts)
 1336    ).
 mode_check(+Moded, -TestCode)
Enforce the output arguments of a mode-directed tabled predicate to be unbound.
 1344mode_check(Moded, Check) :-
 1345    var(Moded),
 1346    !,
 1347    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1348mode_check(Moded, true) :-
 1349    '$tbl_trienode'(Moded),
 1350    !.
 1351mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1352    Moded =.. [s|Vars],
 1353    var_check(Vars, Test).
 1354
 1355var_check([H|T], Test) :-
 1356    (   T == []
 1357    ->  Test = var(H)
 1358    ;   Test = (var(H),Rest),
 1359        var_check(T, Rest)
 1360    ).
 1361
 1362:- public
 1363    instantiated_moded_arg/1. 1364
 1365instantiated_moded_arg(Vars) :-
 1366    '$member'(V, Vars),
 1367    \+ var(V),
 1368    '$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,...)
 1380extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1381    compound(ModeSpec),
 1382    !,
 1383    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1384    compound_name_arguments(Head, Name, HeadArgs),
 1385    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1386    length(ModedArgs, Count),
 1387    atomic_list_concat([$,Name,$,Count], VName),
 1388    Variant =.. [VName|VariantArgs],
 1389    (   ModedArgs == []
 1390    ->  '$tbl_trienode'(ModedAnswer)
 1391    ;   ModedArgs = [ModedAnswer]
 1392    ->  true
 1393    ;   ModedAnswer =.. [s|ModedArgs]
 1394    ).
 1395extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1396    atomic_list_concat([$,Atom,$,0], Variant),
 1397    '$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?
 1407separate_args([], [], [], [], []).
 1408separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1409    indexed_mode(HM),
 1410    !,
 1411    separate_args(TM, TA, TNA, Modes, TMA).
 1412separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1413    separate_args(TM, TA, TNA, Modes, TMA).
 1414
 1415indexed_mode(Mode) :-                           % XSB
 1416    var(Mode),
 1417    !.
 1418indexed_mode(index).                            % YAP
 1419indexed_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.
 1426updater_clauses([], _, []) :- !.
 1427updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1428    update_goal(P, S0,S1,S2, Body).
 1429updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1430    length(Modes, Len),
 1431    functor(S0, s, Len),
 1432    functor(S1, s, Len),
 1433    functor(S2, s, Len),
 1434    S0 =.. [_|Args0],
 1435    S1 =.. [_|Args1],
 1436    S2 =.. [_|Args2],
 1437    update_body(Modes, Args0, Args1, Args2, true, Body).
 1438
 1439update_body([], _, _, _, Body, Body).
 1440update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1441    update_goal(P, A0,A1,A2, Goal),
 1442    mkconj(Body0, Goal, Body1),
 1443    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1444
 1445update_goal(Var, _,_,_, _) :-
 1446    var(Var),
 1447    !,
 1448    '$instantiation_error'(Var).
 1449update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1450    !,
 1451    '$must_be'(atom, M),
 1452    update_goal(lattice(PI), S0,S1,S2, Goal).
 1453update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1454    !,
 1455    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1456    '$must_be'(atom, Name),
 1457    Goal =.. [Name,S0,S1,S2].
 1458update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1459    compound(Head),
 1460    !,
 1461    compound_name_arity(Head, Name, Arity),
 1462    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1463    Goal =.. [Name,S0,S1,S2].
 1464update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1465    !,
 1466    '$must_be'(atom, Name),
 1467    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1468update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1469    !,
 1470    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1471    '$must_be'(atom, Name),
 1472    Call =.. [Name, S0, S1],
 1473    Goal = (Call -> S2 = S0 ; S2 = S1).
 1474update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1475    !,
 1476    '$must_be'(atom, M),
 1477    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1478    '$must_be'(atom, Name),
 1479    Call =.. [Name, S0, S1],
 1480    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1481update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1482    !,
 1483    '$must_be'(atom, M),
 1484    '$must_be'(atom, Name),
 1485    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1486update_goal(po(Name), S0,S1,S2, Goal) :-
 1487    !,
 1488    '$must_be'(atom, Name),
 1489    update_goal(po(Name/2), S0,S1,S2, Goal).
 1490update_goal(Alias, S0,S1,S2, Goal) :-
 1491    update_alias(Alias, Update),
 1492    !,
 1493    update_goal(Update, S0,S1,S2, Goal).
 1494update_goal(Mode, _,_,_, _) :-
 1495    '$domain_error'(tabled_mode, Mode).
 1496
 1497update_alias(first, lattice('$tabling':first/3)).
 1498update_alias(-,     lattice('$tabling':first/3)).
 1499update_alias(last,  lattice('$tabling':last/3)).
 1500update_alias(min,   lattice('$tabling':min/3)).
 1501update_alias(max,   lattice('$tabling':max/3)).
 1502update_alias(sum,   lattice('$tabling':sum/3)).
 1503
 1504mkconj(true, G,  G) :- !.
 1505mkconj(G1,   G2, (G1,G2)).
 1506
 1507
 1508		 /*******************************
 1509		 *          AGGREGATION		*
 1510		 *******************************/
 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.
 1520:- public first/3, last/3, min/3, max/3, sum/3. 1521
 1522first(S, _, S).
 1523last(_, S, S).
 1524min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1525max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1526sum(S0, S1, S) :- S is S0+S1.
 1527
 1528
 1529		 /*******************************
 1530		 *      DYNAMIC PREDICATES	*
 1531		 *******************************/
 $set_table_wrappers(:Head)
Clear/add wrappers and notifications to trap dynamic predicates. This is required both for incremental and monotonic tabling.
 1538'$set_table_wrappers'(Pred) :-
 1539    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1540        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1541    ->  wrap_incremental(Pred)
 1542    ;   unwrap_incremental(Pred)
 1543    ),
 1544    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1545    ->  wrap_monotonic(Pred)
 1546    ;   unwrap_monotonic(Pred)
 1547    ).
 1548
 1549		 /*******************************
 1550		 *       MONOTONIC TABLING	*
 1551		 *******************************/
 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.
 1558mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1559    '$idg_add_mono_dyn_dep'(Dynamic,
 1560                            dependency(Dynamic, Cont, Skel),
 1561                            ATrie).
 1562mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1563    '$idg_add_monotonic_dep'(SrcTrie,
 1564                             dependency(SrcSkel, IsMono, Cont, Skel),
 1565                             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.
 1575monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1576    '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1577                              dependency(SrcSkel, IsMono, Cont, Skel)).
 monotonic_dyn_affects(:Head, -Continuation, -Return, -ATrie)
Dynamic predicate that maintains the dependency from a monotonic
 1583monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1584    dyn_affected(Head, DTrie),
 1585    '$idg_mono_affects_eager'(DTrie, ATrie,
 1586                              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.
 1594wrap_monotonic(Head) :-
 1595    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1596                      '$start_monotonic'(Head, Wrapped)),
 1597    '$pi_head'(PI, Head),
 1598    prolog_listen(PI, monotonic_update).
 unwrap_monotonic(+Head)
Remove the monotonic wrappers and dependencies.
 1604unwrap_monotonic(Head) :-
 1605    '$pi_head'(PI, Head),
 1606    (   unwrap_predicate(PI, monotonic)
 1607    ->  prolog_unlisten(PI, monotonic_update)
 1608    ;   true
 1609    ).
 $start_monotonic(+Head, +Wrapped)
This is called the monotonic wrapper around a dynamic predicate to collect the dependencies between the dynamic predicate and the monotonic tabled predicates.
 1617'$start_monotonic'(Head, Wrapped) :-
 1618    (   '$tbl_collect_mono_dep'
 1619    ->  shift(dependency(Head)),
 1620        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1621        Wrapped,
 1622        tdebug(monotonic, '  --> ~p', [Head])
 1623    ;   Wrapped
 1624    ).
 monotonic_update(+Action, +ClauseRef)
Trap changes to the monotonic dynamic predicate and forward them.
 1630:- public monotonic_update/2. 1631monotonic_update(Action, ClauseRef) :-
 1632    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1633    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1634        mon_propagate(Action, Head, ClauseRef)
 1635    ;   true
 1636    ).
 mon_propagate(+Action, +Head, +ClauseRef)
Handle changes to a dynamic predicate as part of monotonic updates.
 1643mon_propagate(Action, Head, ClauseRef) :-
 1644    assert_action(Action),
 1645    !,
 1646    setup_call_cleanup(
 1647        '$tbl_propagate_start'(Old),
 1648        propagate_assert(Head),                 % eager monotonic dependencies
 1649        '$tbl_propagate_end'(Old)),
 1650    forall(dyn_affected(Head, ATrie),
 1651           '$mono_idg_changed'(ATrie, ClauseRef)). % lazy monotonic dependencies
 1652mon_propagate(retract, Head, _) :-
 1653    !,
 1654    mon_invalidate_dependents(Head).
 1655mon_propagate(rollback(Action), Head, _) :-
 1656    mon_propagate_rollback(Action, Head).
 1657
 1658mon_propagate_rollback(Action, _Head) :-
 1659    assert_action(Action),
 1660    !.
 1661mon_propagate_rollback(retract, Head) :-
 1662    mon_invalidate_dependents(Head).
 1663
 1664assert_action(asserta).
 1665assert_action(assertz).
 propagate_assert(+Head) is det
Propagate assertion of a dynamic clause with head Head.
 1671propagate_assert(Head) :-
 1672    tdebug(monotonic, 'Asserted ~p', [Head]),
 1673    (   monotonic_dyn_affects(Head, Cont, Skel, ATrie),
 1674        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1675        '$idg_set_current'(_, ATrie),
 1676        pdelim(Cont, Skel, ATrie),
 1677        fail
 1678    ;   true
 1679    ).
 propagate_answer(+SrcTrie, +SrcSkel) is det
Propagate the new answer SrcSkel to the answer table SrcTrie.
 1685propagate_answer(SrcTrie, SrcSkel) :-
 1686    (   monotonic_affects(SrcTrie, SrcSkel, true, Cont, Skel, ATrie),
 1687        tdebug(monotonic, 'Propagating tab ~p to ~p', [SrcTrie, ATrie]),
 1688        pdelim(Cont, Skel, ATrie),
 1689        fail
 1690    ;   true
 1691    ).
 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.
 1703pdelim(Worker, Skel, ATrie) :-
 1704    reset(Worker, Dep, Cont),
 1705    (   Cont == 0
 1706    ->  '$tbl_monotonic_add_answer'(ATrie, Skel),
 1707        propagate_answer(ATrie, Skel)
 1708    ;   mon_assert_dep(Dep, Cont, Skel, ATrie),
 1709        pdelim(Cont, Skel, ATrie)
 1710    ).
 mon_invalidate_dependents(+Head)
A non-monotonic operation was done on Head. Invalidate all dependent tables, preparing for normal incremental reevaluation on the next cycle.
 1718mon_invalidate_dependents(Head) :-
 1719    tdebug(monotonic, 'Invalidate dependents for ~p', [Head]),
 1720    forall(dyn_affected(Head, ATrie),
 1721           '$idg_mono_invalidate'(ATrie)).
 abolish_monotonic_tables
Abolish all monotonic tables and the monotonic dependency relations.
To be done
- : just prepare for incremental reevaluation?
 1729abolish_monotonic_tables :-
 1730    (   '$tbl_variant_table'(VariantTrie),
 1731        trie_gen(VariantTrie, Goal, ATrie),
 1732        '$get_predicate_attribute'(Goal, monotonic, 1),
 1733        '$tbl_destroy_table'(ATrie),
 1734        fail
 1735    ;   true
 1736    ).
 1737
 1738		 /*******************************
 1739		 *      INCREMENTAL TABLING	*
 1740		 *******************************/
 wrap_incremental(:Head) is det
Wrap an incremental dynamic predicate to be added to the IDG.
 1746wrap_incremental(Head) :-
 1747    tdebug(monotonic, 'Wrapping ~p', [Head]),
 1748    abstract_goal(Head, Abstract),
 1749    '$pi_head'(PI, Head),
 1750    (   Head == Abstract
 1751    ->  prolog_listen(PI, dyn_update)
 1752    ;   prolog_listen(PI, dyn_update(Abstract))
 1753    ).
 1754
 1755abstract_goal(M:Head, M:Abstract) :-
 1756    compound(Head),
 1757    '$get_predicate_attribute'(M:Head, abstract, 1),
 1758    !,
 1759    compound_name_arity(Head, Name, Arity),
 1760    functor(Abstract, Name, Arity).
 1761abstract_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.
 1771:- public dyn_update/2, dyn_update/3. 1772
 1773dyn_update(_Action, ClauseRef) :-
 1774    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1775    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1776        dyn_changed_pattern(Head)
 1777    ;   true
 1778    ).
 1779
 1780dyn_update(Abstract, _, _) :-
 1781    dyn_changed_pattern(Abstract).
 1782
 1783dyn_changed_pattern(Term) :-
 1784    forall(dyn_affected(Term, ATrie),
 1785           '$idg_changed'(ATrie)).
 1786
 1787dyn_affected(Term, ATrie) :-
 1788    '$tbl_variant_table'(VTable),
 1789    trie_gen(VTable, Term, ATrie).
 unwrap_incremental(:Head) is det
Remove dynamic predicate incremenal forwarding, reset the possible abstract property and remove possible tables.
 1796unwrap_incremental(Head) :-
 1797    '$pi_head'(PI, Head),
 1798    abstract_goal(Head, Abstract),
 1799    (   Head == Abstract
 1800    ->  prolog_unlisten(PI, dyn_update)
 1801    ;   '$set_predicate_attribute'(Head, abstract, 0),
 1802        prolog_unlisten(PI, dyn_update(_))
 1803    ),
 1804    (   '$tbl_variant_table'(VariantTrie)
 1805    ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1806               '$tbl_destroy_table'(ATrie))
 1807    ;   true
 1808    ).
 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
 1834reeval(ATrie, Goal, Return) :-
 1835    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1836          retry_reeval(ATrie, Goal)).
 1837
 1838retry_reeval(ATrie, Goal) :-
 1839    '$tbl_reeval_abandon'(ATrie),
 1840    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1841    sleep(0.000001),
 1842    call(Goal).
 1843
 1844try_reeval(ATrie, Goal, Return) :-
 1845    nb_current('$tbl_reeval', true),
 1846    !,
 1847    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1848    do_reeval(ATrie, Goal, Return).
 1849try_reeval(ATrie, Goal, Return) :-
 1850    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1851    findall(Path, false_path(ATrie, Path), Paths0),
 1852    sort(0, @>, Paths0, Paths1),
 1853    clean_paths(Paths1, Paths),
 1854    tdebug(forall('$member'(Path, Paths),
 1855                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1856    reeval_paths(Paths, ATrie),
 1857    do_reeval(ATrie, Goal, Return).
 1858
 1859do_reeval(ATrie, Goal, Return) :-
 1860    '$tbl_reeval_prepare_top'(ATrie, Clause),
 1861    (   Clause == 0                          % complete and answer subsumption
 1862    ->  '$tbl_table_status'(ATrie, _Status, M:Variant, Return),
 1863        M:'$table_mode'(Goal0, Variant, ModeArgs),
 1864        Goal = M:Goal0,
 1865        moded_gen_answer(ATrie, Return, ModeArgs)
 1866    ;   nonvar(Clause)                       % complete
 1867    ->  trie_gen_compiled(Clause, Return)
 1868    ;   call(Goal)                           % actually re-evaluate
 1869    ).
 clean_paths(+PathsIn, -Paths)
Clean the reevaluation paths. Get rid of the head term for ranking and remove duplicate paths. Note that a Path is a list of tries, ground terms.
 1878clean_paths([], []).
 1879clean_paths([[_|Path]|T0], [Path|T]) :-
 1880    clean_paths(T0, Path, T).
 1881
 1882clean_paths([], _, []).
 1883clean_paths([[_|CPath]|T0], CPath, T) :-
 1884    !,
 1885    clean_paths(T0, CPath, T).
 1886clean_paths([[_|Path]|T0], _, [Path|T]) :-
 1887    clean_paths(T0, Path, T).
 reeval_paths(+Paths, +Atrie)
Make Atrie valid again by re-evaluating nodes in Paths. We stop as soon as Atrie is valid again. Note that we may not need to reevaluate all paths because evaluating the head of some path may include other nodes in an SCC, making them valid as well.
 1896reeval_paths([], _) :-
 1897    !.
 1898reeval_paths(BottomUp, ATrie) :-
 1899    is_invalid(ATrie),
 1900    !,
 1901    reeval_heads(BottomUp, ATrie, BottomUp1),
 1902    tdebug(assertion(BottomUp \== BottomUp1)),
 1903    '$list_to_set'(BottomUp1, BottomUp2),
 1904    reeval_paths(BottomUp2, ATrie).
 1905reeval_paths(_, _).
 1906
 1907reeval_heads(_, ATrie, []) :-                % target is valid again
 1908    \+ is_invalid(ATrie),
 1909    !.
 1910reeval_heads([], _, []).
 1911reeval_heads([[H]|B], ATrie, BT) :-          % Last one of a falsepath
 1912    reeval_node(H),
 1913    !,
 1914    reeval_heads(B, ATrie, BT).
 1915reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1916    reeval_node(H),
 1917    !,
 1918    reeval_heads(B, ATrie, BT).
 1919reeval_heads([FP|B], ATrie, [FP|BT]) :-
 1920    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 s(Rank,Length,ATrie) 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.

 1932false_path(ATrie, BottomUp) :-
 1933    false_path(ATrie, Path, []),
 1934    '$reverse'(Path, BottomUp).
 1935
 1936false_path(ATrie, [ATrie|T], Seen) :-
 1937    \+ memberchk(ATrie, Seen),
 1938    '$idg_false_edge'(ATrie, Dep, Status),
 1939    tdebug(reeval, '    ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
 1940    (   Status == invalid
 1941    ->  false_path(Dep, T, [ATrie|Seen])
 1942    ;   status_rank(Status, Rank),
 1943        length(Seen, Len),
 1944        T = [s(Rank,Len,Dep)]
 1945    ).
 1946
 1947status_rank(dynamic,   2) :- !.
 1948status_rank(monotonic, 2) :- !.
 1949status_rank(complete,  1) :- !.
 1950status_rank(Status,    Rank) :-
 1951    var(Rank),
 1952    !,
 1953    format(user_error, 'Re-eval from status ~p~n', [Status]),
 1954    Rank = 0.
 1955status_rank(Rank,   Rank) :-
 1956    format(user_error, 'Re-eval from rank ~p~n', [Rank]).
 1957
 1958is_invalid(ATrie) :-
 1959    '$idg_falsecount'(ATrie, FalseCount),
 1960    FalseCount > 0.
 reeval_node(+ATrie) is semidet
Re-evaluate the invalid answer trie ATrie. Initially this created a nested tabling environment, but this is dropped:

Fails if the node is not ready for evaluation. This is the case if it is valid or it is a lazy table that has invalid dependencies.

 1976reeval_node(ATrie) :-
 1977    '$tbl_reeval_prepare'(ATrie, M:Variant),
 1978    !,
 1979    M:'$table_mode'(Goal0, Variant, _Moded),
 1980    Goal = M:Goal0,
 1981    tdebug(reeval, 'Re-evaluating ~p', [Goal]),
 1982    (   '$idg_reset_current',
 1983        setup_call_cleanup(
 1984            nb_setval('$tbl_reeval', true),
 1985            ignore(Goal),                    % assumes local scheduling
 1986            nb_delete('$tbl_reeval')),
 1987        fail
 1988    ;   tdebug(reeval, 'Re-evaluated ~p', [Goal])
 1989    ).
 1990reeval_node(ATrie) :-
 1991    '$mono_reeval_prepare'(ATrie, Size),
 1992    !,
 1993    setup_call_cleanup(
 1994        '$tbl_propagate_start'(Old),
 1995        reeval_monotonic_node(ATrie, Size),
 1996        '$tbl_propagate_end'(Old)).
 1997reeval_node(ATrie) :-
 1998    \+ is_invalid(ATrie).
 1999
 2000reeval_monotonic_node(ATrie, Size) :-
 2001    tdebug(reeval, 'Re-evaluating lazy monotonic ~p', [ATrie]),
 2002    (   '$idg_mono_affects_lazy'(ATrie, _0SrcTrie, Dep, DepRef, Answers),
 2003        length(Answers, Count),
 2004        (   Dep = dependency(Head, Cont, Skel)
 2005        ->  (   '$member'(ClauseRef, Answers),
 2006                '$clause'(Head, _Body, ClauseRef, _Bindings),
 2007                tdebug(monotonic, 'Propagating ~p from ~p to ~p',
 2008                       [Head, _0SrcTrie, ATrie]),
 2009                pdelim(Cont, Skel, ATrie),
 2010                fail
 2011            ;   '$idg_mono_empty_queue'(DepRef, Count)
 2012            )
 2013        ;   Dep = dependency(SrcSkel, true, Cont, Skel)
 2014        ->  (   '$member'(Node, Answers),
 2015                '$tbl_node_answer'(Node, SrcSkel),
 2016                tdebug(monotonic, 'Propagating ~p from ~p to ~p',
 2017                       [Skel, _0SrcTrie, ATrie]),
 2018                pdelim(Cont, Skel, ATrie),
 2019                fail
 2020            ;   '$idg_mono_empty_queue'(DepRef, Count)
 2021            )
 2022        ;   tdebug(monotonic, 'Skipped queued ~p, answers ~p',
 2023                   [Dep, Answers])
 2024        ),
 2025        fail
 2026    ;   '$mono_reeval_done'(ATrie, Size, Deps),
 2027        (   Deps == []
 2028        ->  tdebug(reeval, 'Re-evaluation for ~p complete', [ATrie])
 2029        ;   Deps == false
 2030        ->  tdebug(reeval, 'Re-evaluation for ~p queued new answers', [ATrie]),
 2031            reeval_node(ATrie)
 2032        ;   tdebug(reeval, 'Re-evaluation for ~p: new invalid deps: ~p', [ATrie, Deps]),
 2033            reeval_nodes(Deps),
 2034            reeval_node(ATrie)
 2035        )
 2036    ).
 2037
 2038reeval_nodes([]).
 2039reeval_nodes([H|T]) :-
 2040    reeval_node(H),
 2041    reeval_nodes(T).
 2042
 2043
 2044		 /*******************************
 2045		 *      EXPAND DIRECTIVES	*
 2046		 *******************************/
 2047
 2048system:term_expansion((:- table(Preds)), Expansion) :-
 2049    \+ current_prolog_flag(xref, true),
 2050    prolog_load_context(module, M),
 2051    phrase(wrappers(Preds, M), Clauses),
 2052    multifile_decls(Clauses, Directives0),
 2053    sort(Directives0, Directives),
 2054    '$append'(Directives, Clauses, Expansion).
 2055
 2056multifile_decls([], []).
 2057multifile_decls([H0|T0], [H|T]) :-
 2058    multifile_decl(H0, H),
 2059    !,
 2060    multifile_decls(T0, T).
 2061multifile_decls([_|T0], T) :-
 2062    multifile_decls(T0, T).
 2063
 2064multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 2065    !,
 2066    functor(Head, Name, Arity).
 2067multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 2068    !,
 2069    functor(Head, Name, Arity).
 2070multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 2071    !,
 2072    functor(Head, Name, Arity).
 2073multifile_decl(Head, (:- multifile(Name/Arity))) :-
 2074    !,
 2075    Head \= (:-_),
 2076    functor(Head, Name, Arity).
 2077
 2078
 2079		 /*******************************
 2080		 *      ANSWER COMPLETION	*
 2081		 *******************************/
 2082
 2083:- 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()
 2099answer_completion(AnswerTrie, Return) :-
 2100    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 2101    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 2102    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 2103                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 2104    (   Propagated > 0
 2105    ->  answer_completion(AnswerTrie, Return)
 2106    ;   true
 2107    ).
 2108
 2109answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 2110    (   eval_subgoal_in_residual(AnswerTrie, Return),
 2111        fail
 2112    ;   true
 2113    ),
 2114    delete_answers_for_failing_calls(Propagated),
 2115    (   Propagated == 0
 2116    ->  mark_succeeding_calls_as_answer_completed
 2117    ;   true
 2118    ).
 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.
 2126delete_answers_for_failing_calls(Propagated) :-
 2127    State = state(0),
 2128    (   subgoal_residual_trie(ASGF, ESGF),
 2129        \+ trie_gen(ESGF, _ETmp),
 2130        tdebug(trie_goal(ASGF, Goal0, _)),
 2131        tdebug(trie_goal(ASGF, Goal, _0Return)),
 2132        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 2133        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 2134	'$tbl_force_truth_value'(ALeaf, false, Count),
 2135        arg(1, State, Prop0),
 2136        Prop is Prop0+Count-1,
 2137        nb_setarg(1, State, Prop),
 2138	fail
 2139    ;   arg(1, State, Propagated)
 2140    ).
 2141
 2142mark_succeeding_calls_as_answer_completed :-
 2143    (   subgoal_residual_trie(ASGF, _ESGF),
 2144        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 2145        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 2146            tdebug(trie_goal(ASGF, Goal, _0Return)),
 2147            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 2148            '$tbl_set_answer_completed'(ASGF)
 2149        ),
 2150        fail
 2151    ;   true
 2152    ).
 2153
 2154subgoal_residual_trie(ASGF, ESGF) :-
 2155    '$tbl_variant_table'(VariantTrie),
 2156    context_module(M),
 2157    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.
 2164eval_dl_in_residual(true) :-
 2165    !.
 2166eval_dl_in_residual((A;B)) :-
 2167    !,
 2168    (   eval_dl_in_residual(A)
 2169    ;   eval_dl_in_residual(B)
 2170    ).
 2171eval_dl_in_residual((A,B)) :-
 2172    !,
 2173    eval_dl_in_residual(A),
 2174    eval_dl_in_residual(B).
 2175eval_dl_in_residual(tnot(G)) :-
 2176    !,
 2177    tdebug(ac, ' ? tnot(~p)', [G]),
 2178    current_table(G, SGF),
 2179    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2180    tnot(eval_subgoal_in_residual(SGF, Return)).
 2181eval_dl_in_residual(G) :-
 2182    tdebug(ac, ' ? ~p', [G]),
 2183    (   current_table(G, SGF)
 2184    ->	true
 2185    ;   more_general_table(G, SGF)
 2186    ->	true
 2187    ;	writeln(user_error, 'MISSING CALL? '(G)),
 2188        fail
 2189    ),
 2190    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2191    eval_subgoal_in_residual(SGF, Return).
 2192
 2193more_general_table(G, Trie) :-
 2194    term_variables(G, Vars),
 2195    '$tbl_variant_table'(VariantTrie),
 2196    trie_gen(VariantTrie, G, Trie),
 2197    is_most_general_term(Vars).
 2198
 2199:- 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.
 2206eval_subgoal_in_residual(AnswerTrie, _Return) :-
 2207    '$tbl_is_answer_completed'(AnswerTrie),
 2208    !,
 2209    undefined.
 2210eval_subgoal_in_residual(AnswerTrie, Return) :-
 2211    '$tbl_answer'(AnswerTrie, Return, Condition),
 2212    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 2213    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 2214    eval_dl_in_residual(Condition).
 2215
 2216
 2217		 /*******************************
 2218		 *            TRIPWIRES		*
 2219		 *******************************/
 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.
 2227:- public tripwire/3. 2228:- multifile prolog:tripwire/2. 2229
 2230tripwire(Wire, _Action, Context) :-
 2231    prolog:tripwire(Wire, Context),
 2232    !.
 2233tripwire(Wire, Action, Context) :-
 2234    Error = error(resource_error(tripwire(Wire, Context)), _),
 2235    tripwire_action(Action, Error).
 2236
 2237tripwire_action(warning, Error) :-
 2238    print_message(warning, Error).
 2239tripwire_action(error, Error) :-
 2240    throw(Error).
 2241tripwire_action(suspend, Error) :-
 2242    print_message(warning, Error),
 2243    break.
 2244
 2245
 2246		 /*******************************
 2247		 *   SYSTEM TABLED PREDICATES	*
 2248		 *******************************/
 2249
 2250:- table
 2251    system:undefined/0,
 2252    system:answer_count_restraint/0,
 2253    system:radial_restraint/0,
 2254    system:tabled_call/1.
 undefined is undefined
Expresses the value bottom from the well founded semantics.
 2260system:(undefined :-
 2261    tnot(undefined)).
 answer_count_restraint is undefined
 radial_restraint is undefined
Similar to undefined/0, providing a specific undefined for restraint violations.
 2269system:(answer_count_restraint :-
 2270    tnot(answer_count_restraint)).
 2271
 2272system:(radial_restraint :-
 2273    tnot(radial_restraint)).
 2274
 2275system:(tabled_call(X) :- call(X))