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-2019, 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            undefined/0,
   43
   44            current_table/2,            % :Variant, ?Table
   45            abolish_all_tables/0,
   46            abolish_table_subgoals/1,   % :Subgoal
   47            abolish_module_tables/1,    % +Module
   48            abolish_nonincremental_tables/0,
   49            abolish_nonincremental_tables/1, % +Options
   50
   51            start_tabling/3,            % +Closure, +Wrapper, :Worker
   52            start_subsumptive_tabling/3,% +Closure, +Wrapper, :Worker
   53            start_tabling/5,            % +Closure, +Wrapper, :Worker, :Variant, ?ModeArgs
   54
   55            '$wrap_tabled'/2,		% :Head, +Mode
   56            '$moded_wrap_tabled'/4,	% :Head, +ModeTest, +Variant, +Moded
   57            '$wfs_call'/2,              % :Goal, -Delays
   58
   59            '$wrap_incremental'/1,      % :Head
   60            '$unwrap_incremental'/1     % :Head
   61          ]).   62
   63:- meta_predicate
   64    table(:),
   65    untable(:),
   66    tnot(0),
   67    start_tabling(+, +, 0),
   68    start_tabling(+, +, 0, +, ?),
   69    current_table(:, -),
   70    abolish_table_subgoals(:),
   71    '$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 */
   83% Enable debugging using debug(tabling(Topic)) when compiled with
   84% -DO_DEBUG
   85goal_expansion(tdebug(Topic, Fmt, Args), Expansion) :-
   86    (   current_prolog_flag(prolog_debug, true)
   87    ->  Expansion = debug(tabling(Topic), Fmt, Args)
   88    ;   Expansion = true
   89    ).
   90goal_expansion(tdebug(Goal), Expansion) :-
   91    (   current_prolog_flag(prolog_debug, true)
   92    ->  Expansion = (   debugging(tabling(_))
   93                    ->  (   Goal
   94                        ->  true
   95                        ;   print_message(error, goal_failed(Goal))
   96                        )
   97                    ;   true
   98                    )
   99    ;   Expansion = true
  100    ).
  101
  102:- if(current_prolog_flag(prolog_debug, true)).  103wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
  104    !,
  105    '$tbl_worklist_data'(WorkList, worklist(_SCC,Trie,_,_,_)),
  106    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  107    unqualify_goal(Wrapper, user, Goal).
  108wl_goal(WorkList, Goal, Skeleton) :-
  109    '$tbl_worklist_data'(WorkList, worklist(_SCC,Trie,_,_,_)),
  110    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  111    unqualify_goal(Wrapper, user, Goal).
  112
  113trie_goal(ATrie, Goal, Skeleton) :-
  114    '$tbl_table_status'(ATrie, _Status, Wrapper, Skeleton),
  115    unqualify_goal(Wrapper, user, Goal).
  116
  117delay_goals(List, Goal) :-
  118    delay_goals(List, user, Goal).
  119
  120user_goal(Goal, UGoal) :-
  121    unqualify_goal(Goal, user, UGoal).
  122
  123:- multifile
  124    prolog:portray/1.  125
  126user:portray(ATrie) :-
  127    '$is_answer_trie'(ATrie),
  128    trie_goal(ATrie, Goal, _Skeleton),
  129    format('~q for ~p', [ATrie, Goal]).
  130
  131:- 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.

  156table(M:PIList) :-
  157    setup_call_cleanup(
  158        '$set_source_module'(OldModule, M),
  159        expand_term((:- table(PIList)), Clauses),
  160        '$set_source_module'(OldModule)),
  161    dyn_tabling_list(Clauses, M).
  162
  163dyn_tabling_list([], _).
  164dyn_tabling_list([H|T], M) :-
  165    dyn_tabling(H, M),
  166    dyn_tabling_list(T, M).
  167
  168dyn_tabling(M:Clause, _) :-
  169    !,
  170    dyn_tabling(Clause, M).
  171dyn_tabling((:- multifile(PI)), M) :-
  172    !,
  173    multifile(M:PI),
  174    dynamic(M:PI).
  175dyn_tabling(:- initialization(Wrap, now), M) :-
  176    !,
  177    M:Wrap.
  178dyn_tabling('$tabled'(Head, TMode), M) :-
  179    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  180        (   OMode \== TMode
  181        ->  erase(Ref),
  182            fail
  183        ;   true
  184        )
  185    ->  true
  186    ;   assertz(M:'$tabled'(Head, TMode))
  187    ).
  188dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  189    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  190    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  191        ->  true
  192        ;   erase(Ref),
  193            assertz(M:'$table_mode'(Head, Variant, Moded))
  194        )
  195    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  196    ).
  197dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  198    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  199    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  200        ->  true
  201        ;   erase(Ref),
  202            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  203        )
  204    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  205    ).
 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.
  216untable(M:PIList) :-
  217    untable(PIList, M).
  218
  219untable(Var, _) :-
  220    var(Var),
  221    !,
  222    '$instantiation_error'(Var).
  223untable(M:Spec, _) :-
  224    !,
  225    '$must_be'(atom, M),
  226    untable(Spec, M).
  227untable((A,B), M) :-
  228    !,
  229    untable(A, M),
  230    untable(B, M).
  231untable(Name//Arity, M) :-
  232    atom(Name), integer(Arity), Arity >= 0,
  233    !,
  234    Arity1 is Arity+2,
  235    untable(Name/Arity1, M).
  236untable(Name/Arity, M) :-
  237    !,
  238    functor(Head, Name, Arity),
  239    (   '$get_predicate_attribute'(M:Head, tabled, 1)
  240    ->  abolish_table_subgoals(M:Head),
  241        dynamic(M:'$tabled'/2),
  242        dynamic(M:'$table_mode'/3),
  243        retractall(M:'$tabled'(Head, _TMode)),
  244        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  245        unwrap_predicate(M:Name/Arity, table),
  246        '$set_predicate_attribute'(M:Head, tabled, false)
  247    ;   true
  248    ).
  249untable(Head, M) :-
  250    callable(Head),
  251    !,
  252    functor(Head, Name, Arity),
  253    untable(Name/Arity, M).
  254untable(TableSpec, _) :-
  255    '$type_error'(table_desclaration, TableSpec).
  256
  257untable_reconsult(PI) :-
  258    print_message(informational, untable(PI)),
  259    untable(PI).
  260
  261:- initialization
  262   prolog_listen(untable, untable_reconsult).
 start_tabling(: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.
Compatibility
- This interface may change or disappear without notice from future versions.
  275'$wrap_tabled'(Head, Options) :-
  276    get_dict(mode, Options, subsumptive),
  277    !,
  278    set_pattributes(Head, Options),
  279    '$wrap_predicate'(Head, table, Closure, Wrapped,
  280                      start_subsumptive_tabling(Closure, Head, Wrapped)).
  281'$wrap_tabled'(Head, Options) :-
  282    !,
  283    set_pattributes(Head, Options),
  284    '$wrap_predicate'(Head, table, Closure, Wrapped,
  285                      start_tabling(Closure, Head, Wrapped)).
  286
  287set_pattributes(Head, Options) :-
  288    '$set_predicate_attribute'(Head, tabled, true),
  289    (   get_dict(incremental, Options, true)
  290    ->  '$set_predicate_attribute'(Head, incremental, true)
  291    ;   true
  292    ),
  293    (   get_dict(dynamic, Options, true)
  294    ->  '$set_predicate_attribute'(Head, dynamic, true)
  295    ;   true
  296    ),
  297    (   get_dict(tshared, Options, true)
  298    ->  '$set_predicate_attribute'(Head, tshared, true)
  299    ;   true
  300    ).
  301
  302
  303start_tabling(Closure, Wrapper, Worker) :-
  304    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton),
  305    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  306    (   Status == complete
  307    ->  trie_gen_compiled(Trie, Skeleton)
  308    ;   Status == fresh
  309    ->  catch(create_table(Trie, Skeleton, Wrapper, Worker),
  310              deadlock,
  311              restart_tabling(Closure, Wrapper, Worker))
  312    ;   Status == invalid
  313    ->  reeval(Trie, Wrapper, Skeleton)
  314    ;   % = run_follower, but never fresh and Status is a worklist
  315        shift(call_info(Skeleton, Status))
  316    ).
  317
  318create_table(Trie, Skeleton, Wrapper, Worker) :-
  319    '$tbl_create_subcomponent'(SCC, Trie),
  320    tdebug(user_goal(Wrapper, Goal)),
  321    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  322    setup_call_catcher_cleanup(
  323        '$idg_set_current'(OldCurrent, Trie),
  324        run_leader(Skeleton, Worker, Trie, SCC, LStatus, Clause),
  325        Catcher,
  326        finished_leader(OldCurrent, Catcher, SCC, Wrapper)),
  327    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  328    done_leader(LStatus, SCC, 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.
  339restart_tabling(Closure, Wrapper, Worker) :-
  340    tdebug(user_goal(Wrapper, Goal)),
  341    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  342    sleep(0.000001),
  343    start_tabling(Closure, Wrapper, Worker).
 start_subsumptive_tabling(:Wrapper, :Implementation)
  348start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  349    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  350    ->  (   Status == complete
  351        ->  trie_gen_compiled(Trie, Skeleton)
  352        ;   Status == invalid
  353        ->  reeval(Trie),
  354            trie_gen_compiled(Trie, Skeleton)
  355        ;   shift(call_info(Skeleton, Status))
  356        )
  357    ;   more_general_table(Wrapper, ATrie),
  358        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  359    ->  '$tbl_answer_update_dl'(ATrie, Skeleton)
  360    ;   '$tbl_variant_table'(Closure, Wrapper, Trie, _0Status, Skeleton),
  361        tdebug(_0Status == fresh),
  362        '$tbl_create_subcomponent'(SCC, Trie),
  363        tdebug(user_goal(Wrapper, Goal)),
  364        tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  365        setup_call_catcher_cleanup(
  366            '$idg_set_current'(OldCurrent, Trie),
  367            run_leader(Skeleton, Worker, Trie, SCC, LStatus, Clause),
  368            Catcher,
  369            finished_leader(OldCurrent, Catcher, SCC, Wrapper)),
  370        tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  371        done_leader(LStatus, SCC, Skeleton, Clause)
  372    ).
  373
  374
  375:- '$hide'((done_leader/4, finished_leader/4)).  376
  377done_leader(complete, _SCC, Skeleton, Clause) :-
  378    !,
  379    trie_gen_compiled(Clause, Skeleton).
  380done_leader(final, SCC, Skeleton, Clause) :-
  381    !,
  382    '$tbl_free_component'(SCC),
  383    trie_gen_compiled(Clause, Skeleton).
  384done_leader(_,_,_,_).
  385
  386finished_leader(OldCurrent, Catcher, SCC, Wrapper) :-
  387    '$idg_set_current'(OldCurrent),
  388    (   Catcher == exit
  389    ->  true
  390    ;   Catcher == fail
  391    ->  true
  392    ;   Catcher = exception(_)
  393    ->  '$tbl_table_discard_all'(SCC)
  394    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  395    ).
 run_leader(+Wrapper, +Worker, +Trie, +SCC, -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.

  410run_leader(Skeleton, Worker, Trie, SCC, Status, Clause) :-
  411    tdebug('$tbl_table_status'(Trie, _Status, Wrapper, Skeleton)),
  412    tdebug(user_goal(Wrapper, Goal)),
  413    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  414    activate(Skeleton, Worker, Trie, Worklist),
  415    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  416    completion(SCC, Status, Clause),
  417    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  418    (   Status == merged
  419    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  420        '$tbl_wkl_make_follower'(Worklist),
  421        shift(call_info(Skeleton, Worklist))
  422    ;   true                                    % completed
  423    ).
  424
  425activate(Wrapper, Worker, Trie, WorkList) :-
  426    '$tbl_new_worklist'(WorkList, Trie),
  427    tdebug(activate, '~p: created wl=~p, trie=~p',
  428           [Wrapper, WorkList, Trie]),
  429    (   reset_delays,
  430        delim(Wrapper, Worker, WorkList, []),
  431        fail
  432    ;   true
  433    ).
 delim(+Wrapper, +Worker, +WorkList, +Delays)
Call/resume Worker for non-mode directed tabled predicates.
  439delim(Wrapper, Worker, WorkList, Delays) :-
  440    reset(Worker, SourceCall, Continuation),
  441    tdebug(wl_goal(WorkList, Goal, _)),
  442    (   Continuation == 0
  443    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  444        tdebug(delay_goals(AllDelays, Cond)),
  445        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  446               [Wrapper, Goal, Cond]),
  447        '$tbl_wkl_add_answer'(WorkList, Wrapper, Delays, Complete),
  448        Complete == !,
  449        !
  450    ;   SourceCall = call_info(SrcSkeleton, SourceWL),
  451        '$tbl_add_global_delays'(Delays, AllDelays),
  452        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  453        tdebug(wl_goal(WorkList, DstGoal, _)),
  454        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  455        '$tbl_wkl_add_suspension'(
  456            SourceWL,
  457            dependency(SrcSkeleton, Continuation, Wrapper, WorkList, AllDelays))
  458    ).
 start_tabling(:Wrapper, :Implementation, +Variant, +ModeArgs)
As start_tabling/2, but in addition separates the data stored in the answer trie in the Variant and ModeArgs.
  465'$moded_wrap_tabled'(Head, ModeTest, WrapperNoModes, ModeArgs) :-
  466    '$set_predicate_attribute'(Head, tabled, true),
  467    '$wrap_predicate'(Head, table, Closure, Wrapped,
  468                      (   ModeTest,
  469                          start_tabling(Closure, Head, Wrapped, WrapperNoModes, ModeArgs)
  470                      )).
  471
  472
  473start_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  474    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie, Status, _Skeleton),
  475    (   Status == complete
  476    ->  trie_gen(Trie, WrapperNoModes, ModeArgs)
  477    ;   Status == fresh
  478    ->  '$tbl_create_subcomponent'(SubComponent, Trie),
  479        setup_call_catcher_cleanup(
  480            '$idg_set_current'(OldCurrent, Trie),
  481            run_leader(Wrapper, WrapperNoModes, ModeArgs,
  482                       Worker, Trie, SubComponent, LStatus),
  483            Catcher,
  484            finished_leader(OldCurrent, Catcher, SubComponent, Wrapper)),
  485        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  486               [Wrapper, ModeArgs, LStatus]),
  487        moded_done_leader(LStatus, SubComponent, WrapperNoModes, ModeArgs, Trie)
  488    ;   Status == invalid
  489    ->  reeval(Trie),
  490        trie_gen(Trie, WrapperNoModes, ModeArgs)
  491    ;   % = run_follower, but never fresh and Status is a worklist
  492        shift(call_info(Wrapper, Status))
  493    ).
  494
  495moded_done_leader(complete, _SCC, WrapperNoModes, ModeArgs, Trie) :-
  496    !,
  497    trie_gen(Trie, WrapperNoModes, ModeArgs).
  498moded_done_leader(final, SCC, WrapperNoModes, ModeArgs, Trie) :-
  499    !,
  500    '$tbl_free_component'(SCC),
  501    trie_gen(Trie, WrapperNoModes, ModeArgs).
  502moded_done_leader(_, _, _, _, _).
  503
  504
  505get_wrapper_no_mode_args(M:Wrapper, M:WrapperNoModes, ModeArgs) :-
  506    M:'$table_mode'(Wrapper, WrapperNoModes, ModeArgs).
  507
  508run_leader(Wrapper, WrapperNoModes, ModeArgs, Worker, Trie, SCC, Status) :-
  509    moded_activate(Wrapper, WrapperNoModes, ModeArgs, Worker, Trie, Worklist),
  510    completion(SCC, Status, _Clause),           % TBD: propagate
  511    (   Status == merged
  512    ->  tdebug(scc, 'Turning leader ~p into follower', [Wrapper]),
  513        (   trie_gen(Trie, WrapperNoModes1, ModeArgs1),
  514            tdebug(scc, 'Adding old answer ~p+~p to worklist ~p',
  515                   [ WrapperNoModes1, ModeArgs1, Worklist]),
  516            '$tbl_wkl_mode_add_answer'(Worklist, WrapperNoModes1,
  517                                       ModeArgs1, Wrapper),
  518            fail
  519        ;   true
  520        ),
  521        shift(call_info(Wrapper, Worklist))
  522    ;   true                                    % completed
  523    ).
  524
  525
  526moded_activate(Wrapper, WrapperNoModes, _ModeArgs, Worker, Trie, WorkList) :-
  527    '$tbl_new_worklist'(WorkList, Trie),
  528    (   moded_delim(Wrapper, WrapperNoModes, Worker, WorkList, []), % FIXME: Delay list
  529        fail
  530    ;   true
  531    ).
 moded_delim(+Wrapper, +WrapperNoModes, +Worker, +WorkList, +Delays)
Call/resume Worker for mode directed tabled predicates.
  537moded_delim(Wrapper, WrapperNoModes, Worker, WorkList, Delays) :-
  538    reset(Worker, SourceCall, Continuation),
  539    moded_add_answer_or_suspend(Continuation, Wrapper, WrapperNoModes,
  540                                WorkList, SourceCall, Delays).
  541
  542moded_add_answer_or_suspend(0, Wrapper, WrapperNoModes, WorkList, _, _) :-
  543    !,
  544    get_wrapper_no_mode_args(Wrapper, _, ModeArgs),
  545    '$tbl_wkl_mode_add_answer'(WorkList, WrapperNoModes,
  546                               ModeArgs, Wrapper). % FIXME: Add Delays
  547moded_add_answer_or_suspend(Continuation, Wrapper, _WrapperNoModes, WorkList,
  548                      call_info(SrcWrapper, SourceWL),
  549                      Delays) :-
  550    '$tbl_wkl_add_suspension'(
  551        SourceWL,
  552        dependency(SrcWrapper, Continuation, Wrapper, WorkList, Delays)).
 update(+Wrapper, +A1, +A2, -A3) is semidet
Update the aggregated value for an answer. Wrapper is the tabled goal, A1 is the aggregated value so far, A2 is the new answer and A3 should be unified with the new aggregated value. The new aggregate is ignored if it is the same as the old one.
  562:- public
  563    update/4.  564
  565update(M:Wrapper, A1, A2, A3) :-
  566    M:'$table_update'(Wrapper, A1, A2, A3),
  567    A1 \=@= A3.
 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.
  577completion(SCC, Status, Clause) :-
  578    (   reset_delays,
  579        completion_(SCC),
  580        fail
  581    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  582        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  583    ).
  584
  585completion_(SCC) :-
  586    repeat,
  587    (   '$tbl_pop_worklist'(SCC, WorkList)
  588    ->  tdebug(wl_goal(WorkList, Goal, _)),
  589        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  590        completion_step(WorkList)
  591    ;   !
  592    ).
  596completion_step(WorkList) :-
  597    '$tbl_trienode'(Reserved),
  598    '$tbl_wkl_work'(WorkList,
  599                    Answer, ModeArgs,
  600                    Goal, Continuation, Wrapper, TargetWorklist, Delays),
  601    '$idg_set_current_wl'(TargetWorklist),
  602    tdebug(wl_goal(WorkList, SourceGoal, _)),
  603    tdebug(wl_goal(TargetWorklist, TargetGoal, _Skeleton)),
  604    (   ModeArgs == Reserved
  605    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  606        tdebug(delay_goals(AllDelays, Cond)),
  607        tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  608               [TargetGoal, SourceGoal, Answer, Cond]),
  609        Goal = Answer,
  610        delim(Wrapper, Continuation, TargetWorklist, Delays)
  611    ;   get_wrapper_no_mode_args(Goal, Answer, ModeArgs),
  612        get_wrapper_no_mode_args(Wrapper, WrapperNoModes, _),
  613        moded_delim(Wrapper, WrapperNoModes, Continuation, TargetWorklist,
  614                    Delays)
  615    ),
  616    fail.
  617
  618
  619		 /*******************************
  620		 *     STRATIFIED NEGATION	*
  621		 *******************************/
 tnot(:Goal)
Tabled negation.
  627tnot(Goal0) :-
  628    '$tnot_implementation'(Goal0, Goal),        % verifies Goal is tabled
  629    '$tbl_variant_table'(_, Goal, Trie, Status, Skeleton),
  630    (   '$tbl_answer_dl'(Trie, _, true)
  631    ->  fail
  632    ;   '$tbl_answer_dl'(Trie, _, _)
  633    ->  add_delay(Trie)
  634    ;   Status == complete
  635    ->  true
  636    ;   Status == fresh
  637    ->  tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  638        (   call(Goal),
  639            fail
  640        ;   '$tbl_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
  641            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  642            (   '$tbl_answer_dl'(Trie, _, true)
  643            ->  fail
  644            ;   '$tbl_answer_dl'(Trie, _, _)
  645            ->  add_delay(Trie)
  646            ;   NewStatus == complete
  647            ->  true
  648            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  649            )
  650        )
  651    ;   negation_suspend(Goal, Skeleton, Status)
  652    ).
 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.

  663negation_suspend(Wrapper, Skeleton, Worklist) :-
  664    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  665    '$tbl_wkl_negative'(Worklist),
  666    shift(call_info(Skeleton, tnot(Worklist))),
  667    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  668    '$tbl_wkl_is_false'(Worklist).
  669
  670
  671		 /*******************************
  672		 *           DELAY LISTS	*
  673		 *******************************/
  674
  675add_delay(Delay) :-
  676    '$tbl_delay_list'(DL0),
  677    '$tbl_set_delay_list'([Delay|DL0]).
  678
  679reset_delays :-
  680    '$tbl_set_delay_list'([]).
 $wfs_call(:Goal, :Delays)
Call Goal and provide WFS delayed goals as a conjunction in Delays. This predicate is teh internal version of call_delays/2 from library(wfs).
  688'$wfs_call'(Goal, M:Delays) :-
  689    '$tbl_delay_list'(DL0),
  690    reset_delays,
  691    call(Goal),
  692    '$tbl_delay_list'(DL1),
  693    (   delay_goals(DL1, M, Delays)
  694    ->  true
  695    ;   Delays = undefined
  696    ),
  697    '$append'(DL0, DL1, DL),
  698    '$tbl_set_delay_list'(DL).
  699
  700delay_goals([], _, true) :-
  701    !.
  702delay_goals([AT+AN|T], M, Goal) :-
  703    !,
  704    (   integer(AN)
  705    ->  at_delay_goal(AT, M, G0, Answer),
  706        trie_term(AN, Answer)
  707    ;   '$tbl_table_status'(AT, _Status, G0, AN)
  708    ),
  709    GN = G0,
  710    (   T == []
  711    ->  Goal = GN
  712    ;   Goal = (GN,GT),
  713        delay_goals(T, M, GT)
  714    ).
  715delay_goals([AT|T], M, Goal) :-
  716    at_delay_goal(AT, M, G0, _Skeleton),
  717    GN = tnot(G0),
  718    (   T == []
  719    ->  Goal = GN
  720    ;   Goal = (GN,GT),
  721        delay_goals(T, M, GT)
  722    ).
  723
  724at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton) :-
  725    is_trie(Trie),
  726    !,
  727    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  728    unqualify_goal(Wrapper, M, Goal).
  729at_delay_goal(Trie, M, Goal, Skeleton) :-
  730    is_trie(Trie),
  731    !,
  732    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  733    unqualify_goal(Wrapper, M, Goal).
  734
  735unqualify_goal(M:Goal, M, Goal0) :-
  736    !,
  737    Goal0 = Goal.
  738unqualify_goal(Goal, _, Goal).
  739
  740
  741                 /*******************************
  742                 *            CLEANUP           *
  743                 *******************************/
 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.

  754abolish_all_tables :-
  755    (   '$tbl_abolish_local_tables'
  756    ->  true
  757    ;   true
  758    ),
  759    (   '$tbl_variant_table'(VariantTrie),
  760        trie_gen(VariantTrie, _, Trie),
  761        '$tbl_destroy_table'(Trie),
  762        fail
  763    ;   true
  764    ).
 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?
  773abolish_table_subgoals(SubGoal0) :-
  774    '$tbl_implementation'(SubGoal0, M:SubGoal),
  775    !,
  776    forall(( '$tbl_variant_table'(VariantTrie),
  777             trie_gen(VariantTrie, M:SubGoal, Trie)
  778           ),
  779           '$tbl_destroy_table'(Trie)).
  780abolish_table_subgoals(_).
 abolish_module_tables(+Module) is det
Abolish all tables for predicates associated with the given module.
  786abolish_module_tables(Module) :-
  787    '$must_be'(atom, Module),
  788    '$tbl_variant_table'(VariantTrie),
  789    current_module(Module),
  790    !,
  791    forall(trie_gen(VariantTrie, Module:_, Trie),
  792           '$tbl_destroy_table'(Trie)).
  793abolish_module_tables(_).
 abolish_nonincremental_tables is det
Abolish all tables that are not related to incremental predicates.
  799abolish_nonincremental_tables :-
  800    (   '$tbl_variant_table'(VariantTrie),
  801        trie_gen(VariantTrie, _, Trie),
  802        '$tbl_table_status'(Trie, Status, Goal, _),
  803        (   Status == complete
  804        ->  true
  805        ;   '$permission_error'(abolish, incomplete_table, Trie)
  806        ),
  807        \+ predicate_property(Goal, incremental),
  808        '$tbl_destroy_table'(Trie),
  809        fail
  810    ;   true
  811    ).
 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.
  820abolish_nonincremental_tables(Options) :-
  821    (   Options = on_incomplete(Action)
  822    ->  Action == skip
  823    ;   '$option'(on_incomplete(skip), Options)
  824    ),
  825    !,
  826    (   '$tbl_variant_table'(VariantTrie),
  827        trie_gen(VariantTrie, _, Trie),
  828        '$tbl_table_status'(Trie, complete, Goal, _),
  829        \+ predicate_property(Goal, incremental),
  830        '$tbl_destroy_table'(Trie),
  831        fail
  832    ;   true
  833    ).
  834abolish_nonincremental_tables(_) :-
  835    abolish_nonincremental_tables.
  836
  837
  838                 /*******************************
  839                 *        EXAMINE TABLES        *
  840                 *******************************/
 current_table(:Variant, -Trie) is nondet
True when Trie is the answer table for Variant.
  846current_table(M:Variant, Trie) :-
  847    '$tbl_variant_table'(VariantTrie),
  848    (   (var(Variant) ; var(M))
  849    ->  trie_gen(VariantTrie, M:Variant, Trie)
  850    ;   trie_lookup(VariantTrie, M:Variant, Trie)
  851    ).
  852
  853
  854                 /*******************************
  855                 *      WRAPPER GENERATION      *
  856                 *******************************/
  857
  858:- multifile
  859    system:term_expansion/2,
  860    tabled/2.  861:- dynamic
  862    system:term_expansion/2.  863
  864wrappers(Spec, M) -->
  865    { tabling_defaults([ table_incremental-incremental,
  866                         table_shared-tshared
  867                       ],
  868                       #{}, Defaults)
  869    },
  870    wrappers(Spec, M, Defaults).
  871
  872wrappers(Var, _, _) -->
  873    { var(Var),
  874      !,
  875      '$instantiation_error'(Var)
  876    }.
  877wrappers(M:Spec, _, Opts) -->
  878    !,
  879    { '$must_be'(atom, M) },
  880    wrappers(Spec, M, Opts).
  881wrappers(Spec as Options, M, Opts0) -->
  882    !,
  883    { table_options(Options, Opts0, Opts) },
  884    wrappers(Spec, M, Opts).
  885wrappers((A,B), M, Opts) -->
  886    !,
  887    wrappers(A, M, Opts),
  888    wrappers(B, M, Opts).
  889wrappers(Name//Arity, M, Opts) -->
  890    { atom(Name), integer(Arity), Arity >= 0,
  891      !,
  892      Arity1 is Arity+2
  893    },
  894    wrappers(Name/Arity1, M, Opts).
  895wrappers(Name/Arity, Module, Opts) -->
  896    { '$option'(mode(TMode), Opts, variant),
  897      atom(Name), integer(Arity), Arity >= 0,
  898      !,
  899      functor(Head, Name, Arity),
  900      '$tbl_trienode'(Reserved)
  901    },
  902    qualify(Module,
  903            [ '$tabled'(Head, TMode),
  904              '$table_mode'(Head, Head, Reserved)
  905            ]),
  906    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
  907    ].
  908wrappers(ModeDirectedSpec, Module, Opts) -->
  909    { '$option'(mode(TMode), Opts, variant),
  910      callable(ModeDirectedSpec),
  911      !,
  912      functor(ModeDirectedSpec, Name, Arity),
  913      functor(Head, Name, Arity),
  914      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
  915      updater_clauses(Modes, Head, UpdateClauses),
  916      mode_check(Moded, ModeTest),
  917      (   ModeTest == true
  918      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts)
  919      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, ModeTest,
  920          Module:Variant, Moded)
  921      )
  922    },
  923    qualify(Module,
  924            [ '$tabled'(Head, TMode),
  925              '$table_mode'(Head, Variant, Moded)
  926            ]),
  927    [ (:- initialization(WrapClause, now))
  928    ],
  929    qualify(Module, UpdateClauses).
  930wrappers(TableSpec, _M, _Opts) -->
  931    { '$type_error'(table_desclaration, TableSpec)
  932    }.
  933
  934qualify(Module, List) -->
  935    { prolog_load_context(module, Module) },
  936    !,
  937    clist(List).
  938qualify(Module, List) -->
  939    qlist(List, Module).
  940
  941clist([])    --> [].
  942clist([H|T]) --> [H], clist(T).
  943
  944qlist([], _)    --> [].
  945qlist([H|T], M) --> [M:H], qlist(T, M).
  946
  947
  948tabling_defaults([], Dict, Dict).
  949tabling_defaults([Flag-Opt|T], Dict0, Dict) :-
  950    (   current_prolog_flag(Flag, true)
  951    ->  Dict1 = Dict0.put(Opt,true)
  952    ;   Dict1 = Dict0
  953    ),
  954    tabling_defaults(T, Dict1, Dict).
 table_options(+Options, +OptDictIn, -OptDictOut)
Handler the ... as options ... construct.
  961table_options(Options, _Opts0, _Opts) :-
  962    var(Options),
  963    '$instantiation_error'(Options).
  964table_options((A,B), Opts0, Opts) :-
  965    !,
  966    table_options(A, Opts0, Opts1),
  967    table_options(B, Opts1, Opts).
  968table_options(subsumptive, Opts0, Opts1) :-
  969    !,
  970    put_dict(mode, Opts0, subsumptive, Opts1).
  971table_options(variant, Opts0, Opts1) :-
  972    !,
  973    put_dict(mode, Opts0, variant, Opts1).
  974table_options(incremental, Opts0, Opts1) :-
  975    !,
  976    put_dict(incremental, Opts0, true, Opts1).
  977table_options(opaque, Opts0, Opts1) :-
  978    !,
  979    put_dict(incremental, Opts0, false, Opts1).
  980table_options(dynamic, Opts0, Opts1) :-
  981    !,
  982    put_dict(dynamic, Opts0, true, Opts1).
  983table_options(shared, Opts0, Opts1) :-
  984    !,
  985    put_dict(tshared, Opts0, true, Opts1).
  986table_options(private, Opts0, Opts1) :-
  987    !,
  988    put_dict(tshared, Opts0, false, Opts1).
  989table_options(Opt, _, _) :-
  990    '$domain_error'(table_option, Opt).
 mode_check(+Moded, -TestCode)
Enforce the output arguments of a mode-directed tabled predicate to be unbound.
  997mode_check(Moded, Check) :-
  998    var(Moded),
  999    !,
 1000    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1001mode_check(Moded, true) :-
 1002    '$tbl_trienode'(Moded),
 1003    !.
 1004mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1005    Moded =.. [s|Vars],
 1006    var_check(Vars, Test).
 1007
 1008var_check([H|T], Test) :-
 1009    (   T == []
 1010    ->  Test = var(H)
 1011    ;   Test = (var(H),Rest),
 1012        var_check(T, Rest)
 1013    ).
 1014
 1015:- public
 1016    instantiated_moded_arg/1. 1017
 1018instantiated_moded_arg(Vars) :-
 1019    '$member'(V, Vars),
 1020    \+ var(V),
 1021    '$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,...)
 1033extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1034    compound(ModeSpec),
 1035    !,
 1036    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1037    compound_name_arguments(Head, Name, HeadArgs),
 1038    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1039    length(ModedArgs, Count),
 1040    atomic_list_concat([$,Name,$,Count], VName),
 1041    Variant =.. [VName|VariantArgs],
 1042    (   ModedArgs == []
 1043    ->  '$tbl_trienode'(ModedAnswer)
 1044    ;   ModedArgs = [ModedAnswer]
 1045    ->  true
 1046    ;   ModedAnswer =.. [s|ModedArgs]
 1047    ).
 1048extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1049    atomic_list_concat([$,Atom,$,0], Variant),
 1050    '$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?
 1060separate_args([], [], [], [], []).
 1061separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1062    indexed_mode(HM),
 1063    !,
 1064    separate_args(TM, TA, TNA, Modes, TMA).
 1065separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1066    separate_args(TM, TA, TNA, Modes, TMA).
 1067
 1068indexed_mode(Mode) :-                           % XSB
 1069    var(Mode),
 1070    !.
 1071indexed_mode(index).                            % YAP
 1072indexed_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.
 1079updater_clauses([], _, []) :- !.
 1080updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1081    update_goal(P, S0,S1,S2, Body).
 1082updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1083    length(Modes, Len),
 1084    functor(S0, s, Len),
 1085    functor(S1, s, Len),
 1086    functor(S2, s, Len),
 1087    S0 =.. [_|Args0],
 1088    S1 =.. [_|Args1],
 1089    S2 =.. [_|Args2],
 1090    update_body(Modes, Args0, Args1, Args2, true, Body).
 1091
 1092update_body([], _, _, _, Body, Body).
 1093update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1094    update_goal(P, A0,A1,A2, Goal),
 1095    mkconj(Body0, Goal, Body1),
 1096    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1097
 1098update_goal(Var, _,_,_, _) :-
 1099    var(Var),
 1100    !,
 1101    '$instantiation_error'(Var).
 1102update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1103    !,
 1104    '$must_be'(atom, M),
 1105    update_goal(lattice(PI), S0,S1,S2, Goal).
 1106update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1107    !,
 1108    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1109    '$must_be'(atom, Name),
 1110    Goal =.. [Name,S0,S1,S2].
 1111update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1112    compound(Head),
 1113    !,
 1114    compound_name_arity(Head, Name, Arity),
 1115    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1116    Goal =.. [Name,S0,S1,S2].
 1117update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1118    !,
 1119    '$must_be'(atom, Name),
 1120    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1121update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1122    !,
 1123    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1124    '$must_be'(atom, Name),
 1125    Call =.. [Name, S0, S1],
 1126    Goal = (Call -> S2 = S0 ; S2 = S1).
 1127update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1128    !,
 1129    '$must_be'(atom, M),
 1130    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1131    '$must_be'(atom, Name),
 1132    Call =.. [Name, S0, S1],
 1133    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1134update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1135    !,
 1136    '$must_be'(atom, M),
 1137    '$must_be'(atom, Name),
 1138    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1139update_goal(po(Name), S0,S1,S2, Goal) :-
 1140    !,
 1141    '$must_be'(atom, Name),
 1142    update_goal(po(Name/2), S0,S1,S2, Goal).
 1143update_goal(Alias, S0,S1,S2, Goal) :-
 1144    update_alias(Alias, Update),
 1145    !,
 1146    update_goal(Update, S0,S1,S2, Goal).
 1147update_goal(Mode, _,_,_, _) :-
 1148    '$domain_error'(tabled_mode, Mode).
 1149
 1150update_alias(first, lattice('$tabling':first/3)).
 1151update_alias(-,     lattice('$tabling':first/3)).
 1152update_alias(last,  lattice('$tabling':last/3)).
 1153update_alias(min,   lattice('$tabling':min/3)).
 1154update_alias(max,   lattice('$tabling':max/3)).
 1155update_alias(sum,   lattice('$tabling':sum/3)).
 1156
 1157mkconj(true, G,  G) :- !.
 1158mkconj(G1,   G2, (G1,G2)).
 1159
 1160
 1161		 /*******************************
 1162		 *          AGGREGATION		*
 1163		 *******************************/
 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.
 1173:- public first/3, last/3, min/3, max/3, sum/3. 1174
 1175first(S, _, S).
 1176last(_, S, S).
 1177min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1178max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1179sum(S0, S1, S) :- S is S0+S1.
 1180
 1181
 1182		 /*******************************
 1183		 *      INCREMENTAL TABLING	*
 1184		 *******************************/
 $wrap_incremental(:Head) is det
Wrap an incremental dynamic predicate to be added to the IDG.
 1190'$wrap_incremental'(Head) :-
 1191    abstract_goal(Head, Abstract),
 1192    '$pi_head'(PI, Head),
 1193    (   Head == Abstract
 1194    ->  prolog_listen(PI, dyn_update)
 1195    ;   prolog_listen(PI, dyn_update(Abstract))
 1196    ).
 1197
 1198abstract_goal(M:Head, M:Abstract) :-
 1199    compound(Head),
 1200    '$get_predicate_attribute'(M:Head, abstract, 1),
 1201    !,
 1202    compound_name_arity(Head, Name, Arity),
 1203    functor(Abstract, Name, Arity).
 1204abstract_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.
 1214dyn_update(_Action, ClauseRef) :-
 1215    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1216    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1217        dyn_changed_pattern(Head)
 1218    ;   true
 1219    ).
 1220
 1221dyn_update(Abstract, _, _) :-
 1222    dyn_changed_pattern(Abstract).
 1223
 1224dyn_changed_pattern(Term) :-
 1225    forall(dyn_affected(Term, ATrie),
 1226           '$idg_changed'(ATrie)).
 1227
 1228dyn_affected(Term, ATrie) :-
 1229    '$tbl_variant_table'(VTable),
 1230    trie_gen(VTable, Term, ATrie).
 $unwrap_incremental(:Head) is det
Remove dynamic predicate incremenal forwarding, reset the possible abstract property and remove possible tables.
 1237'$unwrap_incremental'(Head) :-
 1238    '$pi_head'(PI, Head),
 1239    (   unwrap_predicate(PI, incremental)
 1240    ->  abstract_goal(Head, Abstract),
 1241        (   Head == Abstract
 1242        ->  prolog_unlisten(PI, dyn_update)
 1243        ;   '$set_predicate_attribute'(Head, abstract, 0),
 1244            prolog_unlisten(PI, dyn_update(_))
 1245        ),
 1246        (   '$tbl_variant_table'(VariantTrie)
 1247        ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1248                   '$tbl_destroy_table'(ATrie))
 1249        ;   true
 1250        )
 1251    ;   true
 1252    ).
 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
 1278reeval(ATrie, Goal, Return) :-
 1279    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1280          retry_reeval(ATrie, Goal)).
 1281
 1282retry_reeval(ATrie, Goal) :-
 1283    '$tbl_reeval_abandon'(ATrie),
 1284    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1285    sleep(0.000001),
 1286    call(Goal).
 1287
 1288try_reeval(ATrie, Goal, Return) :-
 1289    nb_current('$tbl_reeval', true),
 1290    !,
 1291    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1292    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1293    (   nonvar(Clause)
 1294    ->  trie_gen_compiled(Clause, Return)
 1295    ;   call(Goal)
 1296    ).
 1297try_reeval(ATrie, Goal, Return) :-
 1298    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1299    findall(Path, false_path(ATrie, Path), Paths0),
 1300    sort(0, @>, Paths0, Paths),
 1301    split_paths(Paths, Dynamic, Complete),
 1302    tdebug(forall('$member'(Path, Dynamic),
 1303                  tdebug(reeval, '  Re-eval dynamic path: ~p', [Path]))),
 1304    tdebug(forall('$member'(Path, Complete),
 1305                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1306    reeval_paths(Dynamic, ATrie),
 1307    reeval_paths(Complete, ATrie),
 1308    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1309    (   nonvar(Clause)
 1310    ->  trie_gen_compiled(Clause, Return)
 1311    ;   call(Goal)
 1312    ).
 1313
 1314split_paths([], [], []).
 1315split_paths([[Rank-_Len|Path]|T], [Path|DT], CT) :-
 1316    status_rank(dynamic, Rank),
 1317    !,
 1318    split_paths(T, DT, CT).
 1319split_paths([[_|Path]|T], DT, [Path|CT]) :-
 1320    split_paths(T, DT, CT).
 1321
 1322reeval_paths([], _) :-
 1323    !.
 1324reeval_paths(BottomUp, ATrie) :-
 1325    is_invalid(ATrie),
 1326    !,
 1327    reeval_heads(BottomUp, ATrie, BottomUp1),
 1328    reeval_paths(BottomUp1, ATrie).
 1329reeval_paths(_, _).
 1330
 1331reeval_heads(_, ATrie, _) :-
 1332    \+ is_invalid(ATrie),
 1333    !.
 1334reeval_heads([], _, []).
 1335reeval_heads([[H]|B], ATrie, BT) :-
 1336    !,
 1337    reeval_node(H),
 1338    reeval_heads(B, ATrie, BT).
 1339reeval_heads([[]|B], ATrie, BT) :-
 1340    !,
 1341    reeval_heads(B, ATrie, BT).
 1342reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1343    !,
 1344    reeval_node(H),
 1345    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.

 1356false_path(ATrie, BottomUp) :-
 1357    false_path(ATrie, Path, []),
 1358    '$reverse'(Path, BottomUp).
 1359
 1360false_path(ATrie, [ATrie|T], Seen) :-
 1361    \+ memberchk(ATrie, Seen),
 1362    '$idg_edge'(ATrie, dependent, Dep),
 1363    '$tbl_reeval_wait'(Dep, Status),
 1364    tdebug(reeval, '    ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
 1365    (   Status == invalid
 1366    ->  false_path(Dep, T, [ATrie|Seen])
 1367    ;   status_rank(Status, Rank),
 1368        length(Seen, Len),
 1369        T = [Rank-Len]
 1370    ).
 1371
 1372status_rank(dynamic,  2) :- !.
 1373status_rank(complete, 1) :- !.
 1374status_rank(Status,   Rank) :-
 1375    var(Rank),
 1376    !,
 1377    format(user_error, 'Re-eval from status ~p~n', [Status]),
 1378    Rank = 0.
 1379status_rank(Rank,   Rank) :-
 1380    format(user_error, 'Re-eval from rank ~p~n', [Rank]).
 1381
 1382is_invalid(ATrie) :-
 1383    '$idg_falsecount'(ATrie, FalseCount),
 1384    FalseCount > 0.
 reeval_node(+ATrie)
Re-evaluate the invalid answer trie ATrie. Initially this created a nested tabling environment, but this is dropped:
 1397reeval_node(ATrie) :-
 1398    '$tbl_reeval_prepare'(ATrie, Variant, Clause),
 1399    var(Clause),
 1400    !,
 1401    tdebug(reeval, 'Re-evaluating ~p', [Variant]),
 1402    (   '$idg_reset_current',
 1403        setup_call_cleanup(
 1404            nb_setval('$tbl_reeval', true),
 1405            ignore(Variant),                    % assumes local scheduling
 1406            nb_delete('$tbl_reeval')),
 1407        fail
 1408    ;   tdebug(reeval, 'Re-evaluated ~p', [Variant])
 1409    ).
 1410reeval_node(_).
 1411
 1412
 1413		 /*******************************
 1414		 *      EXPAND DIRECTIVES	*
 1415		 *******************************/
 1416
 1417system:term_expansion((:- table(Preds)), Expansion) :-
 1418    \+ current_prolog_flag(xref, true),
 1419    prolog_load_context(module, M),
 1420    phrase(wrappers(Preds, M), Clauses),
 1421    multifile_decls(Clauses, Directives0),
 1422    sort(Directives0, Directives),
 1423    '$append'(Directives, Clauses, Expansion).
 1424
 1425multifile_decls([], []).
 1426multifile_decls([H0|T0], [H|T]) :-
 1427    multifile_decl(H0, H),
 1428    !,
 1429    multifile_decls(T0, T).
 1430multifile_decls([_|T0], T) :-
 1431    multifile_decls(T0, T).
 1432
 1433multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 1434    !,
 1435    functor(Head, Name, Arity).
 1436multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 1437    !,
 1438    functor(Head, Name, Arity).
 1439multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 1440    !,
 1441    functor(Head, Name, Arity).
 1442multifile_decl(Head, (:- multifile(Name/Arity))) :-
 1443    !,
 1444    Head \= (:-_),
 1445    functor(Head, Name, Arity).
 1446
 1447
 1448		 /*******************************
 1449		 *      ANSWER COMPLETION	*
 1450		 *******************************/
 1451
 1452:- 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()
 1468answer_completion(AnswerTrie, Return) :-
 1469    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 1470    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 1471    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 1472                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 1473    (   Propagated > 0
 1474    ->  answer_completion(AnswerTrie, Return)
 1475    ;   true
 1476    ).
 1477
 1478answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 1479    (   eval_subgoal_in_residual(AnswerTrie, Return),
 1480        fail
 1481    ;   true
 1482    ),
 1483    delete_answers_for_failing_calls(Propagated),
 1484    (   Propagated == 0
 1485    ->  mark_succeeding_calls_as_answer_completed
 1486    ;   true
 1487    ).
 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.
 1495delete_answers_for_failing_calls(Propagated) :-
 1496    State = state(0),
 1497    (   subgoal_residual_trie(ASGF, ESGF),
 1498        \+ trie_gen(ESGF, _ETmp),
 1499        tdebug(trie_goal(ASGF, Goal0, _)),
 1500        tdebug(trie_goal(ASGF, Goal, _0Return)),
 1501        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 1502        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 1503	'$tbl_force_truth_value'(ALeaf, false, Count),
 1504        arg(1, State, Prop0),
 1505        Prop is Prop0+Count-1,
 1506        nb_setarg(1, State, Prop),
 1507	fail
 1508    ;   arg(1, State, Propagated)
 1509    ).
 1510
 1511mark_succeeding_calls_as_answer_completed :-
 1512    (   subgoal_residual_trie(ASGF, _ESGF),
 1513        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 1514        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 1515            tdebug(trie_goal(ASGF, Goal, _0Return)),
 1516            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 1517            '$tbl_set_answer_completed'(ASGF)
 1518        ),
 1519        fail
 1520    ;   true
 1521    ).
 1522
 1523subgoal_residual_trie(ASGF, ESGF) :-
 1524    '$tbl_variant_table'(VariantTrie),
 1525    context_module(M),
 1526    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.
 1533eval_dl_in_residual(true) :-
 1534    !.
 1535eval_dl_in_residual((A;B)) :-
 1536    !,
 1537    (   eval_dl_in_residual(A)
 1538    ;   eval_dl_in_residual(B)
 1539    ).
 1540eval_dl_in_residual((A,B)) :-
 1541    !,
 1542    eval_dl_in_residual(A),
 1543    eval_dl_in_residual(B).
 1544eval_dl_in_residual(tnot(G)) :-
 1545    !,
 1546    tdebug(ac, ' ? tnot(~p)', [G]),
 1547    current_table(G, SGF),
 1548    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 1549    tnot(eval_subgoal_in_residual(SGF, Return)).
 1550eval_dl_in_residual(G) :-
 1551    tdebug(ac, ' ? ~p', [G]),
 1552    (   current_table(G, SGF)
 1553    ->	true
 1554    ;   more_general_table(G, SGF)
 1555    ->	true
 1556    ;	writeln(user_error, 'MISSING CALL? '(G)),
 1557        fail
 1558    ),
 1559    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 1560    eval_subgoal_in_residual(SGF, Return).
 1561
 1562more_general_table(G, Trie) :-
 1563    term_variables(G, Vars),
 1564    '$tbl_variant_table'(VariantTrie),
 1565    trie_gen(VariantTrie, G, Trie),
 1566    is_most_general_term(Vars).
 1567
 1568:- 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.
 1575eval_subgoal_in_residual(AnswerTrie, _Return) :-
 1576    '$tbl_is_answer_completed'(AnswerTrie),
 1577    !,
 1578    undefined.
 1579eval_subgoal_in_residual(AnswerTrie, Return) :-
 1580    '$tbl_answer'(AnswerTrie, Return, Condition),
 1581    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 1582    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 1583    eval_dl_in_residual(Condition).
 undefined
Expresses the value bottom from the well founded semantics.
 1589:- table
 1590    undefined/0. 1591
 1592undefined :-
 1593    tnot(undefined)