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

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

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

 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.

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

  325set_pattributes(Head, Options) :-
  326    '$set_predicate_attribute'(Head, tabled, true),
  327    (   tabled_attribute(Attr),
  328        get_dict(Attr, Options, Value),
  329        '$set_predicate_attribute'(Head, Attr, Value),
  330        fail
  331    ;   current_prolog_flag(table_monotonic, lazy),
  332        '$set_predicate_attribute'(Head, lazy, true),
  333        fail
  334    ;   true
  335    ).
  336
  337tabled_attribute(incremental).
  338tabled_attribute(dynamic).
  339tabled_attribute(tshared).
  340tabled_attribute(max_answers).
  341tabled_attribute(subgoal_abstract).
  342tabled_attribute(answer_abstract).
  343tabled_attribute(monotonic).
  344tabled_attribute(opaque).
  345tabled_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.

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

  406restart_tabling(Closure, Wrapper, Worker) :-
  407    tdebug(user_goal(Wrapper, Goal)),
  408    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  409    sleep(0.000001),
  410    start_tabling(Closure, Wrapper, Worker).
  411
  412restart_abstract_tabling(Closure, Wrapper, Worker) :-
  413    tdebug(user_goal(Wrapper, Goal)),
  414    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  415    sleep(0.000001),
  416    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.

  428start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  429    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  430    ->  (   Status == complete
  431        ->  trie_gen_compiled(Trie, Skeleton)
  432        ;   Status == invalid
  433        ->  reeval(Trie, Wrapper, Skeleton),
  434            trie_gen_compiled(Trie, Skeleton)
  435        ;   shift_for_copy(call_info(Skeleton, Status))
  436        )
  437    ;   more_general_table(Wrapper, ATrie),
  438        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  439    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  440    ;   more_general_table(Wrapper, ATrie),
  441        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  442    ->  (   Status == invalid
  443        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  444            Wrapper = GenWrapper,
  445            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  446        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  447            shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  448            unify_subsumptive(Skeleton, GenSkeleton)
  449        )
  450    ;   start_tabling(Closure, Wrapper, Worker)
  451    ).

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

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

  458wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  459    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  460    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  461           [GenSkeleton+Skeleton]).
  462
  463unify_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))

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

  536:- '$hide'((done_leader/4, finished_leader/4)).  537
  538done_leader(complete, _Fresh, Skeleton, Clause) :-
  539    !,
  540    trie_gen_compiled(Clause, Skeleton).
  541done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  542    !,
  543    '$tbl_free_component'(SCC),
  544    trie_gen_compiled(Clause, Skeleton).
  545done_leader(_,_,_,_).
  546
  547finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  548    '$idg_set_current'(OldCurrent),
  549    (   Catcher == exit
  550    ->  true
  551    ;   Catcher == fail
  552    ->  true
  553    ;   Catcher = exception(_)
  554    ->  Fresh = fresh(SCC, _),
  555        '$tbl_table_discard_all'(SCC)
  556    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  557    ).

 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.

  572run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  573    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  574    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  575    activate(Skeleton, Worker, Worklist),
  576    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  577    completion(SCC, Status, Clause),
  578    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  579    (   Status == merged
  580    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  581        '$tbl_wkl_make_follower'(Worklist),
  582        shift_for_copy(call_info(Skeleton, Worklist))
  583    ;   true                                    % completed
  584    ).
  585
  586activate(Skeleton, Worker, WorkList) :-
  587    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  588    (   reset_delays,
  589        delim(Skeleton, Worker, WorkList, []),
  590        fail
  591    ;   true
  592    ).

 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.

  608delim(Skeleton, Worker, WorkList, Delays) :-
  609    reset(Worker, SourceCall, Continuation),
  610    tdebug(wl_goal(WorkList, Goal, _)),
  611    (   Continuation == 0
  612    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  613        tdebug(delay_goals(AllDelays, Cond)),
  614        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  615               [Skeleton, Goal, Cond]),
  616        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  617        Complete == !,
  618        !
  619    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  620    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  621        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  622        tdebug(wl_goal(WorkList, DstGoal, _)),
  623        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  624        '$tbl_wkl_add_suspension'(
  625            SourceWL,
  626            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  627    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  628    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  629        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  630        tdebug(wl_goal(WorkList, DstGoal, _)),
  631        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  632        '$tbl_wkl_add_suspension'(
  633            SourceWL,
  634            InstSkeleton,
  635            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  636    ;   '$tbl_wkl_table'(WorkList, ATrie),
  637        mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
  638    ->  delim(Skeleton, Continuation, WorkList, Delays)
  639    ).

 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.

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

 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 unconditional
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

  747:- public
  748    update/7.  749
  750% both unconditional
  751update(0b11, Wrapper, M, Agg, New, Next, delete) :-
  752    !,
  753    M:'$table_update'(Wrapper, Agg, New, Next),
  754    Agg \=@= Next.
  755% old unconditional, new conditional
  756update(0b10, Wrapper, M, Agg, New, Next, keep) :-
  757    !,
  758    M:'$table_update'(Wrapper, Agg, New, Next0),
  759    (   Next0 =@= Agg
  760    ->  Next = Agg
  761    ;   Next = Next0
  762    ).
  763% old conditional, new unconditional,
  764update(0b01, Wrapper, M, Agg, New, Next, keep) :-
  765    !,
  766    M:'$table_update'(Wrapper, New, Agg, Next0),
  767    (   Next0 =@= Agg
  768    ->  Next = Agg
  769    ;   Next = Next0
  770    ).
  771% both conditional
  772update(0b00, _Wrapper, _M, _Agg, New, New, keep) :-
  773    !.

 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.

  782completion(SCC, Status, Clause) :-
  783    (   reset_delays,
  784        completion_(SCC),
  785        fail
  786    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  787        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  788    ).
  789
  790completion_(SCC) :-
  791    repeat,
  792    (   '$tbl_pop_worklist'(SCC, WorkList)
  793    ->  tdebug(wl_goal(WorkList, Goal, _)),
  794        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  795        completion_step(WorkList)
  796    ;   !
  797    ).

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

  828completion_step(SourceWL) :-
  829    '$tbl_wkl_work'(SourceWL,
  830                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  831    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  832    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  833    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  834    tdebug(delay_goals(AllDelays, Cond)),
  835    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  836           [TargetGoal, SourceGoal, Answer, Cond]),
  837    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  838    fail.
  839
  840
  841		 /*******************************
  842		 *     STRATIFIED NEGATION	*
  843		 *******************************/

 tnot(:Goal)

Tabled negation.

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

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

  896negation_suspend(Wrapper, Skeleton, Worklist) :-
  897    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  898    '$tbl_wkl_negative'(Worklist),
  899    shift_for_copy(call_info(Skeleton, tnot(Worklist))),
  900    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  901    '$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.

  910not_exists(Goal) :-
  911    ground(Goal),
  912    '$get_predicate_attribute'(Goal, tabled, 1),
  913    !,
  914    tnot(Goal).
  915not_exists(Goal) :-
  916    (   tabled_call(Goal), fail
  917    ;   tnot(tabled_call(Goal))
  918    ).
  919
  920		 /*******************************
  921		 *           DELAY LISTS	*
  922		 *******************************/
  923
  924add_delay(Delay) :-
  925    '$tbl_delay_list'(DL0),
  926    '$tbl_set_delay_list'([Delay|DL0]).
  927
  928reset_delays :-
  929    '$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).

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

 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.

 1016abolish_all_tables :-
 1017    (   '$tbl_abolish_local_tables'
 1018    ->  true
 1019    ;   true
 1020    ),
 1021    (   '$tbl_variant_table'(VariantTrie),
 1022        trie_gen(VariantTrie, _, Trie),
 1023        '$tbl_destroy_table'(Trie),
 1024        fail
 1025    ;   true
 1026    ).
 1027
 1028abolish_private_tables :-
 1029    (   '$tbl_abolish_local_tables'
 1030    ->  true
 1031    ;   (   '$tbl_local_variant_table'(VariantTrie),
 1032            trie_gen(VariantTrie, _, Trie),
 1033            '$tbl_destroy_table'(Trie),
 1034            fail
 1035        ;   true
 1036        )
 1037    ).
 1038
 1039abolish_shared_tables :-
 1040    (   '$tbl_global_variant_table'(VariantTrie),
 1041        trie_gen(VariantTrie, _, Trie),
 1042        '$tbl_destroy_table'(Trie),
 1043        fail
 1044    ;   true
 1045    ).

 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?

 1054abolish_table_subgoals(SubGoal0) :-
 1055    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1056    !,
 1057    '$must_be'(acyclic, SubGoal),
 1058    (   '$tbl_variant_table'(VariantTrie),
 1059        trie_gen(VariantTrie, M:SubGoal, Trie),
 1060        '$tbl_destroy_table'(Trie),
 1061        fail
 1062    ;   true
 1063    ).
 1064abolish_table_subgoals(_).

 abolish_module_tables(+Module) is det

Abolish all tables for predicates associated with the given module.

 1070abolish_module_tables(Module) :-
 1071    '$must_be'(atom, Module),
 1072    '$tbl_variant_table'(VariantTrie),
 1073    current_module(Module),
 1074    !,
 1075    forall(trie_gen(VariantTrie, Module:_, Trie),
 1076           '$tbl_destroy_table'(Trie)).
 1077abolish_module_tables(_).

 abolish_nonincremental_tables is det

Abolish all tables that are not related to incremental predicates.

 1083abolish_nonincremental_tables :-
 1084    (   '$tbl_variant_table'(VariantTrie),
 1085        trie_gen(VariantTrie, _, Trie),
 1086        '$tbl_table_status'(Trie, Status, Goal, _),
 1087        (   Status == complete
 1088        ->  true
 1089        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1090        ),
 1091        \+ predicate_property(Goal, incremental),
 1092        '$tbl_destroy_table'(Trie),
 1093        fail
 1094    ;   true
 1095    ).

 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.

 1104abolish_nonincremental_tables(Options) :-
 1105    (   Options = on_incomplete(Action)
 1106    ->  Action == skip
 1107    ;   '$option'(on_incomplete(skip), Options)
 1108    ),
 1109    !,
 1110    (   '$tbl_variant_table'(VariantTrie),
 1111        trie_gen(VariantTrie, _, Trie),
 1112        '$tbl_table_status'(Trie, complete, Goal, _),
 1113        \+ predicate_property(Goal, incremental),
 1114        '$tbl_destroy_table'(Trie),
 1115        fail
 1116    ;   true
 1117    ).
 1118abolish_nonincremental_tables(_) :-
 1119    abolish_nonincremental_tables.
 1120
 1121
 1122                 /*******************************
 1123                 *        EXAMINE TABLES        *
 1124                 *******************************/

 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.

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

 table_options(+Options, +OptDictIn, -OptDictOut)

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

 1290table_options(Options, _Opts0, _Opts) :-
 1291    var(Options),
 1292    '$instantiation_error'(Options).
 1293table_options((A,B), Opts0, Opts) :-
 1294    !,
 1295    table_options(A, Opts0, Opts1),
 1296    table_options(B, Opts1, Opts).
 1297table_options(subsumptive, Opts0, Opts1) :-
 1298    !,
 1299    put_dict(mode, Opts0, subsumptive, Opts1).
 1300table_options(variant, Opts0, Opts1) :-
 1301    !,
 1302    put_dict(mode, Opts0, variant, Opts1).
 1303table_options(incremental, Opts0, Opts1) :-
 1304    !,
 1305    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1306table_options(monotonic, Opts0, Opts1) :-
 1307    !,
 1308    put_dict(monotonic, Opts0, true, Opts1).
 1309table_options(opaque, Opts0, Opts1) :-
 1310    !,
 1311    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1312table_options(lazy, Opts0, Opts1) :-
 1313    !,
 1314    put_dict(lazy, Opts0, true, Opts1).
 1315table_options(dynamic, Opts0, Opts1) :-
 1316    !,
 1317    put_dict(dynamic, Opts0, true, Opts1).
 1318table_options(shared, Opts0, Opts1) :-
 1319    !,
 1320    put_dict(tshared, Opts0, true, Opts1).
 1321table_options(private, Opts0, Opts1) :-
 1322    !,
 1323    put_dict(tshared, Opts0, false, Opts1).
 1324table_options(max_answers(Count), Opts0, Opts1) :-
 1325    !,
 1326    restraint(max_answers, Count, Opts0, Opts1).
 1327table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1328    !,
 1329    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1330table_options(answer_abstract(Size), Opts0, Opts1) :-
 1331    !,
 1332    restraint(answer_abstract, Size, Opts0, Opts1).
 1333table_options(Opt, _, _) :-
 1334    '$domain_error'(table_option, Opt).
 1335
 1336restraint(Name, Value0, Opts0, Opts) :-
 1337    '$table_option'(Value0, Value),
 1338    (   Value < 0
 1339    ->  Opts = Opts0
 1340    ;   put_dict(Name, Opts0, Value, Opts)
 1341    ).

 mode_check(+Moded, -TestCode)

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

 1349mode_check(Moded, Check) :-
 1350    var(Moded),
 1351    !,
 1352    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1353mode_check(Moded, true) :-
 1354    '$tbl_trienode'(Moded),
 1355    !.
 1356mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1357    Moded =.. [s|Vars],
 1358    var_check(Vars, Test).
 1359
 1360var_check([H|T], Test) :-
 1361    (   T == []
 1362    ->  Test = var(H)
 1363    ;   Test = (var(H),Rest),
 1364        var_check(T, Rest)
 1365    ).
 1366
 1367:- public
 1368    instantiated_moded_arg/1. 1369
 1370instantiated_moded_arg(Vars) :-
 1371    '$member'(V, Vars),
 1372    \+ var(V),
 1373    '$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,...)

 1385extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1386    compound(ModeSpec),
 1387    !,
 1388    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1389    compound_name_arguments(Head, Name, HeadArgs),
 1390    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1391    length(ModedArgs, Count),
 1392    atomic_list_concat([$,Name,$,Count], VName),
 1393    Variant =.. [VName|VariantArgs],
 1394    (   ModedArgs == []
 1395    ->  '$tbl_trienode'(ModedAnswer)
 1396    ;   ModedArgs = [ModedAnswer]
 1397    ->  true
 1398    ;   ModedAnswer =.. [s|ModedArgs]
 1399    ).
 1400extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1401    atomic_list_concat([$,Atom,$,0], Variant),
 1402    '$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?

 1412separate_args([], [], [], [], []).
 1413separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1414    indexed_mode(HM),
 1415    !,
 1416    separate_args(TM, TA, TNA, Modes, TMA).
 1417separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1418    separate_args(TM, TA, TNA, Modes, TMA).
 1419
 1420indexed_mode(Mode) :-                           % XSB
 1421    var(Mode),
 1422    !.
 1423indexed_mode(index).                            % YAP
 1424indexed_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.

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

 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.

 1525:- public first/3, last/3, min/3, max/3, sum/3. 1526
 1527first(S, _, S).
 1528last(_, S, S).
 1529min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1530max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1531sum(S0, S1, S) :- S is S0+S1.
 1532
 1533
 1534		 /*******************************
 1535		 *      DYNAMIC PREDICATES	*
 1536		 *******************************/

 $set_table_wrappers(:Head)

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

 1543'$set_table_wrappers'(Pred) :-
 1544    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1545        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1546    ->  wrap_incremental(Pred)
 1547    ;   unwrap_incremental(Pred)
 1548    ),
 1549    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1550    ->  wrap_monotonic(Pred)
 1551    ;   unwrap_monotonic(Pred)
 1552    ).
 1553
 1554		 /*******************************
 1555		 *       MONOTONIC TABLING	*
 1556		 *******************************/

 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.

 1563mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1564    '$idg_add_mono_dyn_dep'(Dynamic,
 1565                            dependency(Dynamic, Cont, Skel),
 1566                            ATrie).
 1567mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1568    '$idg_add_monotonic_dep'(SrcTrie,
 1569                             dependency(SrcSkel, IsMono, Cont, Skel),
 1570                             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.

 1580monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1581    '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1582                              dependency(SrcSkel, IsMono, Cont, Skel)).

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

Dynamic predicate that maintains the dependency from a monotonic

 1588monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1589    dyn_affected(Head, DTrie),
 1590    '$idg_mono_affects_eager'(DTrie, ATrie,
 1591                              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.

 1599wrap_monotonic(Head) :-
 1600    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1601                      '$start_monotonic'(Head, Wrapped)),
 1602    '$pi_head'(PI, Head),
 1603    prolog_listen(PI, monotonic_update).

 unwrap_monotonic(+Head)

Remove the monotonic wrappers and dependencies.

 1609unwrap_monotonic(Head) :-
 1610    '$pi_head'(PI, Head),
 1611    (   unwrap_predicate(PI, monotonic)
 1612    ->  prolog_unlisten(PI, monotonic_update)
 1613    ;   true
 1614    ).

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

 1622'$start_monotonic'(Head, Wrapped) :-
 1623    (   '$tbl_collect_mono_dep'
 1624    ->  shift(dependency(Head)),
 1625        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1626        Wrapped,
 1627        tdebug(monotonic, '  --> ~p', [Head])
 1628    ;   Wrapped
 1629    ).

 monotonic_update(+Action, +ClauseRef)

Trap changes to the monotonic dynamic predicate and forward them.

 1635:- public monotonic_update/2. 1636monotonic_update(Action, ClauseRef) :-
 1637    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1638    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1639        mon_propagate(Action, Head, ClauseRef)
 1640    ;   true
 1641    ).

 mon_propagate(+Action, +Head, +ClauseRef)

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

 1648mon_propagate(Action, Head, ClauseRef) :-
 1649    assert_action(Action),
 1650    !,
 1651    setup_call_cleanup(
 1652        '$tbl_propagate_start'(Old),
 1653        propagate_assert(Head),                 % eager monotonic dependencies
 1654        '$tbl_propagate_end'(Old)),
 1655    forall(dyn_affected(Head, ATrie),
 1656           '$mono_idg_changed'(ATrie, ClauseRef)). % lazy monotonic dependencies
 1657mon_propagate(retract, Head, _) :-
 1658    !,
 1659    mon_invalidate_dependents(Head).
 1660mon_propagate(rollback(Action), Head, _) :-
 1661    mon_propagate_rollback(Action, Head).
 1662
 1663mon_propagate_rollback(Action, _Head) :-
 1664    assert_action(Action),
 1665    !.
 1666mon_propagate_rollback(retract, Head) :-
 1667    mon_invalidate_dependents(Head).
 1668
 1669assert_action(asserta).
 1670assert_action(assertz).

 propagate_assert(+Head) is det

Propagate assertion of a dynamic clause with head Head.

 1676propagate_assert(Head) :-
 1677    tdebug(monotonic, 'Asserted ~p', [Head]),
 1678    (   monotonic_dyn_affects(Head, Cont, Skel, ATrie),
 1679        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1680        '$idg_set_current'(_, ATrie),
 1681        pdelim(Cont, Skel, ATrie),
 1682        fail
 1683    ;   true
 1684    ).

 incr_propagate_assert(+Head) is det

Propagate assertion of a dynamic clause with head Head, both through eager and dynamic tables.

 1691incr_propagate_assert(Head) :-
 1692    tdebug(monotonic, 'New dynamic answer ~p', [Head]),
 1693    (   dyn_affected(Head, DTrie),
 1694         '$idg_mono_affects'(DTrie, ATrie,
 1695                             dependency(Head, Cont, Skel)),
 1696        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1697        '$idg_set_current'(_, ATrie),
 1698        pdelim(Cont, Skel, ATrie),
 1699        fail
 1700    ;   true
 1701    ).

 propagate_answer(+SrcTrie, +SrcSkel) is det

Propagate the new answer SrcSkel to the answer table SrcTrie.

 1708propagate_answer(SrcTrie, SrcSkel) :-
 1709    (   monotonic_affects(SrcTrie, SrcSkel, true, Cont, Skel, ATrie),
 1710        tdebug(monotonic, 'Propagating tab ~p to ~p', [SrcTrie, ATrie]),
 1711        pdelim(Cont, Skel, ATrie),
 1712        fail
 1713    ;   true
 1714    ).

 pdelim(+Worker, +Skel, +ATrie)

Call Worker (a continuation) and add each binding it provides for Skel to ATrie. If a new answer is added to ATrie, using propagate_answer/2 to propagate this further. Note that we may hit new dependencies and thus we need to run this using reset/3.

To be done

- Not sure whether we need full tabling here. Need to think of test cases.

 1726pdelim(Worker, Skel, ATrie) :-
 1727    reset(Worker, Dep, Cont),
 1728    (   Cont == 0
 1729    ->  '$tbl_monotonic_add_answer'(ATrie, Skel),
 1730        propagate_answer(ATrie, Skel)
 1731    ;   mon_assert_dep(Dep, Cont, Skel, ATrie),
 1732        pdelim(Cont, Skel, ATrie)
 1733    ).

 mon_invalidate_dependents(+Head)

A non-monotonic operation was done on Head. Invalidate all dependent tables, preparing for normal incremental reevaluation on the next cycle.

 1741mon_invalidate_dependents(Head) :-
 1742    tdebug(monotonic, 'Invalidate dependents for ~p', [Head]),
 1743    forall(dyn_affected(Head, ATrie),
 1744           '$idg_mono_invalidate'(ATrie)).

 abolish_monotonic_tables

Abolish all monotonic tables and the monotonic dependency relations.

To be done

- : just prepare for incremental reevaluation?

 1752abolish_monotonic_tables :-
 1753    (   '$tbl_variant_table'(VariantTrie),
 1754        trie_gen(VariantTrie, Goal, ATrie),
 1755        '$get_predicate_attribute'(Goal, monotonic, 1),
 1756        '$tbl_destroy_table'(ATrie),
 1757        fail
 1758    ;   true
 1759    ).
 1760
 1761		 /*******************************
 1762		 *      INCREMENTAL TABLING	*
 1763		 *******************************/

 wrap_incremental(:Head) is det

Wrap an incremental dynamic predicate to be added to the IDG.

 1769wrap_incremental(Head) :-
 1770    tdebug(monotonic, 'Wrapping ~p', [Head]),
 1771    abstract_goal(Head, Abstract),
 1772    '$pi_head'(PI, Head),
 1773    (   Head == Abstract
 1774    ->  prolog_listen(PI, dyn_update)
 1775    ;   prolog_listen(PI, dyn_update(Abstract))
 1776    ).
 1777
 1778abstract_goal(M:Head, M:Abstract) :-
 1779    compound(Head),
 1780    '$get_predicate_attribute'(M:Head, abstract, 1),
 1781    !,
 1782    compound_name_arity(Head, Name, Arity),
 1783    functor(Abstract, Name, Arity).
 1784abstract_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.

 1794:- public dyn_update/2, dyn_update/3. 1795
 1796dyn_update(_Action, ClauseRef) :-
 1797    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1798    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1799        dyn_changed_pattern(Head)
 1800    ;   true
 1801    ).
 1802
 1803dyn_update(Abstract, _, _) :-
 1804    dyn_changed_pattern(Abstract).
 1805
 1806dyn_changed_pattern(Term) :-
 1807    forall(dyn_affected(Term, ATrie),
 1808           '$idg_changed'(ATrie)).
 1809
 1810dyn_affected(Term, ATrie) :-
 1811    '$tbl_variant_table'(VTable),
 1812    trie_gen(VTable, Term, ATrie).

 unwrap_incremental(:Head) is det

Remove dynamic predicate incremenal forwarding, reset the possible abstract property and remove possible tables.

 1819unwrap_incremental(Head) :-
 1820    '$pi_head'(PI, Head),
 1821    abstract_goal(Head, Abstract),
 1822    (   Head == Abstract
 1823    ->  prolog_unlisten(PI, dyn_update)
 1824    ;   '$set_predicate_attribute'(Head, abstract, 0),
 1825        prolog_unlisten(PI, dyn_update(_))
 1826    ),
 1827    (   '$tbl_variant_table'(VariantTrie)
 1828    ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1829               '$tbl_destroy_table'(ATrie))
 1830    ;   true
 1831    ).

 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

 1857reeval(ATrie, Goal, Return) :-
 1858    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1859          retry_reeval(ATrie, Goal)).
 1860
 1861retry_reeval(ATrie, Goal) :-
 1862    '$tbl_reeval_abandon'(ATrie),
 1863    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1864    sleep(0.000001),
 1865    call(Goal).
 1866
 1867try_reeval(ATrie, Goal, Return) :-
 1868    nb_current('$tbl_reeval', true),
 1869    !,
 1870    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1871    do_reeval(ATrie, Goal, Return).
 1872try_reeval(ATrie, Goal, Return) :-
 1873    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1874    findall(Path, false_path(ATrie, Path), Paths0),
 1875    sort(0, @>, Paths0, Paths1),
 1876    clean_paths(Paths1, Paths),
 1877    tdebug(forall('$member'(Path, Paths),
 1878                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1879    reeval_paths(Paths, ATrie),
 1880    do_reeval(ATrie, Goal, Return).
 1881
 1882do_reeval(ATrie, Goal, Return) :-
 1883    '$tbl_reeval_prepare_top'(ATrie, Clause),
 1884    (   Clause == 0                          % complete and answer subsumption
 1885    ->  '$tbl_table_status'(ATrie, _Status, M:Variant, Return),
 1886        M:'$table_mode'(Goal0, Variant, ModeArgs),
 1887        Goal = M:Goal0,
 1888        moded_gen_answer(ATrie, Return, ModeArgs)
 1889    ;   nonvar(Clause)                       % complete
 1890    ->  trie_gen_compiled(Clause, Return)
 1891    ;   call(Goal)                           % actually re-evaluate
 1892    ).

 clean_paths(+PathsIn, -Paths)

Clean the reevaluation paths. Get rid of the head term for ranking and remove duplicate paths. Note that a Path is a list of tries, ground terms.

 1901clean_paths([], []).
 1902clean_paths([[_|Path]|T0], [Path|T]) :-
 1903    clean_paths(T0, Path, T).
 1904
 1905clean_paths([], _, []).
 1906clean_paths([[_|CPath]|T0], CPath, T) :-
 1907    !,
 1908    clean_paths(T0, CPath, T).
 1909clean_paths([[_|Path]|T0], _, [Path|T]) :-
 1910    clean_paths(T0, Path, T).

 reeval_paths(+Paths, +Atrie)

Make Atrie valid again by re-evaluating nodes in Paths. We stop as soon as Atrie is valid again. Note that we may not need to reevaluate all paths because evaluating the head of some path may include other nodes in an SCC, making them valid as well.

 1919reeval_paths([], _) :-
 1920    !.
 1921reeval_paths(BottomUp, ATrie) :-
 1922    is_invalid(ATrie),
 1923    !,
 1924    reeval_heads(BottomUp, ATrie, BottomUp1),
 1925    tdebug(assertion(BottomUp \== BottomUp1)),
 1926    '$list_to_set'(BottomUp1, BottomUp2),
 1927    reeval_paths(BottomUp2, ATrie).
 1928reeval_paths(_, _).
 1929
 1930reeval_heads(_, ATrie, []) :-                % target is valid again
 1931    \+ is_invalid(ATrie),
 1932    !.
 1933reeval_heads([], _, []).
 1934reeval_heads([[H]|B], ATrie, BT) :-          % Last one of a falsepath
 1935    reeval_node(H),
 1936    !,
 1937    reeval_heads(B, ATrie, BT).
 1938reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1939    reeval_node(H),
 1940    !,
 1941    reeval_heads(B, ATrie, BT).
 1942reeval_heads([FP|B], ATrie, [FP|BT]) :-
 1943    reeval_heads(B, ATrie, BT).