View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Benoit Desouter <Benoit.Desouter@UGent.be>
    4                   Jan Wielemaker (SWI-Prolog port)
    5                   Fabrizio Riguzzi (mode directed tabling)
    6    Copyright (c) 2016-2020, Benoit Desouter,
    7                             Jan Wielemaker,
    8                             Fabrizio Riguzzi
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module('$tabling',
   38          [ (table)/1,                  % :PI ...
   39            untable/1,                  % :PI ...
   40
   41            (tnot)/1,                   % :Goal
   42            not_exists/1,               % :Goal
   43            undefined/0,
   44
   45            current_table/2,            % :Variant, ?Table
   46            abolish_all_tables/0,
   47            abolish_table_subgoals/1,   % :Subgoal
   48            abolish_module_tables/1,    % +Module
   49            abolish_nonincremental_tables/0,
   50            abolish_nonincremental_tables/1, % +Options
   51
   52            start_tabling/3,            % +Closure, +Wrapper, :Worker
   53            start_subsumptive_tabling/3,% +Closure, +Wrapper, :Worker
   54            moded_start_tabling/5,      % +Closure, +Wrapper, :Worker, :Variant, ?ModeArgs
   55
   56            '$tbl_answer'/4,            % +Trie, -Return, -ModeArgs, -Delay
   57
   58            '$wrap_tabled'/2,		% :Head, +Mode
   59            '$moded_wrap_tabled'/4,	% :Head, +ModeTest, +Variant, +Moded
   60            '$wfs_call'/2,              % :Goal, -Delays
   61
   62            '$wrap_incremental'/1,      % :Head
   63            '$unwrap_incremental'/1     % :Head
   64          ]).   65
   66:- meta_predicate
   67    table(:),
   68    untable(:),
   69    tnot(0),
   70    not_exists(0),
   71    tabled_call(0),
   72    start_tabling(+, +, 0),
   73    start_tabling(+, +, 0, +, ?),
   74    current_table(:, -),
   75    abolish_table_subgoals(:),
   76    '$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 */
   88% Enable debugging using debug(tabling(Topic)) when compiled with
   89% -DO_DEBUG
   90goal_expansion(tdebug(Topic, Fmt, Args), Expansion) :-
   91    (   current_prolog_flag(prolog_debug, true)
   92    ->  Expansion = debug(tabling(Topic), Fmt, Args)
   93    ;   Expansion = true
   94    ).
   95goal_expansion(tdebug(Goal), Expansion) :-
   96    (   current_prolog_flag(prolog_debug, true)
   97    ->  Expansion = (   debugging(tabling(_))
   98                    ->  (   Goal
   99                        ->  true
  100                        ;   print_message(error,
  101                                          format('goal_failed: ~q', [Goal]))
  102                        )
  103                    ;   true
  104                    )
  105    ;   Expansion = true
  106    ).
  107
  108:- if(current_prolog_flag(prolog_debug, true)).  109wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
  110    !,
  111    '$tbl_wkl_table'(WorkList, ATrie),
  112    trie_goal(ATrie, Goal, Skeleton).
  113wl_goal(WorkList, Goal, Skeleton) :-
  114    '$tbl_wkl_table'(WorkList, ATrie),
  115    trie_goal(ATrie, Goal, Skeleton).
  116
  117trie_goal(ATrie, Goal, Skeleton) :-
  118    '$tbl_table_status'(ATrie, _Status, M:Variant, Skeleton),
  119    M:'$table_mode'(Goal0, Variant, _Moded),
  120    unqualify_goal(M:Goal0, user, Goal).
  121
  122delay_goals(List, Goal) :-
  123    delay_goals(List, user, Goal).
  124
  125user_goal(Goal, UGoal) :-
  126    unqualify_goal(Goal, user, UGoal).
  127
  128:- multifile
  129    prolog:portray/1.  130
  131user:portray(ATrie) :-
  132    '$is_answer_trie'(ATrie),
  133    trie_goal(ATrie, Goal, _Skeleton),
  134    format('~q for ~p', [ATrie, Goal]).
  135
  136:- 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.

  161table(M:PIList) :-
  162    setup_call_cleanup(
  163        '$set_source_module'(OldModule, M),
  164        expand_term((:- table(PIList)), Clauses),
  165        '$set_source_module'(OldModule)),
  166    dyn_tabling_list(Clauses, M).
  167
  168dyn_tabling_list([], _).
  169dyn_tabling_list([H|T], M) :-
  170    dyn_tabling(H, M),
  171    dyn_tabling_list(T, M).
  172
  173dyn_tabling(M:Clause, _) :-
  174    !,
  175    dyn_tabling(Clause, M).
  176dyn_tabling((:- multifile(PI)), M) :-
  177    !,
  178    multifile(M:PI),
  179    dynamic(M:PI).
  180dyn_tabling(:- initialization(Wrap, now), M) :-
  181    !,
  182    M:Wrap.
  183dyn_tabling('$tabled'(Head, TMode), M) :-
  184    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  185        (   OMode \== TMode
  186        ->  erase(Ref),
  187            fail
  188        ;   true
  189        )
  190    ->  true
  191    ;   assertz(M:'$tabled'(Head, TMode))
  192    ).
  193dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  194    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  195    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  196        ->  true
  197        ;   erase(Ref),
  198            assertz(M:'$table_mode'(Head, Variant, Moded))
  199        )
  200    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  201    ).
  202dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  203    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  204    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  205        ->  true
  206        ;   erase(Ref),
  207            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  208        )
  209    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  210    ).
 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.
  221untable(M:PIList) :-
  222    untable(PIList, M).
  223
  224untable(Var, _) :-
  225    var(Var),
  226    !,
  227    '$instantiation_error'(Var).
  228untable(M:Spec, _) :-
  229    !,
  230    '$must_be'(atom, M),
  231    untable(Spec, M).
  232untable((A,B), M) :-
  233    !,
  234    untable(A, M),
  235    untable(B, M).
  236untable(Name//Arity, M) :-
  237    atom(Name), integer(Arity), Arity >= 0,
  238    !,
  239    Arity1 is Arity+2,
  240    untable(Name/Arity1, M).
  241untable(Name/Arity, M) :-
  242    !,
  243    functor(Head, Name, Arity),
  244    (   '$get_predicate_attribute'(M:Head, tabled, 1)
  245    ->  abolish_table_subgoals(M:Head),
  246        dynamic(M:'$tabled'/2),
  247        dynamic(M:'$table_mode'/3),
  248        retractall(M:'$tabled'(Head, _TMode)),
  249        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  250        unwrap_predicate(M:Name/Arity, table),
  251        '$set_predicate_attribute'(M:Head, tabled, false)
  252    ;   true
  253    ).
  254untable(Head, M) :-
  255    callable(Head),
  256    !,
  257    functor(Head, Name, Arity),
  258    untable(Name/Arity, M).
  259untable(TableSpec, _) :-
  260    '$type_error'(table_desclaration, TableSpec).
  261
  262untable_reconsult(PI) :-
  263    print_message(informational, untable(PI)),
  264    untable(PI).
  265
  266:- initialization
  267   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.
  280'$wrap_tabled'(Head, Options) :-
  281    get_dict(mode, Options, subsumptive),
  282    !,
  283    set_pattributes(Head, Options),
  284    '$wrap_predicate'(Head, table, Closure, Wrapped,
  285                      start_subsumptive_tabling(Closure, Head, Wrapped)).
  286'$wrap_tabled'(Head, Options) :-
  287    !,
  288    set_pattributes(Head, Options),
  289    '$wrap_predicate'(Head, table, Closure, Wrapped,
  290                      start_tabling(Closure, Head, Wrapped)).
  291
  292set_pattributes(Head, Options) :-
  293    '$set_predicate_attribute'(Head, tabled, true),
  294    (   get_dict(incremental, Options, true)
  295    ->  '$set_predicate_attribute'(Head, incremental, true)
  296    ;   true
  297    ),
  298    (   get_dict(dynamic, Options, true)
  299    ->  '$set_predicate_attribute'(Head, dynamic, true)
  300    ;   true
  301    ),
  302    (   get_dict(tshared, Options, true)
  303    ->  '$set_predicate_attribute'(Head, tshared, true)
  304    ;   true
  305    ).
  306
  307
  308start_tabling(Closure, Wrapper, Worker) :-
  309    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton),
  310    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  311    (   Status == complete
  312    ->  trie_gen_compiled(Trie, Skeleton)
  313    ;   functor(Status, fresh, 2)
  314    ->  catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
  315              deadlock,
  316              restart_tabling(Closure, Wrapper, Worker))
  317    ;   Status == invalid
  318    ->  reeval(Trie, Wrapper, Skeleton)
  319    ;   % = run_follower, but never fresh and Status is a worklist
  320        shift(call_info(Skeleton, Status))
  321    ).
  322
  323create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
  324    tdebug(Fresh = fresh(SCC, WorkList)),
  325    tdebug(wl_goal(WorkList, Goal, _)),
  326    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  327    setup_call_catcher_cleanup(
  328        '$idg_set_current'(OldCurrent, Trie),
  329        run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
  330        Catcher,
  331        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  332    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  333    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.
  344restart_tabling(Closure, Wrapper, Worker) :-
  345    tdebug(user_goal(Wrapper, Goal)),
  346    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  347    sleep(0.000001),
  348    start_tabling(Closure, Wrapper, Worker).
 start_subsumptive_tabling(: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.
  361start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  362    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  363    ->  (   Status == complete
  364        ->  trie_gen_compiled(Trie, Skeleton)
  365        ;   Status == invalid
  366        ->  reeval(Trie, Wrapper, Skeleton),
  367            trie_gen_compiled(Trie, Skeleton)
  368        ;   shift(call_info(Skeleton, Status))
  369        )
  370    ;   more_general_table(Wrapper, ATrie),
  371        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  372    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  373    ;   more_general_table(Wrapper, ATrie),
  374        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  375    ->  (   Status == invalid
  376        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  377            Wrapper = GenWrapper,
  378            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  379        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  380            shift(call_info(GenSkeleton, Skeleton, Status)),
  381            unify_subsumptive(Skeleton, GenSkeleton)
  382        )
  383    ;   start_tabling(Closure, Wrapper, Worker)
  384    ).
 wrapper_skeleton(+GenWrapper, +GenSkeleton, +Wrapper, -Skeleton)
Skeleton is a specialized version of GenSkeleton for the subsumed new consumer.
  391wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  392    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  393    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  394           [GenSkeleton+Skeleton]).
  395
  396unify_subsumptive(X,X).
  397
  398:- '$hide'((done_leader/4, finished_leader/4)).  399
  400done_leader(complete, _Fresh, Skeleton, Clause) :-
  401    !,
  402    trie_gen_compiled(Clause, Skeleton).
  403done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  404    !,
  405    '$tbl_free_component'(SCC),
  406    trie_gen_compiled(Clause, Skeleton).
  407done_leader(_,_,_,_).
  408
  409finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  410    '$idg_set_current'(OldCurrent),
  411    (   Catcher == exit
  412    ->  true
  413    ;   Catcher == fail
  414    ->  true
  415    ;   Catcher = exception(_)
  416    ->  Fresh = fresh(SCC, _),
  417        '$tbl_table_discard_all'(SCC)
  418    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  419    ).
 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.

  434run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  435    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  436    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  437    activate(Skeleton, Worker, Worklist),
  438    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  439    completion(SCC, Status, Clause),
  440    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  441    (   Status == merged
  442    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  443        '$tbl_wkl_make_follower'(Worklist),
  444        shift(call_info(Skeleton, Worklist))
  445    ;   true                                    % completed
  446    ).
  447
  448activate(Skeleton, Worker, WorkList) :-
  449    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  450    (   reset_delays,
  451        delim(Skeleton, Worker, WorkList, []),
  452        fail
  453    ;   true
  454    ).
 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.
  470delim(Skeleton, Worker, WorkList, Delays) :-
  471    reset(Worker, SourceCall, Continuation),
  472    tdebug(wl_goal(WorkList, Goal, _)),
  473    (   Continuation == 0
  474    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  475        tdebug(delay_goals(AllDelays, Cond)),
  476        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  477               [Skeleton, Goal, Cond]),
  478        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  479        Complete == !,
  480        !
  481    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  482    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  483        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  484        tdebug(wl_goal(WorkList, DstGoal, _)),
  485        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  486        '$tbl_wkl_add_suspension'(
  487            SourceWL,
  488            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  489    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  490    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  491        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  492        tdebug(wl_goal(WorkList, DstGoal, _)),
  493        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  494        '$tbl_wkl_add_suspension'(
  495            SourceWL,
  496            InstSkeleton,
  497            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  498    ).
 moded_start_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.
  505'$moded_wrap_tabled'(Head, ModeTest, WrapperNoModes, ModeArgs) :-
  506    '$set_predicate_attribute'(Head, tabled, true),
  507    '$wrap_predicate'(Head, table, Closure, Wrapped,
  508                      (   ModeTest,
  509                          moded_start_tabling(Closure, Head, Wrapped,
  510                                              WrapperNoModes, ModeArgs)
  511                      )).
  512
  513
  514moded_start_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  515    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie, Status, Skeleton),
  516    (   Status == complete
  517    ->  moded_gen_answer(Trie, Skeleton, ModeArgs)
  518    ;   functor(Status, fresh, 2)
  519    ->  setup_call_catcher_cleanup(
  520            '$idg_set_current'(OldCurrent, Trie),
  521            moded_run_leader(Wrapper, Skeleton/ModeArgs,
  522                             Worker, Status, LStatus),
  523            Catcher,
  524            finished_leader(OldCurrent, Catcher, Status, Wrapper)),
  525        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  526               [Wrapper, ModeArgs, LStatus]),
  527        moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
  528    ;   Status == invalid
  529    ->  reeval(Trie),
  530        moded_gen_answer(Trie, Skeleton, ModeArgs)
  531    ;   % = run_follower, but never fresh and Status is a worklist
  532        shift(call_info(Skeleton/ModeArgs, Status))
  533    ).
  534
  535moded_gen_answer(Trie, Skeleton, ModedArgs) :-
  536    trie_gen(Trie, Skeleton),
  537    '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
  538
  539'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
  540    trie_gen(ATrie, Skeleton),
  541    '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
  542
  543moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
  544    !,
  545    moded_gen_answer(Trie, Skeleton, ModeArgs).
  546moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
  547    !,
  548    '$tbl_free_component'(SCC),
  549    moded_gen_answer(Trie, Skeleton, ModeArgs).
  550moded_done_leader(_, _, _, _, _).
  551
  552moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
  553    tdebug(wl_goal(Worklist, Goal, _)),
  554    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  555    moded_activate(SkeletonMA, Worker, Worklist),
  556    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  557    completion(SCC, Status, _Clause),           % TBD: propagate
  558    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  559    (   Status == merged
  560    ->  tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
  561        '$tbl_wkl_make_follower'(Worklist),
  562        shift(call_info(SkeletonMA, Worklist))
  563    ;   true                                    % completed
  564    ).
  565
  566moded_activate(SkeletonMA, Worker, WorkList) :-
  567    (   reset_delays,
  568        delim(SkeletonMA, Worker, WorkList, []),
  569        fail
  570    ;   true
  571    ).
 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
  589:- public
  590    update/7.  591
  592update(0b11, Wrapper, M, A1, A2, A3, delete) :-
  593    !,
  594    M:'$table_update'(Wrapper, A1, A2, A3),
  595    A1 \=@= A3.
  596update(0b10, Wrapper, M, A1, A2, A3, Action) :-
  597    !,
  598    (   is_subsumed_by(Wrapper, M, A2, A1)
  599    ->  Action = done
  600    ;   A3 = A2,
  601        Action = keep
  602    ).
  603update(0b01, Wrapper, M, A1, A2, A2, Action) :-
  604    !,
  605    (   is_subsumed_by(Wrapper, M, A1, A2)
  606    ->  Action = delete
  607    ;   Action = keep
  608    ).
  609update(0b00, _Wrapper, _M, _A1, A2, A2, keep) :-
  610    !.
  611
  612is_subsumed_by(Wrapper, M, Instance, General) :-
  613    M:'$table_update'(Wrapper, Instance, General, New),
  614    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.
  623completion(SCC, Status, Clause) :-
  624    (   reset_delays,
  625        completion_(SCC),
  626        fail
  627    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  628        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  629    ).
  630
  631completion_(SCC) :-
  632    repeat,
  633    (   '$tbl_pop_worklist'(SCC, WorkList)
  634    ->  tdebug(wl_goal(WorkList, Goal, _)),
  635        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  636        completion_step(WorkList)
  637    ;   !
  638    ).
 $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.
  669completion_step(SourceWL) :-
  670    '$tbl_wkl_work'(SourceWL,
  671                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  672    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  673    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  674    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  675    tdebug(delay_goals(AllDelays, Cond)),
  676    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  677           [TargetGoal, SourceGoal, Answer, Cond]),
  678    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  679    fail.
  680
  681
  682		 /*******************************
  683		 *     STRATIFIED NEGATION	*
  684		 *******************************/
 tnot(:Goal)
Tabled negation.
  690tnot(Goal0) :-
  691    '$tnot_implementation'(Goal0, Goal),        % verifies Goal is tabled
  692    (   '$tbl_existing_variant_table'(_, Goal, Trie, Status, Skeleton)
  693    ->  (   '$tbl_answer_dl'(Trie, _, true)
  694        ->  fail
  695        ;   '$tbl_answer_dl'(Trie, _, _)
  696        ->  tdebug(tnot, 'tnot: adding ~p to delay list', [Goal]),
  697            add_delay(Trie)
  698        ;   Status == complete
  699        ->  true
  700        ;   negation_suspend(Goal, Skeleton, Status)
  701        )
  702    ;   tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  703        (   call(Goal),
  704            fail
  705        ;   '$tbl_existing_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
  706            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  707            (   '$tbl_answer_dl'(Trie, _, true)
  708            ->  fail
  709            ;   '$tbl_answer_dl'(Trie, _, _)
  710            ->  add_delay(Trie)
  711            ;   NewStatus == complete
  712            ->  true
  713            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  714            )
  715        )
  716    ).
  717
  718floundering(Goal) :-
  719    format(string(Comment), 'Floundering goal in tnot/1: ~p', [Goal]),
  720    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.

  731negation_suspend(Wrapper, Skeleton, Worklist) :-
  732    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  733    '$tbl_wkl_negative'(Worklist),
  734    shift(call_info(Skeleton, tnot(Worklist))),
  735    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  736    '$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.
  745not_exists(Goal) :-
  746    ground(Goal),
  747    '$get_predicate_attribute'(Goal, tabled, 1),
  748    !,
  749    tnot(Goal).
  750not_exists(Goal) :-
  751    (   tabled_call(Goal), fail
  752    ;   tnot(tabled_call(Goal))
  753    ).
  754
  755		 /*******************************
  756		 *           DELAY LISTS	*
  757		 *******************************/
  758
  759add_delay(Delay) :-
  760    '$tbl_delay_list'(DL0),
  761    '$tbl_set_delay_list'([Delay|DL0]).
  762
  763reset_delays :-
  764    '$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).
  772'$wfs_call'(Goal, M:Delays) :-
  773    '$tbl_delay_list'(DL0),
  774    reset_delays,
  775    call(Goal),
  776    '$tbl_delay_list'(DL1),
  777    (   delay_goals(DL1, M, Delays)
  778    ->  true
  779    ;   Delays = undefined
  780    ),
  781    '$append'(DL0, DL1, DL),
  782    '$tbl_set_delay_list'(DL).
  783
  784delay_goals([], _, true) :-
  785    !.
  786delay_goals([AT+AN|T], M, Goal) :-
  787    !,
  788    (   integer(AN)
  789    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  790        (   '$tbl_is_trienode'(Moded)
  791        ->  trie_term(AN, Answer)
  792        ;   true                        % TBD: Generated moded answer
  793        )
  794    ;   AN = Skeleton/ModeArgs
  795    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  796        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  797        G0 = M1:G0plain
  798    ;   '$tbl_table_status'(AT, _, G0, AN)
  799    ),
  800    GN = G0,
  801    (   T == []
  802    ->  Goal = GN
  803    ;   Goal = (GN,GT),
  804        delay_goals(T, M, GT)
  805    ).
  806delay_goals([AT|T], M, Goal) :-
  807    atrie_goal(AT, G0),
  808    unqualify_goal(G0, M, G1),
  809    GN = tnot(G1),
  810    (   T == []
  811    ->  Goal = GN
  812    ;   Goal = (GN,GT),
  813        delay_goals(T, M, GT)
  814    ).
  815
  816at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
  817    is_trie(Trie),
  818    !,
  819    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
  820at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
  821    is_trie(Trie),
  822    !,
  823    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
  824    M2:'$table_mode'(Goal0, Variant, Moded),
  825    unqualify_goal(M2:Goal0, M, Goal).
  826
  827atrie_goal(Trie, M:Goal) :-
  828    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
  829    M:'$table_mode'(Goal, Variant, _Moded).
  830
  831unqualify_goal(M:Goal, M, Goal0) :-
  832    !,
  833    Goal0 = Goal.
  834unqualify_goal(Goal, _, Goal).
  835
  836
  837                 /*******************************
  838                 *            CLEANUP           *
  839                 *******************************/
 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.

  850abolish_all_tables :-
  851    (   '$tbl_abolish_local_tables'
  852    ->  true
  853    ;   true
  854    ),
  855    (   '$tbl_variant_table'(VariantTrie),
  856        trie_gen(VariantTrie, _, Trie),
  857        '$tbl_destroy_table'(Trie),
  858        fail
  859    ;   true
  860    ).
 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?
  869abolish_table_subgoals(SubGoal0) :-
  870    '$tbl_implementation'(SubGoal0, M:SubGoal),
  871    !,
  872    forall(( '$tbl_variant_table'(VariantTrie),
  873             trie_gen(VariantTrie, M:SubGoal, Trie)
  874           ),
  875           '$tbl_destroy_table'(Trie)).
  876abolish_table_subgoals(_).
 abolish_module_tables(+Module) is det
Abolish all tables for predicates associated with the given module.
  882abolish_module_tables(Module) :-
  883    '$must_be'(atom, Module),
  884    '$tbl_variant_table'(VariantTrie),
  885    current_module(Module),
  886    !,
  887    forall(trie_gen(VariantTrie, Module:_, Trie),
  888           '$tbl_destroy_table'(Trie)).
  889abolish_module_tables(_).
 abolish_nonincremental_tables is det
Abolish all tables that are not related to incremental predicates.
  895abolish_nonincremental_tables :-
  896    (   '$tbl_variant_table'(VariantTrie),
  897        trie_gen(VariantTrie, _, Trie),
  898        '$tbl_table_status'(Trie, Status, Goal, _),
  899        (   Status == complete
  900        ->  true
  901        ;   '$permission_error'(abolish, incomplete_table, Trie)
  902        ),
  903        \+ predicate_property(Goal, incremental),
  904        '$tbl_destroy_table'(Trie),
  905        fail
  906    ;   true
  907    ).
 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.
  916abolish_nonincremental_tables(Options) :-
  917    (   Options = on_incomplete(Action)
  918    ->  Action == skip
  919    ;   '$option'(on_incomplete(skip), Options)
  920    ),
  921    !,
  922    (   '$tbl_variant_table'(VariantTrie),
  923        trie_gen(VariantTrie, _, Trie),
  924        '$tbl_table_status'(Trie, complete, Goal, _),
  925        \+ predicate_property(Goal, incremental),
  926        '$tbl_destroy_table'(Trie),
  927        fail
  928    ;   true
  929    ).
  930abolish_nonincremental_tables(_) :-
  931    abolish_nonincremental_tables.
  932
  933
  934                 /*******************************
  935                 *        EXAMINE TABLES        *
  936                 *******************************/
 current_table(:Variant, -Trie) is nondet
True when Trie is the answer table for Variant.
  942current_table(M:Variant, Trie) :-
  943    '$tbl_variant_table'(VariantTrie),
  944    (   (var(Variant) ; var(M))
  945    ->  trie_gen(VariantTrie, M:Variant, Trie)
  946    ;   trie_lookup(VariantTrie, M:Variant, Trie)
  947    ).
  948
  949
  950                 /*******************************
  951                 *      WRAPPER GENERATION      *
  952                 *******************************/
  953
  954:- multifile
  955    system:term_expansion/2,
  956    tabled/2.  957:- dynamic
  958    system:term_expansion/2.  959
  960wrappers(Spec, M) -->
  961    { tabling_defaults([ table_incremental-(incremental=true),
  962                         table_shared-(tshared=true),
  963                         table_subsumptive-((mode)=subsumptive)
  964                       ],
  965                       #{}, Defaults)
  966    },
  967    wrappers(Spec, M, Defaults).
  968
  969wrappers(Var, _, _) -->
  970    { var(Var),
  971      !,
  972      '$instantiation_error'(Var)
  973    }.
  974wrappers(M:Spec, _, Opts) -->
  975    !,
  976    { '$must_be'(atom, M) },
  977    wrappers(Spec, M, Opts).
  978wrappers(Spec as Options, M, Opts0) -->
  979    !,
  980    { table_options(Options, Opts0, Opts) },
  981    wrappers(Spec, M, Opts).
  982wrappers((A,B), M, Opts) -->
  983    !,
  984    wrappers(A, M, Opts),
  985    wrappers(B, M, Opts).
  986wrappers(Name//Arity, M, Opts) -->
  987    { atom(Name), integer(Arity), Arity >= 0,
  988      !,
  989      Arity1 is Arity+2
  990    },
  991    wrappers(Name/Arity1, M, Opts).
  992wrappers(Name/Arity, Module, Opts) -->
  993    { '$option'(mode(TMode), Opts, variant),
  994      atom(Name), integer(Arity), Arity >= 0,
  995      !,
  996      functor(Head, Name, Arity),
  997      '$tbl_trienode'(Reserved)
  998    },
  999    qualify(Module,
 1000            [ '$tabled'(Head, TMode),
 1001              '$table_mode'(Head, Head, Reserved)
 1002            ]),
 1003    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1004    ].
 1005wrappers(ModeDirectedSpec, Module, Opts) -->
 1006    { '$option'(mode(TMode), Opts, variant),
 1007      callable(ModeDirectedSpec),
 1008      !,
 1009      functor(ModeDirectedSpec, Name, Arity),
 1010      functor(Head, Name, Arity),
 1011      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1012      updater_clauses(Modes, Head, UpdateClauses),
 1013      mode_check(Moded, ModeTest),
 1014      (   ModeTest == true
 1015      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1016          TVariant = Head
 1017      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, ModeTest,
 1018                                            Module:Variant, Moded),
 1019          TVariant = Variant
 1020      )
 1021    },
 1022    qualify(Module,
 1023            [ '$tabled'(Head, TMode),
 1024              '$table_mode'(Head, TVariant, Moded)
 1025            ]),
 1026    [ (:- initialization(WrapClause, now))
 1027    ],
 1028    qualify(Module, UpdateClauses).
 1029wrappers(TableSpec, _M, _Opts) -->
 1030    { '$type_error'(table_desclaration, TableSpec)
 1031    }.
 1032
 1033qualify(Module, List) -->
 1034    { prolog_load_context(module, Module) },
 1035    !,
 1036    clist(List).
 1037qualify(Module, List) -->
 1038    qlist(List, Module).
 1039
 1040clist([])    --> [].
 1041clist([H|T]) --> [H], clist(T).
 1042
 1043qlist([], _)    --> [].
 1044qlist([H|T], M) --> [M:H], qlist(T, M).
 1045
 1046
 1047tabling_defaults([], Dict, Dict).
 1048tabling_defaults([Flag-(Opt=Value)|T], Dict0, Dict) :-
 1049    (   current_prolog_flag(Flag, true)
 1050    ->  Dict1 = Dict0.put(Opt,Value)
 1051    ;   Dict1 = Dict0
 1052    ),
 1053    tabling_defaults(T, Dict1, Dict).
 table_options(+Options, +OptDictIn, -OptDictOut)
Handler the ... as options ... construct.
 1060table_options(Options, _Opts0, _Opts) :-
 1061    var(Options),
 1062    '$instantiation_error'(Options).
 1063table_options((A,B), Opts0, Opts) :-
 1064    !,
 1065    table_options(A, Opts0, Opts1),
 1066    table_options(B, Opts1, Opts).
 1067table_options(subsumptive, Opts0, Opts1) :-
 1068    !,
 1069    put_dict(mode, Opts0, subsumptive, Opts1).
 1070table_options(variant, Opts0, Opts1) :-
 1071    !,
 1072    put_dict(mode, Opts0, variant, Opts1).
 1073table_options(incremental, Opts0, Opts1) :-
 1074    !,
 1075    put_dict(incremental, Opts0, true, Opts1).
 1076table_options(opaque, Opts0, Opts1) :-
 1077    !,
 1078    put_dict(incremental, Opts0, false, Opts1).
 1079table_options(dynamic, Opts0, Opts1) :-
 1080    !,
 1081    put_dict(dynamic, Opts0, true, Opts1).
 1082table_options(shared, Opts0, Opts1) :-
 1083    !,
 1084    put_dict(tshared, Opts0, true, Opts1).
 1085table_options(private, Opts0, Opts1) :-
 1086    !,
 1087    put_dict(tshared, Opts0, false, Opts1).
 1088table_options(Opt, _, _) :-
 1089    '$domain_error'(table_option, Opt).
 mode_check(+Moded, -TestCode)
Enforce the output arguments of a mode-directed tabled predicate to be unbound.
 1096mode_check(Moded, Check) :-
 1097    var(Moded),
 1098    !,
 1099    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1100mode_check(Moded, true) :-
 1101    '$tbl_trienode'(Moded),
 1102    !.
 1103mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1104    Moded =.. [s|Vars],
 1105    var_check(Vars, Test).
 1106
 1107var_check([H|T], Test) :-
 1108    (   T == []
 1109    ->  Test = var(H)
 1110    ;   Test = (var(H),Rest),
 1111        var_check(T, Rest)
 1112    ).
 1113
 1114:- public
 1115    instantiated_moded_arg/1. 1116
 1117instantiated_moded_arg(Vars) :-
 1118    '$member'(V, Vars),
 1119    \+ var(V),
 1120    '$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,...)
 1132extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1133    compound(ModeSpec),
 1134    !,
 1135    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1136    compound_name_arguments(Head, Name, HeadArgs),
 1137    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1138    length(ModedArgs, Count),
 1139    atomic_list_concat([$,Name,$,Count], VName),
 1140    Variant =.. [VName|VariantArgs],
 1141    (   ModedArgs == []
 1142    ->  '$tbl_trienode'(ModedAnswer)
 1143    ;   ModedArgs = [ModedAnswer]
 1144    ->  true
 1145    ;   ModedAnswer =.. [s|ModedArgs]
 1146    ).
 1147extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1148    atomic_list_concat([$,Atom,$,0], Variant),
 1149    '$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?
 1159separate_args([], [], [], [], []).
 1160separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1161    indexed_mode(HM),
 1162    !,
 1163    separate_args(TM, TA, TNA, Modes, TMA).
 1164separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1165    separate_args(TM, TA, TNA, Modes, TMA).
 1166
 1167indexed_mode(Mode) :-                           % XSB
 1168    var(Mode),
 1169    !.
 1170indexed_mode(index).                            % YAP
 1171indexed_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.
 1178updater_clauses([], _, []) :- !.
 1179updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1180    update_goal(P, S0,S1,S2, Body).
 1181updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1182    length(Modes, Len),
 1183    functor(S0, s, Len),
 1184    functor(S1, s, Len),
 1185    functor(S2, s, Len),
 1186    S0 =.. [_|Args0],
 1187    S1 =.. [_|Args1],
 1188    S2 =.. [_|Args2],
 1189    update_body(Modes, Args0, Args1, Args2, true, Body).
 1190
 1191update_body([], _, _, _, Body, Body).
 1192update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1193    update_goal(P, A0,A1,A2, Goal),
 1194    mkconj(Body0, Goal, Body1),
 1195    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1196
 1197update_goal(Var, _,_,_, _) :-
 1198    var(Var),
 1199    !,
 1200    '$instantiation_error'(Var).
 1201update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1202    !,
 1203    '$must_be'(atom, M),
 1204    update_goal(lattice(PI), S0,S1,S2, Goal).
 1205update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1206    !,
 1207    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1208    '$must_be'(atom, Name),
 1209    Goal =.. [Name,S0,S1,S2].
 1210update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1211    compound(Head),
 1212    !,
 1213    compound_name_arity(Head, Name, Arity),
 1214    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1215    Goal =.. [Name,S0,S1,S2].
 1216update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1217    !,
 1218    '$must_be'(atom, Name),
 1219    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1220update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1221    !,
 1222    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1223    '$must_be'(atom, Name),
 1224    Call =.. [Name, S0, S1],
 1225    Goal = (Call -> S2 = S0 ; S2 = S1).
 1226update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1227    !,
 1228    '$must_be'(atom, M),
 1229    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1230    '$must_be'(atom, Name),
 1231    Call =.. [Name, S0, S1],
 1232    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1233update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1234    !,
 1235    '$must_be'(atom, M),
 1236    '$must_be'(atom, Name),
 1237    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1238update_goal(po(Name), S0,S1,S2, Goal) :-
 1239    !,
 1240    '$must_be'(atom, Name),
 1241    update_goal(po(Name/2), S0,S1,S2, Goal).
 1242update_goal(Alias, S0,S1,S2, Goal) :-
 1243    update_alias(Alias, Update),
 1244    !,
 1245    update_goal(Update, S0,S1,S2, Goal).
 1246update_goal(Mode, _,_,_, _) :-
 1247    '$domain_error'(tabled_mode, Mode).
 1248
 1249update_alias(first, lattice('$tabling':first/3)).
 1250update_alias(-,     lattice('$tabling':first/3)).
 1251update_alias(last,  lattice('$tabling':last/3)).
 1252update_alias(min,   lattice('$tabling':min/3)).
 1253update_alias(max,   lattice('$tabling':max/3)).
 1254update_alias(sum,   lattice('$tabling':sum/3)).
 1255
 1256mkconj(true, G,  G) :- !.
 1257mkconj(G1,   G2, (G1,G2)).
 1258
 1259
 1260		 /*******************************
 1261		 *          AGGREGATION		*
 1262		 *******************************/
 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.
 1272:- public first/3, last/3, min/3, max/3, sum/3. 1273
 1274first(S, _, S).
 1275last(_, S, S).
 1276min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1277max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1278sum(S0, S1, S) :- S is S0+S1.
 1279
 1280
 1281		 /*******************************
 1282		 *      INCREMENTAL TABLING	*
 1283		 *******************************/
 $wrap_incremental(:Head) is det
Wrap an incremental dynamic predicate to be added to the IDG.
 1289'$wrap_incremental'(Head) :-
 1290    abstract_goal(Head, Abstract),
 1291    '$pi_head'(PI, Head),
 1292    (   Head == Abstract
 1293    ->  prolog_listen(PI, dyn_update)
 1294    ;   prolog_listen(PI, dyn_update(Abstract))
 1295    ).
 1296
 1297abstract_goal(M:Head, M:Abstract) :-
 1298    compound(Head),
 1299    '$get_predicate_attribute'(M:Head, abstract, 1),
 1300    !,
 1301    compound_name_arity(Head, Name, Arity),
 1302    functor(Abstract, Name, Arity).
 1303abstract_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.
 1313dyn_update(_Action, ClauseRef) :-
 1314    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1315    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1316        dyn_changed_pattern(Head)
 1317    ;   true
 1318    ).
 1319
 1320dyn_update(Abstract, _, _) :-
 1321    dyn_changed_pattern(Abstract).
 1322
 1323dyn_changed_pattern(Term) :-
 1324    forall(dyn_affected(Term, ATrie),
 1325           '$idg_changed'(ATrie)).
 1326
 1327dyn_affected(Term, ATrie) :-
 1328    '$tbl_variant_table'(VTable),
 1329    trie_gen(VTable, Term, ATrie).
 $unwrap_incremental(:Head) is det
Remove dynamic predicate incremenal forwarding, reset the possible abstract property and remove possible tables.
 1336'$unwrap_incremental'(Head) :-
 1337    '$pi_head'(PI, Head),
 1338    (   unwrap_predicate(PI, incremental)
 1339    ->  abstract_goal(Head, Abstract),
 1340        (   Head == Abstract
 1341        ->  prolog_unlisten(PI, dyn_update)
 1342        ;   '$set_predicate_attribute'(Head, abstract, 0),
 1343            prolog_unlisten(PI, dyn_update(_))
 1344        ),
 1345        (   '$tbl_variant_table'(VariantTrie)
 1346        ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1347                   '$tbl_destroy_table'(ATrie))
 1348        ;   true
 1349        )
 1350    ;   true
 1351    ).
 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
 1377reeval(ATrie, Goal, Return) :-
 1378    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1379          retry_reeval(ATrie, Goal)).
 1380
 1381retry_reeval(ATrie, Goal) :-
 1382    '$tbl_reeval_abandon'(ATrie),
 1383    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1384    sleep(0.000001),
 1385    call(Goal).
 1386
 1387try_reeval(ATrie, Goal, Return) :-
 1388    nb_current('$tbl_reeval', true),
 1389    !,
 1390    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1391    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1392    (   nonvar(Clause)
 1393    ->  trie_gen_compiled(Clause, Return)
 1394    ;   call(Goal)
 1395    ).
 1396try_reeval(ATrie, Goal, Return) :-
 1397    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1398    findall(Path, false_path(ATrie, Path), Paths0),
 1399    sort(0, @>, Paths0, Paths),
 1400    split_paths(Paths, Dynamic, Complete),
 1401    tdebug(forall('$member'(Path, Dynamic),
 1402                  tdebug(reeval, '  Re-eval dynamic path: ~p', [Path]))),
 1403    tdebug(forall('$member'(Path, Complete),
 1404                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1405    reeval_paths(Dynamic, ATrie),
 1406    reeval_paths(Complete, ATrie),
 1407    '$tbl_reeval_prepare'(ATrie, _Variant, Clause),
 1408    (   nonvar(Clause)
 1409    ->  trie_gen_compiled(Clause, Return)
 1410    ;   call(Goal)
 1411    ).
 1412
 1413split_paths([], [], []).
 1414split_paths([[Rank-_Len|Path]|T], [Path|DT], CT) :-
 1415    status_rank(dynamic, Rank),
 1416    !,
 1417    split_paths(T, DT, CT).
 1418split_paths([[_|Path]|T], DT, [Path|CT]) :-
 1419    split_paths(T, DT, CT).
 1420
 1421reeval_paths([], _) :-
 1422    !.
 1423reeval_paths(BottomUp, ATrie) :-
 1424    is_invalid(ATrie),
 1425    !,
 1426    reeval_heads(BottomUp, ATrie, BottomUp1),
 1427    reeval_paths(BottomUp1, ATrie).
 1428reeval_paths(_, _).
 1429
 1430reeval_heads(_, ATrie, _) :-
 1431    \+ is_invalid(ATrie),
 1432    !.
 1433reeval_heads([], _, []).
 1434reeval_heads([[H]|B], ATrie, BT) :-
 1435    !,
 1436    reeval_node(H),
 1437    reeval_heads(B, ATrie, BT).
 1438reeval_heads([[]|B], ATrie, BT) :-
 1439    !,
 1440    reeval_heads(B, ATrie, BT).
 1441reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1442    !,
 1443    reeval_node(H),
 1444    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.

 1455false_path(ATrie, BottomUp) :-
 1456    false_path(ATrie, Path, []),
 1457    '$reverse'(Path, BottomUp).
 1458
 1459false_path(ATrie, [ATrie|T], Seen) :-
 1460    \+ memberchk(ATrie, Seen),
 1461    '$idg_edge'(ATrie, dependent, Dep),
 1462    '$tbl_reeval_wait'(Dep, Status),
 1463    tdebug(reeval, '    ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
 1464    (   Status == invalid
 1465    ->  false_path(Dep, T, [ATrie|Seen])
 1466    ;   status_rank(Status, Rank),
 1467        length(Seen, Len),
 1468        T = [Rank-Len]
 1469    ).
 1470
 1471status_rank(dynamic,  2) :- !.
 1472status_rank(complete, 1) :- !.
 1473status_rank(Status,   Rank) :-
 1474    var(Rank),
 1475    !,
 1476    format(user_error, 'Re-eval from status ~p~n', [Status]),
 1477    Rank = 0.
 1478status_rank(Rank,   Rank) :-
 1479    format(user_error, 'Re-eval from rank ~p~n', [Rank]).
 1480
 1481is_invalid(ATrie) :-
 1482    '$idg_falsecount'(ATrie, FalseCount),
 1483    FalseCount > 0.
 reeval_node(+ATrie)
Re-evaluate the invalid answer trie ATrie. Initially this created a nested tabling environment, but this is dropped:
 1496reeval_node(ATrie) :-
 1497    '$tbl_reeval_prepare'(ATrie, Variant, Clause),
 1498    var(Clause),
 1499    !,
 1500    tdebug(reeval, 'Re-evaluating ~p', [Variant]),
 1501    (   '$idg_reset_current',
 1502        setup_call_cleanup(
 1503            nb_setval('$tbl_reeval', true),
 1504            ignore(Variant),                    % assumes local scheduling
 1505            nb_delete('$tbl_reeval')),
 1506        fail
 1507    ;   tdebug(reeval, 'Re-evaluated ~p', [Variant])
 1508    ).
 1509reeval_node(_).
 1510
 1511
 1512		 /*******************************
 1513		 *      EXPAND DIRECTIVES	*
 1514		 *******************************/
 1515
 1516system:term_expansion((:- table(Preds)), Expansion) :-
 1517    \+ current_prolog_flag(xref, true),
 1518    prolog_load_context(module, M),
 1519    phrase(wrappers(Preds, M), Clauses),
 1520    multifile_decls(Clauses, Directives0),
 1521    sort(Directives0, Directives),
 1522    '$append'(Directives, Clauses, Expansion).
 1523
 1524multifile_decls([], []).
 1525multifile_decls([H0|T0], [H|T]) :-
 1526    multifile_decl(H0, H),
 1527    !,
 1528    multifile_decls(T0, T).
 1529multifile_decls([_|T0], T) :-
 1530    multifile_decls(T0, T).
 1531
 1532multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 1533    !,
 1534    functor(Head, Name, Arity).
 1535multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 1536    !,
 1537    functor(Head, Name, Arity).
 1538multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 1539    !,
 1540    functor(Head, Name, Arity).
 1541multifile_decl(Head, (:- multifile(Name/Arity))) :-
 1542    !,
 1543    Head \= (:-_),
 1544    functor(Head, Name, Arity).
 1545
 1546
 1547		 /*******************************
 1548		 *      ANSWER COMPLETION	*
 1549		 *******************************/
 1550
 1551:- 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()
 1567answer_completion(AnswerTrie, Return) :-
 1568    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 1569    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 1570    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 1571                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 1572    (   Propagated > 0
 1573    ->  answer_completion(AnswerTrie, Return)
 1574    ;   true
 1575    ).
 1576
 1577answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 1578    (   eval_subgoal_in_residual(AnswerTrie, Return),
 1579        fail
 1580    ;   true
 1581    ),
 1582    delete_answers_for_failing_calls(Propagated),
 1583    (   Propagated == 0
 1584    ->  mark_succeeding_calls_as_answer_completed
 1585    ;   true
 1586    ).
 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.
 1594delete_answers_for_failing_calls(Propagated) :-
 1595    State = state(0),
 1596    (   subgoal_residual_trie(ASGF, ESGF),
 1597        \+ trie_gen(ESGF, _ETmp),
 1598        tdebug(trie_goal(ASGF, Goal0, _)),
 1599        tdebug(trie_goal(ASGF, Goal, _0Return)),
 1600        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 1601        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 1602	'$tbl_force_truth_value'(ALeaf, false, Count),
 1603        arg(1, State, Prop0),
 1604        Prop is Prop0+Count-1,
 1605        nb_setarg(1, State, Prop),
 1606	fail
 1607    ;   arg(1, State, Propagated)
 1608    ).
 1609
 1610mark_succeeding_calls_as_answer_completed :-
 1611    (   subgoal_residual_trie(ASGF, _ESGF),
 1612        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 1613        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 1614            tdebug(trie_goal(ASGF, Goal, _0Return)),
 1615            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 1616            '$tbl_set_answer_completed'(ASGF)
 1617        ),
 1618        fail
 1619    ;   true
 1620    ).
 1621
 1622subgoal_residual_trie(ASGF, ESGF) :-
 1623    '$tbl_variant_table'(VariantTrie),
 1624    context_module(M),
 1625    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.
 1632eval_dl_in_residual(true) :-
 1633    !.
 1634eval_dl_in_residual((A;B)) :-
 1635    !,
 1636    (   eval_dl_in_residual(A)
 1637    ;   eval_dl_in_residual(B)
 1638    ).
 1639eval_dl_in_residual((A,B)) :-
 1640    !,
 1641    eval_dl_in_residual(A),
 1642    eval_dl_in_residual(B).
 1643eval_dl_in_residual(tnot(G)) :-
 1644    !,
 1645    tdebug(ac, ' ? tnot(~p)', [G]),
 1646    current_table(G, SGF),
 1647    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 1648    tnot(eval_subgoal_in_residual(SGF, Return)).
 1649eval_dl_in_residual(G) :-
 1650    tdebug(ac, ' ? ~p', [G]),
 1651    (   current_table(G, SGF)
 1652    ->	true
 1653    ;   more_general_table(G, SGF)
 1654    ->	true
 1655    ;	writeln(user_error, 'MISSING CALL? '(G)),
 1656        fail
 1657    ),
 1658    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 1659    eval_subgoal_in_residual(SGF, Return).
 1660
 1661more_general_table(G, Trie) :-
 1662    term_variables(G, Vars),
 1663    '$tbl_variant_table'(VariantTrie),
 1664    trie_gen(VariantTrie, G, Trie),
 1665    is_most_general_term(Vars).
 1666
 1667:- 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.
 1674eval_subgoal_in_residual(AnswerTrie, _Return) :-
 1675    '$tbl_is_answer_completed'(AnswerTrie),
 1676    !,
 1677    undefined.
 1678eval_subgoal_in_residual(AnswerTrie, Return) :-
 1679    '$tbl_answer'(AnswerTrie, Return, Condition),
 1680    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 1681    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 1682    eval_dl_in_residual(Condition).
 undefined
Expresses the value bottom from the well founded semantics.
 1688:- table
 1689    system:undefined/0,
 1690    system:tabled_call/1. 1691
 1692system:(undefined :-
 1693    tnot(undefined)).
 1694
 1695system:(tabled_call(X) :- call(X))