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

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

 table :PredicateIndicators

Prepare the given PredicateIndicators for tabling. This predicate is normally used as a directive, but SWI-Prolog also allows runtime conversion of non-tabled predicates to tabled predicates by calling table/1. The example below prepares the predicate edge/2 and the non-terminal statement//1 for tabled execution.

:- table edge/2, statement//1.

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

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

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

  177table(M:PIList) :-
  178    setup_call_cleanup(
  179        '$set_source_module'(OldModule, M),
  180        expand_term((:- table(PIList)), Clauses),
  181        '$set_source_module'(OldModule)),
  182    dyn_tabling_list(Clauses, M).
  183
  184dyn_tabling_list([], _).
  185dyn_tabling_list([H|T], M) :-
  186    dyn_tabling(H, M),
  187    dyn_tabling_list(T, M).
  188
  189dyn_tabling(M:Clause, _) :-
  190    !,
  191    dyn_tabling(Clause, M).
  192dyn_tabling((:- multifile(PI)), M) :-
  193    !,
  194    multifile(M:PI),
  195    dynamic(M:PI).
  196dyn_tabling(:- initialization(Wrap, now), M) :-
  197    !,
  198    M:Wrap.
  199dyn_tabling('$tabled'(Head, TMode), M) :-
  200    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  201        (   OMode \== TMode
  202        ->  erase(Ref),
  203            fail
  204        ;   true
  205        )
  206    ->  true
  207    ;   assertz(M:'$tabled'(Head, TMode))
  208    ).
  209dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  210    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  211    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  212        ->  true
  213        ;   erase(Ref),
  214            assertz(M:'$table_mode'(Head, Variant, Moded))
  215        )
  216    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  217    ).
  218dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  219    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  220    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  221        ->  true
  222        ;   erase(Ref),
  223            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  224        )
  225    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  226    ).

 untable(M:PIList) is det

Remove tabling for the predicates in PIList. This can be used to undo the effect of table/1 at runtime. In addition to removing the tabling instrumentation this also removes possibly associated tables using abolish_table_subgoals/1.

Arguments:

PIList

- is a comma-list that is compatible ith table/1.

  237untable(M:PIList) :-
  238    untable(PIList, M).
  239
  240untable(Var, _) :-
  241    var(Var),
  242    !,
  243    '$instantiation_error'(Var).
  244untable(M:Spec, _) :-
  245    !,
  246    '$must_be'(atom, M),
  247    untable(Spec, M).
  248untable((A,B), M) :-
  249    !,
  250    untable(A, M),
  251    untable(B, M).
  252untable(Name//Arity, M) :-
  253    atom(Name), integer(Arity), Arity >= 0,
  254    !,
  255    Arity1 is Arity+2,
  256    untable(Name/Arity1, M).
  257untable(Name/Arity, M) :-
  258    !,
  259    functor(Head, Name, Arity),
  260    (   '$get_predicate_attribute'(M:Head, tabled, 1)
  261    ->  abolish_table_subgoals(M:Head),
  262        dynamic(M:'$tabled'/2),
  263        dynamic(M:'$table_mode'/3),
  264        retractall(M:'$tabled'(Head, _TMode)),
  265        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  266        unwrap_predicate(M:Name/Arity, table),
  267        '$set_predicate_attribute'(M:Head, tabled, false),
  268        '$set_predicate_attribute'(M:Head, opaque, false),
  269        '$set_predicate_attribute'(M:Head, incremental, false),
  270        '$set_predicate_attribute'(M:Head, monotonic, false),
  271        '$set_predicate_attribute'(M:Head, lazy, false)
  272    ;   true
  273    ).
  274untable(Head, M) :-
  275    callable(Head),
  276    !,
  277    functor(Head, Name, Arity),
  278    untable(Name/Arity, M).
  279untable(TableSpec, _) :-
  280    '$type_error'(table_desclaration, TableSpec).
  281
  282untable_reconsult(PI) :-
  283    print_message(informational, untable(PI)),
  284    untable(PI).
  285
  286:- initialization
  287   prolog_listen(untable, untable_reconsult).  288
  289
  290'$wrap_tabled'(Head, Options) :-
  291    get_dict(mode, Options, subsumptive),
  292    !,
  293    set_pattributes(Head, Options),
  294    '$wrap_predicate'(Head, table, Closure, Wrapped,
  295                      start_subsumptive_tabling(Closure, Head, Wrapped)).
  296'$wrap_tabled'(Head, Options) :-
  297    get_dict(subgoal_abstract, Options, _Abstract),
  298    !,
  299    set_pattributes(Head, Options),
  300    '$wrap_predicate'(Head, table, Closure, Wrapped,
  301                      start_abstract_tabling(Closure, Head, Wrapped)).
  302'$wrap_tabled'(Head, Options) :-
  303    !,
  304    set_pattributes(Head, Options),
  305    '$wrap_predicate'(Head, table, Closure, Wrapped,
  306                      start_tabling(Closure, Head, Wrapped)).

 set_pattributes(:Head, +Options) is det

Set all tabling attributes for Head. These have been collected using table_options/3 from the :- table Head as (Attr1,...) directive.

  313set_pattributes(Head, Options) :-
  314    '$set_predicate_attribute'(Head, tabled, true),
  315    (   tabled_attribute(Attr),
  316        get_dict(Attr, Options, Value),
  317        '$set_predicate_attribute'(Head, Attr, Value),
  318        fail
  319    ;   current_prolog_flag(table_monotonic, lazy),
  320        '$set_predicate_attribute'(Head, lazy, true),
  321        fail
  322    ;   true
  323    ).
  324
  325tabled_attribute(incremental).
  326tabled_attribute(dynamic).
  327tabled_attribute(tshared).
  328tabled_attribute(max_answers).
  329tabled_attribute(subgoal_abstract).
  330tabled_attribute(answer_abstract).
  331tabled_attribute(monotonic).
  332tabled_attribute(opaque).
  333tabled_attribute(lazy).

 start_tabling(:Closure, :Wrapper, :Implementation)

Execute Implementation using tabling. This predicate should not be called directly. The table/1 directive causes a predicate to be translated into a renamed implementation and a wrapper that involves this predicate.

Arguments:

Closure

- is the wrapper closure to find the predicate quickly. It is also allowed to pass nothing. In that cases the predicate is looked up using Wrapper. We suggest to pass 0 in this case.

Compatibility

- This interface may change or disappear without notice from future versions.

  349start_tabling(Closure, Wrapper, Worker) :-
  350    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton, IsMono),
  351    (   IsMono == true
  352    ->  shift(dependency(Skeleton, Trie, Mono)),
  353        (   Mono == true
  354        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  355        ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  356        )
  357    ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  358    ).
  359
  360start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
  361    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  362    (   Status == complete
  363    ->  trie_gen_compiled(Trie, Skeleton)
  364    ;   functor(Status, fresh, 2)
  365    ->  catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
  366              deadlock,
  367              restart_tabling(Closure, Wrapper, Worker))
  368    ;   Status == invalid
  369    ->  reeval(Trie, Wrapper, Skeleton)
  370    ;   % = run_follower, but never fresh and Status is a worklist
  371        shift(call_info(Skeleton, Status))
  372    ).
  373
  374create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
  375    tdebug(Fresh = fresh(SCC, WorkList)),
  376    tdebug(wl_goal(WorkList, Goal, _)),
  377    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  378    setup_call_catcher_cleanup(
  379        '$idg_set_current'(OldCurrent, Trie),
  380        run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
  381        Catcher,
  382        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  383    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  384    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.

  394restart_tabling(Closure, Wrapper, Worker) :-
  395    tdebug(user_goal(Wrapper, Goal)),
  396    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  397    sleep(0.000001),
  398    start_tabling(Closure, Wrapper, Worker).
  399
  400restart_abstract_tabling(Closure, Wrapper, Worker) :-
  401    tdebug(user_goal(Wrapper, Goal)),
  402    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  403    sleep(0.000001),
  404    start_abstract_tabling(Closure, Wrapper, Worker).

 start_subsumptive_tabling(:Closure, :Wrapper, :Implementation)

(*) We should not use trie_gen_compiled/2 here as this will enumerate all answers while '$tbl_answer_update_dl'/2 uses the available trie indexing to only fetch the relevant answer(s).

To be done

- In the end '$tbl_answer_update_dl'/2 is problematic with incremental and shared tabling as we do not get the consistent update view from the compiled result.

  416start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  417    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  418    ->  (   Status == complete
  419        ->  trie_gen_compiled(Trie, Skeleton)
  420        ;   Status == invalid
  421        ->  reeval(Trie, Wrapper, Skeleton),
  422            trie_gen_compiled(Trie, Skeleton)
  423        ;   shift(call_info(Skeleton, Status))
  424        )
  425    ;   more_general_table(Wrapper, ATrie),
  426        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  427    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  428    ;   more_general_table(Wrapper, ATrie),
  429        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  430    ->  (   Status == invalid
  431        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  432            Wrapper = GenWrapper,
  433            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  434        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  435            shift(call_info(GenSkeleton, Skeleton, Status)),
  436            unify_subsumptive(Skeleton, GenSkeleton)
  437        )
  438    ;   start_tabling(Closure, Wrapper, Worker)
  439    ).

 wrapper_skeleton(+GenWrapper, +GenSkeleton, +Wrapper, -Skeleton)

Skeleton is a specialized version of GenSkeleton for the subsumed new consumer.

  446wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  447    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  448    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  449           [GenSkeleton+Skeleton]).
  450
  451unify_subsumptive(X,X).

 start_abstract_tabling(:Closure, :Wrapper, :Worker)

Deal with table p/1 as subgoal_abstract(N). This is a merge between variant and subsumptive tabling. If the goal is not abstracted this is simple variant tabling. If the goal is abstracted we must solve the more general goal and use answers from the abstract table.

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

  464start_abstract_tabling(Closure, Wrapper, Worker) :-
  465    '$tbl_abstract_table'(Closure, Wrapper, Trie, _Abstract, Status, Skeleton),
  466    tdebug(abstract, 'Wrapper=~p, Worker=~p, Skel=~p',
  467           [Wrapper, Worker, Skeleton]),
  468    (   is_most_general_term(Skeleton)           % TBD: Fill and test Abstract
  469    ->  start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  470    ;   Status == complete
  471    ->  '$tbl_answer_update_dl'(Trie, Skeleton)
  472    ;   functor(Status, fresh, 2)
  473    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  474        abstract_worker(Worker, GenWrapper, GenWorker),
  475        catch(create_abstract_table(Trie, Status, Skeleton, GenSkeleton, GenWrapper,
  476                                    GenWorker),
  477              deadlock,
  478              restart_abstract_tabling(Closure, Wrapper, Worker))
  479    ;   Status == invalid
  480    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  481        reeval(ATrie, GenWrapper, GenSkeleton),
  482        Wrapper = GenWrapper,
  483        '$tbl_answer_update_dl'(ATrie, Skeleton)
  484    ;   shift(call_info(GenSkeleton, Skeleton, Status)),
  485        unify_subsumptive(Skeleton, GenSkeleton)
  486    ).
  487
  488create_abstract_table(Trie, Fresh, Skeleton, GenSkeleton, Wrapper, Worker) :-
  489    tdebug(Fresh = fresh(SCC, WorkList)),
  490    tdebug(wl_goal(WorkList, Goal, _)),
  491    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  492    setup_call_catcher_cleanup(
  493        '$idg_set_current'(OldCurrent, Trie),
  494        run_leader(GenSkeleton, Worker, Fresh, LStatus, _Clause),
  495        Catcher,
  496        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  497    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  498    Skeleton = GenSkeleton,
  499    done_abstract_leader(LStatus, Fresh, GenSkeleton, Trie).
  500
  501abstract_worker(_:call(Term), _M:GenWrapper, call(GenTerm)) :-
  502    functor(Term, Closure, _),
  503    GenWrapper =.. [_|Args],
  504    GenTerm =.. [Closure|Args].
  505
  506:- '$hide'((done_abstract_leader/4)).  507
  508done_abstract_leader(complete, _Fresh, Skeleton, Trie) :-
  509    !,
  510    '$tbl_answer_update_dl'(Trie, Skeleton).
  511done_abstract_leader(final, fresh(SCC, _Worklist), Skeleton, Trie) :-
  512    !,
  513    '$tbl_free_component'(SCC),
  514    '$tbl_answer_update_dl'(Trie, Skeleton).
  515done_abstract_leader(_,_,_,_).

 done_leader(+Status, +Fresh, +Skeleton, -Clause)

Called on completion of a table. Possibly destroys the component and generates the answers from the complete table. The last cases deals with leaders that are merged into a higher SCC (and thus no longer a leader).

  524:- '$hide'((done_leader/4, finished_leader/4)).  525
  526done_leader(complete, _Fresh, Skeleton, Clause) :-
  527    !,
  528    trie_gen_compiled(Clause, Skeleton).
  529done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  530    !,
  531    '$tbl_free_component'(SCC),
  532    trie_gen_compiled(Clause, Skeleton).
  533done_leader(_,_,_,_).
  534
  535finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  536    '$idg_set_current'(OldCurrent),
  537    (   Catcher == exit
  538    ->  true
  539    ;   Catcher == fail
  540    ->  true
  541    ;   Catcher = exception(_)
  542    ->  Fresh = fresh(SCC, _),
  543        '$tbl_table_discard_all'(SCC)
  544    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  545    ).

 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.

  560run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  561    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  562    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  563    activate(Skeleton, Worker, Worklist),
  564    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  565    completion(SCC, Status, Clause),
  566    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  567    (   Status == merged
  568    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  569        '$tbl_wkl_make_follower'(Worklist),
  570        shift(call_info(Skeleton, Worklist))
  571    ;   true                                    % completed
  572    ).
  573
  574activate(Skeleton, Worker, WorkList) :-
  575    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  576    (   reset_delays,
  577        delim(Skeleton, Worker, WorkList, []),
  578        fail
  579    ;   true
  580    ).

 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.

  596delim(Skeleton, Worker, WorkList, Delays) :-
  597    reset(Worker, SourceCall, Continuation),
  598    tdebug(wl_goal(WorkList, Goal, _)),
  599    (   Continuation == 0
  600    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  601        tdebug(delay_goals(AllDelays, Cond)),
  602        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  603               [Skeleton, Goal, Cond]),
  604        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  605        Complete == !,
  606        !
  607    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  608    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  609        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  610        tdebug(wl_goal(WorkList, DstGoal, _)),
  611        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  612        '$tbl_wkl_add_suspension'(
  613            SourceWL,
  614            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  615    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  616    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  617        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  618        tdebug(wl_goal(WorkList, DstGoal, _)),
  619        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  620        '$tbl_wkl_add_suspension'(
  621            SourceWL,
  622            InstSkeleton,
  623            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  624    ;   '$tbl_wkl_table'(WorkList, ATrie),
  625        mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
  626    ->  delim(Skeleton, Continuation, WorkList, Delays)
  627    ).

 start_moded_tabling(+Closure, :Wrapper, :Implementation, +Variant, +ModeArgs)

As start_tabling/2, but in addition separates the data stored in the answer trie in the Variant and ModeArgs.

  634'$moded_wrap_tabled'(Head, Options, ModeTest, WrapperNoModes, ModeArgs) :-
  635    set_pattributes(Head, Options),
  636    '$wrap_predicate'(Head, table, Closure, Wrapped,
  637                      (   ModeTest,
  638                          start_moded_tabling(Closure, Head, Wrapped,
  639                                              WrapperNoModes, ModeArgs)
  640                      )).
  641
  642
  643start_moded_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  644    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie,
  645                               Status, Skeleton, IsMono),
  646    (   IsMono == true
  647    ->  shift(dependency(Skeleton/ModeArgs, Trie, Mono)),
  648        (   Mono == true
  649        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  650        ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  651                                  Trie, Status, Skeleton)
  652        )
  653    ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  654                              Trie, Status, Skeleton)
  655    ).
  656
  657start_moded_tabling_2(_Closure, Wrapper, Worker, ModeArgs,
  658                      Trie, Status, Skeleton) :-
  659    (   Status == complete
  660    ->  moded_gen_answer(Trie, Skeleton, ModeArgs)
  661    ;   functor(Status, fresh, 2)
  662    ->  setup_call_catcher_cleanup(
  663            '$idg_set_current'(OldCurrent, Trie),
  664            moded_run_leader(Wrapper, Skeleton/ModeArgs,
  665                             Worker, Status, LStatus),
  666            Catcher,
  667            finished_leader(OldCurrent, Catcher, Status, Wrapper)),
  668        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  669               [Wrapper, ModeArgs, LStatus]),
  670        moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
  671    ;   Status == invalid
  672    ->  reeval(Trie, Wrapper, Skeleton),
  673        moded_gen_answer(Trie, Skeleton, ModeArgs)
  674    ;   % = run_follower, but never fresh and Status is a worklist
  675        shift(call_info(Skeleton/ModeArgs, Status))
  676    ).
  677
  678:- public
  679    moded_gen_answer/3.                         % XSB tables.pl
  680
  681moded_gen_answer(Trie, Skeleton, ModedArgs) :-
  682    trie_gen(Trie, Skeleton),
  683    '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
  684
  685'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
  686    trie_gen(ATrie, Skeleton),
  687    '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
  688
  689moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
  690    !,
  691    moded_gen_answer(Trie, Skeleton, ModeArgs).
  692moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
  693    !,
  694    '$tbl_free_component'(SCC),
  695    moded_gen_answer(Trie, Skeleton, ModeArgs).
  696moded_done_leader(_, _, _, _, _).
  697
  698moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
  699    tdebug(wl_goal(Worklist, Goal, _)),
  700    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  701    moded_activate(SkeletonMA, Worker, Worklist),
  702    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  703    completion(SCC, Status, _Clause),           % TBD: propagate
  704    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  705    (   Status == merged
  706    ->  tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
  707        '$tbl_wkl_make_follower'(Worklist),
  708        shift(call_info(SkeletonMA, Worklist))
  709    ;   true                                    % completed
  710    ).
  711
  712moded_activate(SkeletonMA, Worker, WorkList) :-
  713    (   reset_delays,
  714        delim(SkeletonMA, Worker, WorkList, []),
  715        fail
  716    ;   true
  717    ).

 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

  735:- public
  736    update/7.  737
  738update(0b11, Wrapper, M, A1, A2, A3, delete) :-
  739    !,
  740    M:'$table_update'(Wrapper, A1, A2, A3),
  741    A1 \=@= A3.
  742update(0b10, Wrapper, M, A1, A2, A3, Action) :-
  743    !,
  744    (   is_subsumed_by(Wrapper, M, A2, A1)
  745    ->  Action = done
  746    ;   A3 = A2,
  747        Action = keep
  748    ).
  749update(0b01, Wrapper, M, A1, A2, A2, Action) :-
  750    !,
  751    (   is_subsumed_by(Wrapper, M, A1, A2)
  752    ->  Action = delete
  753    ;   Action = keep
  754    ).
  755update(0b00, _Wrapper, _M, _A1, A2, A2, keep) :-
  756    !.
  757
  758is_subsumed_by(Wrapper, M, Instance, General) :-
  759    M:'$table_update'(Wrapper, Instance, General, New),
  760    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.

  769completion(SCC, Status, Clause) :-
  770    (   reset_delays,
  771        completion_(SCC),
  772        fail
  773    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  774        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  775    ).
  776
  777completion_(SCC) :-
  778    repeat,
  779    (   '$tbl_pop_worklist'(SCC, WorkList)
  780    ->  tdebug(wl_goal(WorkList, Goal, _)),
  781        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  782        completion_step(WorkList)
  783    ;   !
  784    ).

 $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:

• Answer and Goal must be unified to rebind the input arguments for the continuation.
• Wrapper is stored in TargetWorklist on successful completion of the Continuation.
• If Answer Subsumption is in effect, the story is a bit more complex and ModeArgs provide the binding over which we do aggregation. Otherwise, ModeArgs is the the reserved trie node produced by '$tbl_trienode'/1.

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.

  815completion_step(SourceWL) :-
  816    '$tbl_wkl_work'(SourceWL,
  817                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  818    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  819    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  820    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  821    tdebug(delay_goals(AllDelays, Cond)),
  822    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  823           [TargetGoal, SourceGoal, Answer, Cond]),
  824    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  825    fail.
  826
  827
  828		 /*******************************
  829		 *     STRATIFIED NEGATION	*
  830		 *******************************/

 tnot(:Goal)

Tabled negation.

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

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

  881negation_suspend(Wrapper, Skeleton, Worklist) :-
  882    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  883    '$tbl_wkl_negative'(Worklist),
  884    shift(call_info(Skeleton, tnot(Worklist))),
  885    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  886    '$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.

  895not_exists(Goal) :-
  896    ground(Goal),
  897    '$get_predicate_attribute'(Goal, tabled, 1),
  898    !,
  899    tnot(Goal).
  900not_exists(Goal) :-
  901    (   tabled_call(Goal), fail
  902    ;   tnot(tabled_call(Goal))
  903    ).
  904
  905		 /*******************************
  906		 *           DELAY LISTS	*
  907		 *******************************/
  908
  909add_delay(Delay) :-
  910    '$tbl_delay_list'(DL0),
  911    '$tbl_set_delay_list'([Delay|DL0]).
  912
  913reset_delays :-
  914    '$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).

  922'$wfs_call'(Goal, M:Delays) :-
  923    '$tbl_delay_list'(DL0),
  924    reset_delays,
  925    call(Goal),
  926    '$tbl_delay_list'(DL1),
  927    (   delay_goals(DL1, M, Delays)
  928    ->  true
  929    ;   Delays = undefined
  930    ),
  931    '$append'(DL0, DL1, DL),
  932    '$tbl_set_delay_list'(DL).
  933
  934delay_goals([], _, true) :-
  935    !.
  936delay_goals([AT+AN|T], M, Goal) :-
  937    !,
  938    (   integer(AN)
  939    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  940        (   '$tbl_is_trienode'(Moded)
  941        ->  trie_term(AN, Answer)
  942        ;   true                        % TBD: Generated moded answer
  943        )
  944    ;   AN = Skeleton/ModeArgs
  945    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  946        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  947        G0 = M1:G0plain
  948    ;   '$tbl_table_status'(AT, _, G0, AN)
  949    ),
  950    GN = G0,
  951    (   T == []
  952    ->  Goal = GN
  953    ;   Goal = (GN,GT),
  954        delay_goals(T, M, GT)
  955    ).
  956delay_goals([AT|T], M, Goal) :-
  957    atrie_goal(AT, G0),
  958    unqualify_goal(G0, M, G1),
  959    GN = tnot(G1),
  960    (   T == []
  961    ->  Goal = GN
  962    ;   Goal = (GN,GT),
  963        delay_goals(T, M, GT)
  964    ).
  965
  966at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
  967    is_trie(Trie),
  968    !,
  969    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
  970at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
  971    is_trie(Trie),
  972    !,
  973    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
  974    M2:'$table_mode'(Goal0, Variant, Moded),
  975    unqualify_goal(M2:Goal0, M, Goal).
  976
  977atrie_goal(Trie, M:Goal) :-
  978    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
  979    M:'$table_mode'(Goal, Variant, _Moded).
  980
  981unqualify_goal(M:Goal, M, Goal0) :-
  982    !,
  983    Goal0 = Goal.
  984unqualify_goal(Goal, _, Goal).
  985
  986
  987                 /*******************************
  988                 *            CLEANUP           *
  989                 *******************************/

 abolish_all_tables

Remove all tables. This is normally used to free up the space or recompute the result after predicates on which the result for some tabled predicates depend.

Abolishes both local and shared tables. Possibly incomplete tables are marked for destruction upon completion. The dependency graphs for incremental and monotonic tabling are reclaimed as well.

 1001abolish_all_tables :-
 1002    (   '$tbl_abolish_local_tables'
 1003    ->  true
 1004    ;   true
 1005    ),
 1006    (   '$tbl_variant_table'(VariantTrie),
 1007        trie_gen(VariantTrie, _, Trie),
 1008        '$tbl_destroy_table'(Trie),
 1009        fail
 1010    ;   true
 1011    ).
 1012
 1013abolish_private_tables :-
 1014    (   '$tbl_abolish_local_tables'
 1015    ->  true
 1016    ;   (   '$tbl_local_variant_table'(VariantTrie),
 1017            trie_gen(VariantTrie, _, Trie),
 1018            '$tbl_destroy_table'(Trie),
 1019            fail
 1020        ;   true
 1021        )
 1022    ).
 1023
 1024abolish_shared_tables :-
 1025    (   '$tbl_global_variant_table'(VariantTrie),
 1026        trie_gen(VariantTrie, _, Trie),
 1027        '$tbl_destroy_table'(Trie),
 1028        fail
 1029    ;   true
 1030    ).

 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?

 1039abolish_table_subgoals(SubGoal0) :-
 1040    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1041    !,
 1042    '$must_be'(acyclic, SubGoal),
 1043    (   '$tbl_variant_table'(VariantTrie),
 1044        trie_gen(VariantTrie, M:SubGoal, Trie),
 1045        '$tbl_destroy_table'(Trie),
 1046        fail
 1047    ;   true
 1048    ).
 1049abolish_table_subgoals(_).

 abolish_module_tables(+Module) is det

Abolish all tables for predicates associated with the given module.

 1055abolish_module_tables(Module) :-
 1056    '$must_be'(atom, Module),
 1057    '$tbl_variant_table'(VariantTrie),
 1058    current_module(Module),
 1059    !,
 1060    forall(trie_gen(VariantTrie, Module:_, Trie),
 1061           '$tbl_destroy_table'(Trie)).
 1062abolish_module_tables(_).

 abolish_nonincremental_tables is det

Abolish all tables that are not related to incremental predicates.

 1068abolish_nonincremental_tables :-
 1069    (   '$tbl_variant_table'(VariantTrie),
 1070        trie_gen(VariantTrie, _, Trie),
 1071        '$tbl_table_status'(Trie, Status, Goal, _),
 1072        (   Status == complete
 1073        ->  true
 1074        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1075        ),
 1076        \+ predicate_property(Goal, incremental),
 1077        '$tbl_destroy_table'(Trie),
 1078        fail
 1079    ;   true
 1080    ).

 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.

 1089abolish_nonincremental_tables(Options) :-
 1090    (   Options = on_incomplete(Action)
 1091    ->  Action == skip
 1092    ;   '$option'(on_incomplete(skip), Options)
 1093    ),
 1094    !,
 1095    (   '$tbl_variant_table'(VariantTrie),
 1096        trie_gen(VariantTrie, _, Trie),
 1097        '$tbl_table_status'(Trie, complete, Goal, _),
 1098        \+ predicate_property(Goal, incremental),
 1099        '$tbl_destroy_table'(Trie),
 1100        fail
 1101    ;   true
 1102    ).
 1103abolish_nonincremental_tables(_) :-
 1104    abolish_nonincremental_tables.
 1105
 1106
 1107                 /*******************************
 1108                 *        EXAMINE TABLES        *
 1109                 *******************************/

 current_table(:Variant, -Trie) is nondet

True when Trie is the answer table for Variant. If Variant has an unbound module or goal, all possible answer tries are generated, otherwise Variant is considered a fully instantiated variant and the predicate is semidet.

 1118current_table(Variant, Trie) :-
 1119    ct_generate(Variant),
 1120    !,
 1121    current_table_gen(Variant, Trie).
 1122current_table(Variant, Trie) :-
 1123    current_table_lookup(Variant, Trie),
 1124    !.
 1125
 1126current_table_gen(M:Variant, Trie) :-
 1127    '$tbl_local_variant_table'(VariantTrie),
 1128    trie_gen(VariantTrie, M:NonModed, Trie),
 1129    M:'$table_mode'(Variant, NonModed, _Moded).
 1130current_table_gen(M:Variant, Trie) :-
 1131    '$tbl_global_variant_table'(VariantTrie),
 1132    trie_gen(VariantTrie, M:NonModed, Trie),
 1133    \+ '$tbl_table_status'(Trie, fresh), % shared tables are not destroyed
 1134    M:'$table_mode'(Variant, NonModed, _Moded).
 1135
 1136current_table_lookup(M:Variant, Trie) :-
 1137    M:'$table_mode'(Variant, NonModed, _Moded),
 1138    '$tbl_local_variant_table'(VariantTrie),
 1139    trie_lookup(VariantTrie, M:NonModed, Trie).
 1140current_table_lookup(M:Variant, Trie) :-
 1141    M:'$table_mode'(Variant, NonModed, _Moded),
 1142    '$tbl_global_variant_table'(VariantTrie),
 1143    trie_lookup(VariantTrie, NonModed, Trie),
 1144    \+ '$tbl_table_status'(Trie, fresh).
 1145
 1146ct_generate(M:Variant) :-
 1147    (   var(Variant)
 1148    ->  true
 1149    ;   var(M)
 1150    ).
 1151
 1152                 /*******************************
 1153                 *      WRAPPER GENERATION      *
 1154                 *******************************/
 1155
 1156:- multifile
 1157    system:term_expansion/2,
 1158    tabled/2. 1159:- dynamic
 1160    system:term_expansion/2. 1161
 1162wrappers(Spec, M) -->
 1163    { tabling_defaults(
 1164          [ (table_incremental=true)            - (incremental=true),
 1165            (table_shared=true)                 - (tshared=true),
 1166            (table_subsumptive=true)            - ((mode)=subsumptive),
 1167            call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
 1168          ],
 1169          #{}, Defaults)
 1170    },
 1171    wrappers(Spec, M, Defaults).
 1172
 1173wrappers(Var, _, _) -->
 1174    { var(Var),
 1175      !,
 1176      '$instantiation_error'(Var)
 1177    }.
 1178wrappers(M:Spec, _, Opts) -->
 1179    !,
 1180    { '$must_be'(atom, M) },
 1181    wrappers(Spec, M, Opts).
 1182wrappers(Spec as Options, M, Opts0) -->
 1183    !,
 1184    { table_options(Options, Opts0, Opts) },
 1185    wrappers(Spec, M, Opts).
 1186wrappers((A,B), M, Opts) -->
 1187    !,
 1188    wrappers(A, M, Opts),
 1189    wrappers(B, M, Opts).
 1190wrappers(Name//Arity, M, Opts) -->
 1191    { atom(Name), integer(Arity), Arity >= 0,
 1192      !,
 1193      Arity1 is Arity+2
 1194    },
 1195    wrappers(Name/Arity1, M, Opts).
 1196wrappers(Name/Arity, Module, Opts) -->
 1197    { '$option'(mode(TMode), Opts, variant),
 1198      atom(Name), integer(Arity), Arity >= 0,
 1199      !,
 1200      functor(Head, Name, Arity),
 1201      '$tbl_trienode'(Reserved)
 1202    },
 1203    qualify(Module,
 1204            [ '$tabled'(Head, TMode),
 1205              '$table_mode'(Head, Head, Reserved)
 1206            ]),
 1207    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1208    ].
 1209wrappers(ModeDirectedSpec, Module, Opts) -->
 1210    { '$option'(mode(TMode), Opts, variant),
 1211      callable(ModeDirectedSpec),
 1212      !,
 1213      functor(ModeDirectedSpec, Name, Arity),
 1214      functor(Head, Name, Arity),
 1215      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1216      updater_clauses(Modes, Head, UpdateClauses),
 1217      mode_check(Moded, ModeTest),
 1218      (   ModeTest == true
 1219      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1220          TVariant = Head
 1221      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, Opts, ModeTest,
 1222                                            Module:Variant, Moded),
 1223          TVariant = Variant
 1224      )
 1225    },
 1226    qualify(Module,
 1227            [ '$tabled'(Head, TMode),
 1228              '$table_mode'(Head, TVariant, Moded)
 1229            ]),
 1230    [ (:- initialization(WrapClause, now))
 1231    ],
 1232    qualify(Module, UpdateClauses).
 1233wrappers(TableSpec, _M, _Opts) -->
 1234    { '$type_error'(table_desclaration, TableSpec)
 1235    }.
 1236
 1237qualify(Module, List) -->
 1238    { prolog_load_context(module, Module) },
 1239    !,
 1240    clist(List).
 1241qualify(Module, List) -->
 1242    qlist(List, Module).
 1243
 1244clist([])    --> [].
 1245clist([H|T]) --> [H], clist(T).
 1246
 1247qlist([], _)    --> [].
 1248qlist([H|T], M) --> [M:H], qlist(T, M).
 1249
 1250
 1251tabling_defaults([], Dict, Dict).
 1252tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
 1253    (   tabling_default(Condition)
 1254    ->  Dict1 = Dict0.put(Opt,Value)
 1255    ;   Dict1 = Dict0
 1256    ),
 1257    tabling_defaults(T, Dict1, Dict).
 1258
 1259tabling_default(Flag=FValue) :-
 1260    !,
 1261    current_prolog_flag(Flag, FValue).
 1262tabling_default(call(Term)) :-
 1263    call(Term).
 1264
 1265% Called from wrappers//2.
 1266
 1267subgoal_size_restraint(Level) :-
 1268    current_prolog_flag(max_table_subgoal_size_action, abstract),
 1269    current_prolog_flag(max_table_subgoal_size, Level).

 table_options(+Options, +OptDictIn, -OptDictOut)

Handler the ... as options ... construct.

 1275table_options(Options, _Opts0, _Opts) :-
 1276    var(Options),
 1277    '$instantiation_error'(Options).
 1278table_options((A,B), Opts0, Opts) :-
 1279    !,
 1280    table_options(A, Opts0, Opts1),
 1281    table_options(B, Opts1, Opts).
 1282table_options(subsumptive, Opts0, Opts1) :-
 1283    !,
 1284    put_dict(mode, Opts0, subsumptive, Opts1).
 1285table_options(variant, Opts0, Opts1) :-
 1286    !,
 1287    put_dict(mode, Opts0, variant, Opts1).
 1288table_options(incremental, Opts0, Opts1) :-
 1289    !,
 1290    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1291table_options(monotonic, Opts0, Opts1) :-
 1292    !,
 1293    put_dict(monotonic, Opts0, true, Opts1).
 1294table_options(opaque, Opts0, Opts1) :-
 1295    !,
 1296    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1297table_options(lazy, Opts0, Opts1) :-
 1298    !,
 1299    put_dict(lazy, Opts0, true, Opts1).
 1300table_options(dynamic, Opts0, Opts1) :-
 1301    !,
 1302    put_dict(dynamic, Opts0, true, Opts1).
 1303table_options(shared, Opts0, Opts1) :-
 1304    !,
 1305    put_dict(tshared, Opts0, true, Opts1).
 1306table_options(private, Opts0, Opts1) :-
 1307    !,
 1308    put_dict(tshared, Opts0, false, Opts1).
 1309table_options(max_answers(Count), Opts0, Opts1) :-
 1310    !,
 1311    restraint(max_answers, Count, Opts0, Opts1).
 1312table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1313    !,
 1314    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1315table_options(answer_abstract(Size), Opts0, Opts1) :-
 1316    !,
 1317    restraint(answer_abstract, Size, Opts0, Opts1).
 1318table_options(Opt, _, _) :-
 1319    '$domain_error'(table_option, Opt).
 1320
 1321restraint(Name, Value0, Opts0, Opts) :-
 1322    '$table_option'(Value0, Value),
 1323    (   Value < 0
 1324    ->  Opts = Opts0
 1325    ;   put_dict(Name, Opts0, Value, Opts)
 1326    ).

 mode_check(+Moded, -TestCode)

Enforce the output arguments of a mode-directed tabled predicate to be unbound.

 1334mode_check(Moded, Check) :-
 1335    var(Moded),
 1336    !,
 1337    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1338mode_check(Moded, true) :-
 1339    '$tbl_trienode'(Moded),
 1340    !.
 1341mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1342    Moded =.. [s|Vars],
 1343    var_check(Vars, Test).
 1344
 1345var_check([H|T], Test) :-
 1346    (   T == []
 1347    ->  Test = var(H)
 1348    ;   Test = (var(H),Rest),
 1349        var_check(T, Rest)
 1350    ).
 1351
 1352:- public
 1353    instantiated_moded_arg/1. 1354
 1355instantiated_moded_arg(Vars) :-
 1356    '$member'(V, Vars),
 1357    \+ var(V),
 1358    '$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,...)

 1370extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1371    compound(ModeSpec),
 1372    !,
 1373    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1374    compound_name_arguments(Head, Name, HeadArgs),
 1375    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1376    length(ModedArgs, Count),
 1377    atomic_list_concat([$,Name,$,Count], VName),
 1378    Variant =.. [VName|VariantArgs],
 1379    (   ModedArgs == []
 1380    ->  '$tbl_trienode'(ModedAnswer)
 1381    ;   ModedArgs = [ModedAnswer]
 1382    ->  true
 1383    ;   ModedAnswer =.. [s|ModedArgs]
 1384    ).
 1385extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1386    atomic_list_concat([$,Atom,$,0], Variant),
 1387    '$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?

 1397separate_args([], [], [], [], []).
 1398separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1399    indexed_mode(HM),
 1400    !,
 1401    separate_args(TM, TA, TNA, Modes, TMA).
 1402separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1403    separate_args(TM, TA, TNA, Modes, TMA).
 1404
 1405indexed_mode(Mode) :-                           % XSB
 1406    var(Mode),
 1407    !.
 1408indexed_mode(index).                            % YAP
 1409indexed_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.

 1416updater_clauses([], _, []) :- !.
 1417updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1418    update_goal(P, S0,S1,S2, Body).
 1419updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1420    length(Modes, Len),
 1421    functor(S0, s, Len),
 1422    functor(S1, s, Len),
 1423    functor(S2, s, Len),
 1424    S0 =.. [_|Args0],
 1425    S1 =.. [_|Args1],
 1426    S2 =.. [_|Args2],
 1427    update_body(Modes, Args0, Args1, Args2, true, Body).
 1428
 1429update_body([], _, _, _, Body, Body).
 1430update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1431    update_goal(P, A0,A1,A2, Goal),
 1432    mkconj(Body0, Goal, Body1),
 1433    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1434
 1435update_goal(Var, _,_,_, _) :-
 1436    var(Var),
 1437    !,
 1438    '$instantiation_error'(Var).
 1439update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1440    !,
 1441    '$must_be'(atom, M),
 1442    update_goal(lattice(PI), S0,S1,S2, Goal).
 1443update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1444    !,
 1445    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1446    '$must_be'(atom, Name),
 1447    Goal =.. [Name,S0,S1,S2].
 1448update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1449    compound(Head),
 1450    !,
 1451    compound_name_arity(Head, Name, Arity),
 1452    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1453    Goal =.. [Name,S0,S1,S2].
 1454update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1455    !,
 1456    '$must_be'(atom, Name),
 1457    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1458update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1459    !,
 1460    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1461    '$must_be'(atom, Name),
 1462    Call =.. [Name, S0, S1],
 1463    Goal = (Call -> S2 = S0 ; S2 = S1).
 1464update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1465    !,
 1466    '$must_be'(atom, M),
 1467    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1468    '$must_be'(atom, Name),
 1469    Call =.. [Name, S0, S1],
 1470    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1471update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1472    !,
 1473    '$must_be'(atom, M),
 1474    '$must_be'(atom, Name),
 1475    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1476update_goal(po(Name), S0,S1,S2, Goal) :-
 1477    !,
 1478    '$must_be'(atom, Name),
 1479    update_goal(po(Name/2), S0,S1,S2, Goal).
 1480update_goal(Alias, S0,S1,S2, Goal) :-
 1481    update_alias(Alias, Update),
 1482    !,
 1483    update_goal(Update, S0,S1,S2, Goal).
 1484update_goal(Mode, _,_,_, _) :-
 1485    '$domain_error'(tabled_mode, Mode).
 1486
 1487update_alias(first, lattice('$tabling':first/3)).
 1488update_alias(-,     lattice('$tabling':first/3)).
 1489update_alias(last,  lattice('$tabling':last/3)).
 1490update_alias(min,   lattice('$tabling':min/3)).
 1491update_alias(max,   lattice('$tabling':max/3)).
 1492update_alias(sum,   lattice('$tabling':sum/3)).
 1493
 1494mkconj(true, G,  G) :- !.
 1495mkconj(G1,   G2, (G1,G2)).
 1496
 1497
 1498		 /*******************************
 1499		 *          AGGREGATION		*
 1500		 *******************************/

 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.

 1510:- public first/3, last/3, min/3, max/3, sum/3. 1511
 1512first(S, _, S).
 1513last(_, S, S).
 1514min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1515max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1516sum(S0, S1, S) :- S is S0+S1.
 1517
 1518
 1519		 /*******************************
 1520		 *      DYNAMIC PREDICATES	*
 1521		 *******************************/

 $set_table_wrappers(:Head)

Clear/add wrappers and notifications to trap dynamic predicates. This is required both for incremental and monotonic tabling.

 1528'$set_table_wrappers'(Pred) :-
 1529    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1530        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1531    ->  wrap_incremental(Pred)
 1532    ;   unwrap_incremental(Pred)
 1533    ),
 1534    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1535    ->  wrap_monotonic(Pred)
 1536    ;   unwrap_monotonic(Pred)
 1537    ).
 1538
 1539		 /*******************************
 1540		 *       MONOTONIC TABLING	*
 1541		 *******************************/

 mon_assert_dep(+Dependency, +Continuation, +Skel, +ATrie) is det

Create a dependency for monotonic tabling. Skel and ATrie are the target trie for solutions of Continuation.

 1548mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1549    '$idg_add_mono_dyn_dep'(Dynamic,
 1550                            dependency(Dynamic, Cont, Skel),
 1551                            ATrie).
 1552mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1553    '$idg_add_monotonic_dep'(SrcTrie,
 1554                             dependency(SrcSkel, IsMono, Cont, Skel),
 1555                             ATrie).

 monotonic_affects(+SrcTrie, +SrcReturn, -IsMono, -Continuation, -Return, -Atrie)

Dependency between two monotonic tables. If SrcReturn is added to SrcTrie we must add all answers for Return of Continuation to Atrie. IsMono shares with Continuation and is used in start_tabling/3 to distinguish normal tabled call from propagation.

 1565monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1566    '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1567                              dependency(SrcSkel, IsMono, Cont, Skel)).

 monotonic_dyn_affects(:Head, -Continuation, -Return, -ATrie)

Dynamic predicate that maintains the dependency from a monotonic

 1573monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1574    dyn_affected(Head, DTrie),
 1575    '$idg_mono_affects_eager'(DTrie, ATrie,
 1576                              dependency(Head, Cont, Skel)).

 wrap_monotonic(:Head)

Prepare the dynamic predicate Head for monotonic tabling. This traps calls to build the dependency graph and updates to propagate answers from new clauses through the dependency graph.

 1584wrap_monotonic(Head) :-
 1585    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1586                      '$start_monotonic'(Head, Wrapped)),
 1587    '$pi_head'(PI, Head),
 1588    prolog_listen(PI, monotonic_update).

 unwrap_monotonic(+Head)

Remove the monotonic wrappers and dependencies.

 1594unwrap_monotonic(Head) :-
 1595    '$pi_head'(PI, Head),
 1596    (   unwrap_predicate(PI, monotonic)
 1597    ->  prolog_unlisten(PI, monotonic_update)
 1598    ;   true
 1599    ).

 $start_monotonic(+Head, +Wrapped)

This is called the monotonic wrapper around a dynamic predicate to collect the dependencies between the dynamic predicate and the monotonic tabled predicates.

 1607'$start_monotonic'(Head, Wrapped) :-
 1608    (   '$tbl_collect_mono_dep'
 1609    ->  shift(dependency(Head)),
 1610        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1611        Wrapped,
 1612        tdebug(monotonic, '  --> ~p', [Head])
 1613    ;   Wrapped
 1614    ).

 monotonic_update(+Action, +ClauseRef)

Trap changes to the monotonic dynamic predicate and forward them.

 1620:- public monotonic_update/2. 1621monotonic_update(Action, ClauseRef) :-
 1622    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1623    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1624        mon_propagate(Action, Head, ClauseRef)
 1625    ;   true
 1626    ).

 mon_propagate(+Action, +Head, +ClauseRef)

Handle changes to a dynamic predicate as part of monotonic updates.